VERSION 5.00
Begin VB.Form frmFile 
   BorderStyle     =   1  '固定(実線)
   Caption         =   "File"
   ClientHeight    =   6360
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7305
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6360
   ScaleWidth      =   7305
   StartUpPosition =   3  'Windows の既定値
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "&Refresh"
      Height          =   405
      Left            =   150
      TabIndex        =   13
      Top             =   5880
      Width           =   1215
   End
   Begin VB.Frame Frame2 
      Caption         =   "Operation"
      Height          =   4725
      Left            =   90
      TabIndex        =   6
      Top             =   1080
      Width           =   7095
      Begin VB.CommandButton cmdOpen 
         Caption         =   "<- &Open"
         Height          =   375
         Left            =   3120
         TabIndex        =   14
         Top             =   3000
         Width           =   825
      End
      Begin VB.ListBox lstRemote 
         Height          =   4020
         Left            =   4050
         TabIndex        =   12
         Top             =   480
         Width           =   2895
      End
      Begin VB.ListBox lstLocal 
         Height          =   4020
         Left            =   120
         TabIndex        =   11
         Top             =   480
         Width           =   2895
      End
      Begin VB.CommandButton cmdPut 
         Caption         =   "&Put ->"
         Height          =   375
         Left            =   3120
         TabIndex        =   8
         Top             =   1950
         Width           =   825
      End
      Begin VB.CommandButton cmdGet 
         Caption         =   "<- &Get"
         Height          =   375
         Left            =   3120
         TabIndex        =   7
         Top             =   1440
         Width           =   825
      End
      Begin VB.Label Label3 
         Caption         =   "REMOTE file:"
         Height          =   225
         Left            =   4110
         TabIndex        =   10
         Top             =   240
         Width           =   2415
      End
      Begin VB.Label Label1 
         Caption         =   "LOCAL file:"
         Height          =   225
         Left            =   180
         TabIndex        =   9
         Top             =   240
         Width           =   2415
      End
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "Exit"
      Height          =   405
      Left            =   5970
      TabIndex        =   4
      Top             =   5880
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "Connection"
      Height          =   855
      Left            =   90
      TabIndex        =   0
      Top             =   120
      Width           =   7095
      Begin VB.CommandButton cmdConnect 
         Caption         =   "&Connect"
         Height          =   375
         Left            =   4440
         TabIndex        =   2
         Top             =   300
         Width           =   1215
      End
      Begin VB.CommandButton cmdDisconnect 
         Caption         =   "&Disconnect"
         Height          =   375
         Left            =   5760
         TabIndex        =   3
         Top             =   300
         Width           =   1215
      End
      Begin VB.ComboBox cmbParameter 
         Height          =   300
         Left            =   1320
         TabIndex        =   1
         Top             =   360
         Width           =   3015
      End
      Begin VB.Label Label2 
         Alignment       =   1  '右揃え
         Caption         =   "Parameter : "
         Height          =   255
         Left            =   240
         TabIndex        =   5
         Top             =   360
         Width           =   975
      End
   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 caoEng As New CaoEngine
Private caoCtrls As CaoControllers
Private caoCtrl  As CaoController
Attribute caoCtrl.VB_VarHelpID = -1

' ----------------------------------------------------
Private Sub Form_Load()
    With cmbParameter
        .Clear
        .AddItem "eth:192.168.0.1:4112" ' <- Change this for your controller IP setting. "eth:<controller IP>:4112
        .AddItem "com:1:38400:N:8:1" ' <- Change this for your controller RS-232C setting. "com:<COM port no.>:<speed>:N:8:1"
        .ListIndex = 0
    End With
       
    cmdGet.Enabled = False
    cmdPut.Enabled = False
    
    Set caoEng = New CaoEngine
    Set caoCtrls = caoEng.Workspaces(0).Controllers

    cmdRefresh_Click

End Sub

' ----------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)

    cmdDisconnect_Click
    
    Set caoCtrls = Nothing
    Set caoEng = Nothing
    
End Sub

' ----------------------------------------------------
Private Sub cmdGet_Click()

    Dim bAdded As Boolean
    bAdded = False
On Error GoTo ErrSkip

    Dim filename As String
    filename = lstRemote.List(lstRemote.ListIndex)

    Dim caoFl  As CaoFile
    Set caoFl = caoCtrl.AddFile(filename)
    bAdded = True
    
    Dim vntData As Variant
    Dim bytData() As Byte
    Dim strData As String

    If Not caoFl Is Nothing Then
        vntData = caoFl.Value
        
        Select Case VarType(vntData)
        Case vbString
            strData = vntData
            SaveToTextFile App.Path + "\" + filename, strData
        Case vbArray + vbByte
            bytData = vntData
            SaveToBinFile App.Path + "\" + filename, bytData
        End Select
    End If
    
DoExit:
    If bAdded = True Then
        caoCtrl.Files.Remove caoFl.Index
        bAdded = False
    End If
    
    Set caoFl = Nothing

    cmdRefresh_Click

    Exit Sub
ErrSkip:
    MsgBox Err.Description
    Err.Clear
    GoTo DoExit

