Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Get Directory Listing from FTP Server

Status
Not open for further replies.

jasonp45

Programmer
Aug 23, 2001
212
0
0
US
I need to communicate with the FTP server to get a directory listing; the question is - HOW? I can pull files easily enough, like this:

Public Sub DownloadFile()
Set oXML = CreateObject("MSXML2.XMLHTTP.3.0") 'New XMLHTTP30
Dim b() 'As Byte
With oXML
.Open "GET", mURL & mDownload_FileName, False, mUserName, mPassword 'False is for async property
.send
Open mOutput_FileName For Binary Access Write As #1
Put #1, , b()
Close #1
End With
End Sub

Seems to me that if I can PULL a file, it ought to be fairly simple to LIST the files! But apparently it isn't, since no one knows how to do it! XMLHTTP doesn't provide a List or Dir method. I can do it with the INET control, but I don't much like using it. I found a class on the web that works using API calls (posted below); I have incorporated it into my code and it works fine - gets the directory listing, puts the filenames into a recordset, etc. But I dislike using code that I don't really understand; I prefer writing the code myself so that I know how it works, and so I can extend/modify it as needed.

An ASP guru from the Web suggested that I use the FSO and MapPath, but I don't know how (or if I can) incorporate ASP into my VB code. I feel quite certain there is some simple, 3- or 4- line code snippet to do this, and I'm hoping someone can tell me what it is. Thanks in advance.

Public Function GetDirectoryList(Optional Directory As String, Optional FilterString As String) As ADOR.Recordset
Attribute GetDirectoryList.VB_Description = "Return a Directory List as a Disconnected Record set"
'
' Returns a Disconnected record set for the
' directory and filterstring
'
' eg. "/NTFFiles", "*.ntf"
'
On Error GoTo vbErrorHandler

Dim oFileColl As Collection
Dim lFind As Long
Dim lLastError As Long
Dim lPtr As Long
Dim pData As WIN32_FIND_DATA
Dim sFilter As String
Dim lError As Long
Dim bRet As Boolean
Dim sItemName As String
Dim oRS As ADOR.Recordset

'
' Check if already connected, else raise an error
'
If mlConnection = 0 Then
Err.Raise errNotConnectedToSite, "CGFTP::GetDirectoryList", ERRNOCONNECTION
End If

'
' Build the disconnected recordset structure.
'
Set oRS = New ADOR.Recordset
oRS.CursorLocation = adUseClient
oRS.Fields.Append "Name", adBSTR
oRS.Open
'
' Change directory if required
'
If Len(Directory) > 0 Then
RemoteChDir Directory
End If

pData.cFileName = String$(MAX_PATH, vbNullChar)

If Len(FilterString) > 0 Then
sFilter = FilterString
Else
sFilter = "*.*"
End If
'
' Get the first file in the directory
'
lFind = FtpFindFirstFile(mlConnection, sFilter, pData, 0, 0)
lLastError = Err.LastDllError
'
' If no files, then return an empty recordset.
'
If lFind = 0 Then
If lLastError = ERROR_NO_MORE_FILES Then
' Empty directory
Set GetDirectoryList = oRS
Exit Function
Else
On Error GoTo 0
Err.Raise lLastError, "cFTP::GetDirectoryList", "Error looking at directory " & Directory & "\" & FilterString
End If
Exit Function
End If
'
' Add the first found file into the recordset
'
sItemName = Left$(pData.cFileName, InStr(1, pData.cFileName, vbNullChar, vbBinaryCompare) - 1)
oRS.AddNew "Name", sItemName
'
' Get the rest of the files in the list
'
Do
pData.cFileName = String(MAX_PATH, vbNullChar)
bRet = InternetFindNextFile(lFind, pData)
If Not (bRet) Then
lLastError = Err.LastDllError
If lLastError = ERROR_NO_MORE_FILES Then
Exit Do
Else
InternetCloseHandle lFind
On Error GoTo 0
Err.Raise lLastError, "cFTP::GetDirectoryList", "Error looking at directory " & Directory & "\" & FilterString
Exit Function
End If
Else
sItemName = Left$(pData.cFileName, InStr(1, pData.cFileName, vbNullChar, vbBinaryCompare) - 1)
oRS.AddNew "Name", sItemName
End If
Loop
'
' Close the 'find' handle
'
InternetCloseHandle lFind

On Error Resume Next
oRS.MoveFirst
Err.Clear
On Error GoTo 0

Set GetDirectoryList = oRS

Exit Function

vbErrorHandler:
'
' Tidy up & raise an error
'
If lFind <> 0 Then
InternetCloseHandle lFind
End If
Set GetDirectoryList = oRS

Err.Raise Err.Number, &quot;cFTP::GetDirectoryList&quot;, Err.Description

End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top