Lightbox Info Board : SQLの窓

コンポーネントで、「Microsoft Windows Common Controls 6.0」をチェックして
新しいフォームに、TreeView コントロールを追加し、「trvサーバ」とする


' ------------------------------------------------------
' コントロールサイズ調整用
' ------------------------------------------------------
Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Declare Function GetClientRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long

サイズ調整のイベント


' ******************************************************
' サイズ調整
' ******************************************************
Private Sub Form_Resize()

    If Me.WindowState = vbMinimized Then
        Exit Sub
    End If

    Dim rc As RECT

    GetClientRect Me.hwnd, rc

    With Me.trvサーバ
        .Left = 0
        .Top = 0
        .Width = 3000
        .Height = Me.ScaleY(rc.Bottom, vbPixels, vbTwips)
    End With

End Sub

ImageListの追加

imgフォルダ

Form1 に呼び出しボタンを作成


' ******************************************************
' ツリー表示用フォームをロード
' ******************************************************
Private Sub cmdツリー表示_Click()

    If Me.cmd接続.Enabled = False Then
        Form2.Show vbModal
    End If

End Sub

TreeView の初期設定


' ******************************************************
' 初期設定
' ******************************************************
Private Sub Form_Load()

    Dim I As Integer

    For I = 1 To Form1.grd一覧.Rows - 1
        
        If Form1.grd一覧.TextMatrix(I, 5) = "10" Then
            If Left(Form1.grd一覧.TextMatrix(I, 1), 1) <> "." Then
                Me.trvサーバ.Nodes.Add , , , Form1.grd一覧.TextMatrix(I, 1), Image_Closed
            End If
        End If
            
    Next I

End Sub

ノードの展開