End Sub

' ----------------------------------------------------
Private Sub cmdOpen_Click()
    
    Dim filename As String
    filename = lstLocal.List(lstLocal.ListIndex)
    If filename <> "" Then
        filename = App.Path + "\" + filename
        Shell "notepad " + filename, vbNormalFocus
    End If

End Sub

' ----------------------------------------------------
Private Sub cmdPut_Click()

    Dim bAdded As Boolean
    bAdded = False
On Error GoTo ErrSkip

    Dim filename As String
    filename = lstLocal.List(lstLocal.ListIndex)

    Dim caoFl  As CaoFile
    Set caoFl = caoCtrl.AddFile(filename, "@Create=1") '1:Create new file
    bAdded = True

    Dim strData As String
    Dim bytData() As Byte

    If Not caoFl Is Nothing Then
        If filename Like "*.nic" Then ' Binary file
            LoadFromBinFile App.Path + "\" + filename, bytData
            caoFl.Value = bytData
        Else
            LoadFromTextFile App.Path + "\" + filename, strData
            caoFl.Value = strData
        End If
    End If

DoExit:
    If bAdded = True Then
        caoCtrl.Files.Remove caoFl.Index
        bAdded = False
    End If
    
    Set caoFl = Nothing

    cmdRefresh_Click

    Exit Sub
ErrSkip:
    MsgBox Err.Description
    Err.Clear
    GoTo DoExit

End Sub

' ----------------------------------------------------
Private Sub cmdRefresh_Click()

    If caoCtrl Is Nothing Then GoTo Skip
'[Remote file list] --------------------------------------
    With lstRemote
        Dim fl As CaoFile
        Dim fls As CaoFiles
        ' Clear all file in caoCtrl.Files
        Set fls = caoCtrl.Files
        For Each fl In fls
            fls.Remove fl.Index
        Next
        .Clear
        
        ' Append all file into caoCtrl.Files
        Dim l As Long
        Dim names As Variant
        
        names = caoCtrl.FileNames
        For l = LBound(names) To UBound(names)
            If (names(l) Like "*.pac") Or (names(l) Like "*.h") Or (names(l) Like "*.nic") Then
                .AddItem names(l)
            End If
        Next l
        If (.ListCount > 0) And (.ListIndex < 0) Then
            .ListIndex = 0
        End If
    End With
Skip:
'[Local file list] --------------------------------------
    Dim sname As String
    With lstLocal
        .Clear
        sname = Dir(App.Path + "\*.*", vbNormal)
        Do While sname <> ""
            If sname <> "." And sname <> ".." Then
                If (sname Like "*.pac") Or (sname Like "*.h") Or (sname Like "*.nic") Then
                    .AddItem sname
                End If
            End If
            sname = Dir
        Loop
        If (.ListCount > 0) And (.ListIndex < 0) Then
            .ListIndex = 0
        End If
    End With
    
End Sub

' ----------------------------------------------------
Private Sub cmdConnect_Click()
On Error GoTo ErrProc
    
    Dim sConn As String
    
    cmdDisconnect_Click
    
    sConn = "Conn=" & cmbParameter.Text
    
    Set caoCtrl = caoCtrls.Add("", "CaoProv.DENSO.NetwoRC", "", sConn)
    
    cmdGet.Enabled = True
    cmdPut.Enabled = True
    
    cmdRefresh_Click

    Exit Sub
ErrProc:
    MsgBox Err.Description
End Sub

' ----------------------------------------------------
Private Sub cmdDisconnect_Click()
    
    If Not caoCtrl Is Nothing Then
        caoCtrls.Remove caoCtrl.Index
        Set caoCtrl = Nothing
    End If
    
    cmdGet.Enabled = False
    cmdPut.Enabled = False
    
End Sub

' ----------------------------------------------------
Private Sub cmdExit_Click()
    Unload Me
End Sub

' ----------------------------------------------------
Private Sub LoadFromTextFile(fn As String, buf As String)

    Dim fd As Integer

    fd = FreeFile
    Open fn For Input As fd
        buf = StrConv(InputB(LOF(fd), #fd), vbUnicode)
    Close fd

End Sub

' ----------------------------------------------------
Private Sub SaveToTextFile(fn As String, buf As String)

    Dim fd As Integer

    fd = FreeFile
    Open fn For Output As fd
        Print #fd, buf;
    Close fd

End Sub

' ----------------------------------------------------
Private Sub LoadFromBinFile(fn As String, bytData() As Byte)

    Dim fd As Integer
    Dim fl As Long

    fd = FreeFile
    fl = FileLen(fn)
    ReDim bytData(0 To fl - 1)
    Open fn For Binary Access Read As fd
        Get #fd, , bytData
    Close fd

End Sub

' ----------------------------------------------------
Private Sub SaveToBinFile(fn As String, bytData() As Byte)

    Dim fd As Integer

    fd = FreeFile
    Open fn For Binary Access Write As fd
        Put #fd, , bytData
    Close fd

End Sub

Private Sub lstLocal_DblClick()
    cmdOpen_Click
End Sub