コンポーネントで、「Microsoft Windows Common Controls 6.0」 をチェックして
新しいフォームに、TreeView コントロールを追加し、「trvサーバ」とする
Module2.bas
' ------------------------------------------------------' コントロールサイズ調整用' ------------------------------------------------------
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.ShowvbModal
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
