VERSION 5.00
Begin VB.Form frmFile 
   Caption         =   "File Transportation"
   ClientHeight    =   1395
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5205
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   1395
   ScaleWidth      =   5205
   StartUpPosition =   3  'Windows の既定値
   Begin VB.TextBox txtFile 
      Height          =   270
      Left            =   1680
      TabIndex        =   5
      Text            =   "PRO1.PAC"
      Top             =   150
      Width           =   3375
   End
   Begin VB.CommandButton cmdGetFile 
      Caption         =   "GetFile"
      Height          =   375
      Left            =   1680
      TabIndex        =   4
      Top             =   480
      Width           =   1095
   End
   Begin VB.CommandButton cmdGetText 
      Caption         =   "get_Text"
      Height          =   375
      Left            =   1680
      TabIndex        =   3
      Top             =   900
      Width           =   1095
   End
   Begin VB.CommandButton cmdPutText 
      Caption         =   "put_Text"
      Height          =   375
      Left            =   2820
      TabIndex        =   2
      Top             =   900
      Width           =   1095
   End
   Begin VB.CommandButton cmdRelFile 
      Caption         =   "Release"
      Height          =   375
      Left            =   2820
      TabIndex        =   1
      Top             =   480
      Width           =   1095
   End
   Begin VB.CommandButton CmdExit 
      Caption         =   "Exit"
      Height          =   375
      Left            =   3960
      TabIndex        =   0
      Top             =   900
      Width           =   1095
   End
   Begin VB.Label Label1 
      Alignment       =   1  '右揃え
      Caption         =   "Filename : "
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   6
      Top             =   180
      Width           =   1455
   End
End
Attribute VB_Name = "frmFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const SAVE_FILE = "Result.txt"

Dim caoEng As CaoEngine
Dim caoCtrl As CaoController
Dim caoFil As CaoFile

' フォームロード
Private Sub Form_Load()

    'CAOエンジンの生成
    Set caoEng = New CaoEngine
    
    'ローカルファイルプロバイダに接続
    Set caoCtrl = caoEng.Workspaces(0).AddController("RC1", "CaoProv.Dummy")

End Sub

'フォームアンロード
Private Sub Form_Unload(Cancel As Integer)

    cmdRelFile_Click
    
    ' CAOオブジェクトの解放
    Set caoCtrl = Nothing
    Set caoEng = Nothing

End Sub

' Exitボタン
Private Sub CmdExit_Click()

    Unload Me

End Sub

' ファイルオブジェクトの取得
Private Sub cmdGetFile_Click()

    On Error GoTo ErrDisp

    Dim lPos As Long
    Dim strName As String
    Dim strPara As String
    
    '接続済みの場合は解放する
    cmdRelFile_Click
    
    ' オブジェクトの生成
    Set caoFil = caoCtrl.AddFile(txtFile)

    Exit Sub

ErrDisp:
    cmdRelFile_Click
    MsgBox Err.Description

End Sub

'ファイルオブジェクトの解放
Private Sub cmdRelFile_Click()

    If Not caoFil Is Nothing Then
        caoCtrl.Files.Remove caoFil.Index
        Set caoFil = Nothing
    End If

End Sub

' ファイルデータの取得
Private Sub cmdGetText_Click()

    On Error GoTo ErrSkip
    
    Dim strData As String
    Dim fd As Integer

    ' ファイルオブジェクトのチェック
    If caoFil Is Nothing Then
        Exit Sub
    End If
    
    'ファイルデータの取得
    strData = caoFil.Value
    
    ' 取得データの保存
    fd = FreeFile
    Open SAVE_FILE For Binary Access Write As fd
    Put #fd, , strData
    Close fd
    
    Exit Sub

ErrSkip:
    MsgBox Err.Description

End Sub

Private Sub cmdPutText_Click()

    On Error GoTo ErrSkip

    Dim strData As String
    Dim fd As Integer
    Dim fl As Long

    ' テキスト形式用
    If caoFil Is Nothing Then
        Exit Sub
    End If
    
    ' 設定データの取得
    fd = FreeFile
    fl = FileLen(SAVE_FILE)
    Open SAVE_FILE For Binary Access Read As fd
    strData = String(fl, " ")
    Get #fd, , strData
    Close fd
    
    'ファイルにデータを設定
    caoFil.Value = strData
    
    Exit Sub

ErrSkip:
    MsgBox Err.Description

End Sub