Lightbox Info Board : SQLの窓

API 用宣言


' ------------------------------------------------------
' 取得データ用構造体関連定義
' ------------------------------------------------------
Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Const MAX_PATH = 260

Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type

' ------------------------------------------------------
' 初回検索
' ------------------------------------------------------
Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" ( _
    ByVal hFtpSession As Long, _
    ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, _
    ByVal dwFlags As Long, _
    ByVal dwContent As Long _
) As Long

' ------------------------------------------------------
' ２件目以降の検索
' ------------------------------------------------------
Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" ( _
    ByVal hFind As Long, _
    lpvFindData As WIN32_FIND_DATA _
) As Long

一覧取得用関数


' ******************************************************
' 一覧の取得
' ******************************************************
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 = 2
    Grid.Rows = 2

    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
            
        End With

    Loop

    Call InternetCloseHandle(hFind)
    
    lbFTPEnum = Grid.Rows - 1

End Function

一覧取得ボタンのイベント


' ******************************************************
' 一覧取得
' ******************************************************
Private Sub cmd一覧取得_Click()

    Call Module1.lbFTPEnum("", "*.*", grd一覧)

End Sub

補足

API を使用すると、VB側で用意したエリアにAPIが文字列をセットする場面が
よくありますが、そのまま String として使用しようとするとゴミが入っている場合
があります。ここでは、いったん Grid へ転送してしまうので消えますが、通常
以下のようにします


Left(lpData.cFileName, InStr(1, lpData.cFileName, String(1, 0), vbBinaryCompare) - 1)

但し既定の文字列比較方法は Binary モードなので以下が簡単です


Left(lpData.cFileName, InStr(lpData.cFileName, Chr(0)) - 1)