VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmTree 
   BorderStyle     =   1  '固定(実線)
   Caption         =   "Tree"
   ClientHeight    =   6360
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7305
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6360
   ScaleWidth      =   7305
   StartUpPosition =   3  'Windows の既定値
   Begin VB.CommandButton cmdGet 
      Caption         =   "&Get"
      Height          =   405
      Left            =   1440
      TabIndex        =   9
      Top             =   5880
      Width           =   1215
   End
   Begin VB.CommandButton cmdRefresh 
      Caption         =   "&Refresh"
      Height          =   405
      Left            =   150
      TabIndex        =   7
      Top             =   5880
      Width           =   1215
   End
   Begin VB.Frame Frame2 
      Caption         =   "Tree"
      Height          =   4725
      Left            =   90
      TabIndex        =   6
      Top             =   1080
      Width           =   7095
      Begin MSComctlLib.ImageList imlRemote 
         Left            =   480
         Top             =   1620
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   16
         ImageHeight     =   16
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   2
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "Tree.frx":0000
               Key             =   "file"
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "Tree.frx":5C22
               Key             =   "dir"
            EndProperty
         EndProperty
      End
      Begin MSComctlLib.TreeView treRemote 
         Height          =   4305
         Left            =   180
         TabIndex        =   8
         Top             =   270
         Width           =   6765
         _ExtentX        =   11933
         _ExtentY        =   7594
         _Version        =   393217
         LabelEdit       =   1
         Style           =   7
         ImageList       =   "imlRemote"
         Appearance      =   1
      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 = "frmTree"
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 cmdGet_Click()
  
  Dim sPath As String
  sPath = treRemote.SelectedItem.Key
  'Debug.Print sPath
  
  Dim vPath As Variant
  vPath = Split(sPath, "/")
  
  Dim bDir As Boolean
  If Right(sPath, 1) = "/" Then
    bDir = True
  Else
    bDir = False
  End If
  
  Dim s As String
  Dim l&, lmin&, lmax&
  lmin = LBound(vPath)
  lmax = UBound(vPath)
  sPath = vbNullString
  For l = lmin To lmax
    s = vPath(l)
    If Len(s) Then
        If (l = lmax) And (bDir = False) Then
            'make dir
            Dim sDir$
            sDir = AppendBackSlash(App.path) + "ROOT\" + Replace(sPath, "/", "\")
            MakePathAux sDir
            'make file
            Dim sFile$
            sFile = s
            Dim fl As CaoFile
            Set fl = caoCtrl.AddFile(sPath + sFile)
            Debug.Print fl.path
            
            Dim vntData As Variant
            Dim bytData() As Byte
            Dim strData As String
        
            If Not fl Is Nothing Then
                vntData = fl.Value
                
                Select Case VarType(vntData)
                Case vbString
                    strData = vntData
                    SaveToTextFile sDir + sFile, strData
                Case vbArray + vbByte
                    bytData = vntData
                    SaveToBinFile sDir + sFile, bytData
                End Select
            End If

            caoCtrl.Files.Remove fl.Index
        Else
            sPath = sPath + s + "/"
        End If
    End If
  Next
  
  
End Sub

' ----------------------------------------------------
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
       
    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 cmdRefresh_Click()

    If caoCtrl Is Nothing Then Exit Sub
    
    With treRemote.Nodes
        .Clear
        
        Dim fls As CaoFiles
        Set fls = caoCtrl.Files
        
        Dim nd As Node
        Set nd = .Add(, , "/Root/", "/Root/", 2, 2)
        AddNodeChild nd, caoCtrl.FileNames, fls, "/"
    End With
    
End Sub

Private Sub AddNodeChild(nd As Node, names As Variant, fls As CaoFiles, ByVal path$)
    
    With treRemote.Nodes
        
        Dim fl As CaoFile
        Dim chld As Node
        Dim parent As Node
        Dim v As Variant
        Dim l As Long
        Dim sPath$
        
        fls.Clear
        ' Append all file into caoCtrl.Files
        For l = LBound(names) To UBound(names)
            Set fl = fls.Add(names(l))
            Select Case fl.Attribute
            Case 32: 'file
                Set chld = .Add(nd.Index, tvwChild, path + fl.Name, fl.Name, 1, 1)
                chld.EnsureVisible
            End Select
        Next l
        fls.Clear
        For l = LBound(names) To UBound(names)
            Set fl = fls.Add(names(l))
            Select Case fl.Attribute
            Case 16: 'dir
                sPath = path + fl.Name + "/"
                Set parent = .Add(nd.Index, tvwChild, sPath, fl.Name + "/", 2, 2)
                v = fl.FileNames
                AddNodeChild parent, v, fl.Files, sPath
            End Select
        Next l
        fls.Clear
        
    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)
    
    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
    
End Sub

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


' ----------------------------------------------------
Public Function MakePathAux(strDirName As String) As Boolean

    Dim strPath         As String
    Dim intOffset       As Integer
    Dim intAnchor       As Integer
    Dim strOldPath      As String

    On Error Resume Next

    strDirName = AppendBackSlash(strDirName)

    strOldPath = CurDir$
    MakePathAux = False
    intAnchor = 0

    intOffset = InStr(intAnchor + 1, strDirName, "\")
    intAnchor = intOffset
    Do
        intOffset = InStr(intAnchor + 1, strDirName, "\")
        intAnchor = intOffset

        If intAnchor > 0 Then
            strPath = Left$(strDirName, intOffset - 1)
            Err = 0
            ChDir strPath
            If Err Then
                Err = 0
                MkDir strPath
                If Err Then GoTo Done
            End If
        End If
    Loop Until intAnchor = 0

    MakePathAux = True
Done:
    ChDir strOldPath
    Err = 0

End Function

' ----------------------------------------------------
Public Sub KillFolder(MyFolder$)

    On Error Resume Next

    MyFolder = RemoveBackSlash(MyFolder)
    
    Dim MyName As String
    MyName = Dir(MyFolder$, vbDirectory)
    Do While MyName <> vbNullString
         If MyName <> "." And MyName <> ".." Then
            SetAttr MyFolder$ & MyName, vbNormal
        End If
        MyName = Dir
    Loop

    Kill MyFolder$ & "\*.*"
    RmDir MyFolder$

End Sub

' ----------------------------------------------------
Private Function AppendBackSlash(sPath$) As String

    If (Right$(sPath, 1) <> "\") Then
        AppendBackSlash = sPath & "\"
    Else
        AppendBackSlash = sPath
    End If

End Function

' ----------------------------------------------------
Private Function RemoveBackSlash(sPath$) As String

    If (Right$(sPath, 1) = "\") Then
        RemoveBackSlash = Left(sPath, Len(sPath) - 1)
    Else
        RemoveBackSlash = sPath
    End If

End Function

' ----------------------------------------------------
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