' ******************************************************
' ノードの展開
' ******************************************************
Private Sub trvサーバ_DblClick()

    Dim nodフォルダ As Node
    Dim I As Integer

    ' 選択されたノードオブジェクトを取得
    Set nodフォルダ = trvサーバ.SelectedItem
    
    Select Case nodフォルダ.Image
        Case Image_Closed       ' 閉じたノード
            
            If nodフォルダ.Children = 0 Then  ' 子ノードが無い場合
                Call Module1.lbFTPEnum( _
                    Replace(nodフォルダ.FullPath, "\", "/"), _
                    "*.*", _
                    Form1.grd一覧 _
                )

                ' 子ノードを展開
                For I = 1 To Form1.grd一覧.Rows - 1
                    
                    If Form1.grd一覧.TextMatrix(I, 5) = "10" Then
                        If Left(Form1.grd一覧.TextMatrix(I, 1), 1) <> "." Then
                            Me.trvサーバ.Nodes.Add _
                                nodフォルダ.Index, _
                                tvwChild, _
                                , _
                                Form1.grd一覧.TextMatrix(I, 1), _
                                Image_Closed
                        End If
                    End If
                        
                Next I

                ' 実際に１つ以上のデータがある場合
                If nodフォルダ.Children <> 0 Then

                    ' 子ノードを開く
                    nodフォルダ.Expanded = True
                    nodフォルダ.ExpandedImage = Image_Opend

                End If
            End If
            
    End Select

End Sub

通常ファイルの追加


' ******************************************************
' 初期設定
' ******************************************************
Private Sub Form_Load()

    Dim I As Integer

    For I = 1 To Form1.grd一覧.Rows - 1
        
        If Form1.grd一覧.TextMatrix(I, 5) = "10" Then
            If Left(Form1.grd一覧.TextMatrix(I, 1), 1) <> "." Then
                Me.trvサーバ.Nodes.Add , , , Form1.grd一覧.TextMatrix(I, 1), Image_Closed
            End If
        End If

        If Form1.grd一覧.TextMatrix(I, 5) = "80" Then
            If Left(Form1.grd一覧.TextMatrix(I, 1), 1) <> "." Then
                Me.trvサーバ.Nodes.Add , , , Form1.grd一覧.TextMatrix(I, 1), Image_Leaf
            End If
        End If

    Next I

End Sub


' ******************************************************
' ノードの展開
' ******************************************************
Private Sub trvサーバ_DblClick()

    Dim nodフォルダ As Node
    Dim I As Integer

    ' 選択されたノードオブジェクトを取得
    Set nodフォルダ = trvサーバ.SelectedItem
    
    Select Case nodフォルダ.Image
        Case Image_Closed       ' 閉じたノード
            
            If nodフォルダ.Children = 0 Then  ' 子ノードが無い場合
                Call Module1.lbFTPEnum( _
                    Replace(nodフォルダ.FullPath, "\", "/"), _
                    "*.*", _
                    Form1.grd一覧 _
                )

                ' 子ノードを展開
                For I = 1 To Form1.grd一覧.Rows - 1
                    
                    If Form1.grd一覧.TextMatrix(I, 5) = "10" Then
                        If Left(Form1.grd一覧.TextMatrix(I, 1), 1) <> "." Then
                            Me.trvサーバ.Nodes.Add _
                                nodフォルダ.Index, _
                                tvwChild, _
                                , _
                                Form1.grd一覧.TextMatrix(I, 1), _
                                Image_Closed
                        End If
                    End If

                    If Form1.grd一覧.TextMatrix(I, 5) = "80" Then
                        If Left(Form1.grd一覧.TextMatrix(I, 1), 1) <> "." Then
                            Me.trvサーバ.Nodes.Add _
                                nodフォルダ.Index, _
                                tvwChild, _
                                , _
                                Form1.grd一覧.TextMatrix(I, 1), _
                                Image_Leaf
                        End If
                    End If
                        
                Next I

                ' 実際に１つ以上のデータがある場合
                If nodフォルダ.Children <> 0 Then

                    ' 子ノードを開く
                    nodフォルダ.Expanded = True
                    nodフォルダ.ExpandedImage = Image_Opend

                End If
            End If
            
    End Select

End Sub

属性・ファイル名順にソート


' ******************************************************
' 一覧の取得
' ******************************************************
Public Function lbFTPEnum( _
strDirectory As String, _
strTarget As String, _
Grid As Object _
) As Long

    Dim bFirst As Boolean
    Dim lpData As WIN32_FIND_DATA
    Dim hFind As Long
    Dim nRet As Long
    Dim nLastDllError As Long
    
    bFirst = True
    Grid.Clear
   
    
    Grid.Cols = 8
    Grid.Rows = 2

    With Grid
        .TextMatrix(0, 1) = "FileName"
        .TextMatrix(0, 2) = "CreationTime"
        .TextMatrix(0, 3) = "LastAccessTime"
        .TextMatrix(0, 4) = "LastWriteTime"
        .TextMatrix(0, 5) = "FileAttributes"
        .TextMatrix(0, 6) = "FileName"
        .TextMatrix(0, 7) = "FileSizeLow"
    End With
 
    Do
    
        If bFirst Then
            bFirst = False
            hFind = FtpFindFirstFile(hCon, strDirectory & "/" & strTarget, lpData, 0, 0)
            nLastDllError = Err.LastDllError
            If hFind = 0 Then
                If (nLastDllError = 18) Then
                    lbFTPEnum = 0
                Else
                    lbFTPEnum = -1
                End If
                Exit Function
            End If
        Else
            nRet = InternetFindNextFile(hFind, lpData)
            nLastDllError = Err.LastDllError
            If nRet = 0 Then
                If (nLastDllError = 18) Then
                    Exit Do
                Else
                    lbFTPEnum = -1
                    Call InternetCloseHandle(hFind)
                    Exit Function
                End If
            End If
            Grid.Rows = Grid.Rows + 1
        End If

        With Grid
        
            .TextMatrix(.Rows - 1, 0) = .Rows - 1
            .TextMatrix(.Rows - 1, 1) = lpData.cFileName
            .TextMatrix(.Rows - 1, 2) = StringDateTime(lpData.ftCreationTime)
            .TextMatrix(.Rows - 1, 3) = StringDateTime(lpData.ftLastAccessTime)
            .TextMatrix(.Rows - 1, 4) = StringDateTime(lpData.ftLastWriteTime)
            
            .TextMatrix(.Rows - 1, 5) = Hex(lpData.dwFileAttributes)
            .TextMatrix(.Rows - 1, 6) = lpData.cFileName
            .TextMatrix(.Rows - 1, 7) = lpData.nFileSizeLow
            
        End With

    Loop

    Form1.grd一覧.Col = 5
    Form1.grd一覧.ColSel = 6
    Form1.grd一覧.Sort = 1
    
    Call InternetCloseHandle(hFind)
    
    lbFTPEnum = Grid.Rows - 1

End Function