halfondj
asked on
Downloading zip and text files via FTP (using Inet control)
After receiving the responses I did re:using the Inet control for FTPing, I decided to go with it. Thanks.
Now that I did, all is working great w/the uploading and downloading of zip and text files. I can't have a progress bar, but that's ok because of the simplicity of the code now.
In the case statement 'icResponseCompleted', I'm not doing anything except setting the status bar message to "Request completed successfully.".
Questions:
1) In the 'icResponseCompleted' case, do I have to implement the Inet1.GetChunk(512, icString) code, etc.? All seems to be working fine with downloading zip and text files without that code. I can't seem to find documentation re:why to use it.
2) Also, how would one know if they're downloading a binary or text file? In a script, one can use the 'binary' or 'ascii' commands, but programmicatically using the Inet control, how would one implement that?
Thanks for all your help!!
Now that I did, all is working great w/the uploading and downloading of zip and text files. I can't have a progress bar, but that's ok because of the simplicity of the code now.
In the case statement 'icResponseCompleted', I'm not doing anything except setting the status bar message to "Request completed successfully.".
Questions:
1) In the 'icResponseCompleted' case, do I have to implement the Inet1.GetChunk(512, icString) code, etc.? All seems to be working fine with downloading zip and text files without that code. I can't seem to find documentation re:why to use it.
2) Also, how would one know if they're downloading a binary or text file? In a script, one can use the 'binary' or 'ascii' commands, but programmicatically using the Inet control, how would one implement that?
Thanks for all your help!!
Richie_Simonetti
inet execute methocd has a second parameter to do that. You could instruct the control to download/upload text (icstring) or binary (icbbytearray) if i remember well.
ASKER
I don't think so. The documentation on Microsoft's website re:the Execute method is as follows:
object.Execute url, operation, data, requestHeaders where operation, data, requestHeaders are optional parms.
Their example is:
Inet1.Execute "FTP://ftp.microsoft.com", "GET Disclaimer.txt C:\Temp\Disclaimer.txt"
In my code I'm using:
Inet1.Execute , "get abc.zip c:\testdir\abc.zip" and it's working.
Any other suggestions?
Thanks.
object.Execute url, operation, data, requestHeaders where operation, data, requestHeaders are optional parms.
Their example is:
Inet1.Execute "FTP://ftp.microsoft.com", "GET Disclaimer.txt C:\Temp\Disclaimer.txt"
In my code I'm using:
Inet1.Execute , "get abc.zip c:\testdir\abc.zip" and it's working.
Any other suggestions?
Thanks.
Sorry, since i haven't vb installed i did a mistake: Openurl is the method that accept second parameter to establish transfer-type mode
Anyway, if i remember well, there is a property of inet control that you could use to establish transfer-type mode, just i don't remembre the name of it. sorry again.
Anyway, if i remember well, there is a property of inet control that you could use to establish transfer-type mode, just i don't remembre the name of it. sorry again.
ASKER
Thanks anyway, but there isn't a property of the Inet control that could be used to establish a transfer-type mode.
How about question #1:
In the 'icResponseCompleted' case, do I have to implement the Inet1.GetChunk(512, icString) code, etc.? All seems to be working fine with downloading zip and text files without that code. I can't seem to find documentation re:why to use it.
Thanks.
How about question #1:
In the 'icResponseCompleted' case, do I have to implement the Inet1.GetChunk(512, icString) code, etc.? All seems to be working fine with downloading zip and text files without that code. I can't seem to find documentation re:why to use it.
Thanks.
wait a sec:
2) You are right, how about using execute method with "binary" or "ascii" string as parameter and then, up/down load the files?
2) You are right, how about using execute method with "binary" or "ascii" string as parameter and then, up/down load the files?
ASKER
Unfortunately, the only valid FTP settings for the Execute method are:
Taken from the Microsoft website:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/Inet98/html/vbmthinetexecutemethod.asp
Operation Description
CD - file1 Change Directory. Changes to the directory specified in file1.
CDUP - Change to parent directory. Equivalent to "CD.."
CLOSE - Closes the current FTP connection.
DELETE - file1 Deletes the file specified in file1.
DIR file1 - Directory. Searches the directory specified in file1. (Wildcards are permitted but the remote host dictates the syntax.) If no file1 is specified, a full directory of the current working directory is returned.
Use the GetChunk method to return the directory data.
GET file1 file2 - Retrieves the remote file specified in file1, and creates a new local file specified in file2.
LS file1 List. - Searches the directory specified in file1. (Wildcards are permitted but the remote host dictates the syntax.) Use the GetChunk method to return the file directory data.
MKDIR file1 - Make Directory. Creates a directory as specified in file1. Success is dependent on user privileges on the remote host.
PUT file1 file2 - Copies a local file specified in file1 to the remote host specified in file2.
PWD - Print Working Directory. Returns the current directory name. Use the GetChunk method to return the data.
QUIT - Terminates the current user.
RECV file1 file2 - Retrieves the remote file specified in file1, and creates a new local file specified in file2. Equivalent to GET.
RENAME file1 file2 - Renames the remote file named in file1 to the new name specified in file2. Success is dependent on user privileges on the remote host.
RMDIR file1 - Remove Directory. Removes the remote directory specified in file1. Success is dependent on user privileges on the remote host.
SEND file1 file2 - Copies a local file, specified in file1, to the remote host, specified in file2. Equivalent to PUT.
SIZE file1 - Returns the size of the directory specified in file1.
That's it. It doesn't seem like the ascii and binary commands are supported.
Taken from the Microsoft website:
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/Inet98/html/vbmthinetexecutemethod.asp
Operation Description
CD - file1 Change Directory. Changes to the directory specified in file1.
CDUP - Change to parent directory. Equivalent to "CD.."
CLOSE - Closes the current FTP connection.
DELETE - file1 Deletes the file specified in file1.
DIR file1 - Directory. Searches the directory specified in file1. (Wildcards are permitted but the remote host dictates the syntax.) If no file1 is specified, a full directory of the current working directory is returned.
Use the GetChunk method to return the directory data.
GET file1 file2 - Retrieves the remote file specified in file1, and creates a new local file specified in file2.
LS file1 List. - Searches the directory specified in file1. (Wildcards are permitted but the remote host dictates the syntax.) Use the GetChunk method to return the file directory data.
MKDIR file1 - Make Directory. Creates a directory as specified in file1. Success is dependent on user privileges on the remote host.
PUT file1 file2 - Copies a local file specified in file1 to the remote host specified in file2.
PWD - Print Working Directory. Returns the current directory name. Use the GetChunk method to return the data.
QUIT - Terminates the current user.
RECV file1 file2 - Retrieves the remote file specified in file1, and creates a new local file specified in file2. Equivalent to GET.
RENAME file1 file2 - Renames the remote file named in file1 to the new name specified in file2. Success is dependent on user privileges on the remote host.
RMDIR file1 - Remove Directory. Removes the remote directory specified in file1. Success is dependent on user privileges on the remote host.
SEND file1 file2 - Copies a local file, specified in file1, to the remote host, specified in file2. Equivalent to PUT.
SIZE file1 - Returns the size of the directory specified in file1.
That's it. It doesn't seem like the ascii and binary commands are supported.
Then, just a guess, how about using openurl method first to "log in" to site setting tranfer mode there and, after that, using Get and Put?
Also, note that tehere is somne free tools/component at internet to do FTP stuff. Maybe let inet would be a good choice.
ASKER
Found my answer on MS's website -- http://support.microsoft.com/default.aspx?scid=kb;EN-US;233037
ITC does not offer the option of an ASCII-type FTP file transfer even though WinInet offers the option of either a binary or ASCII transfer (INTERNET_FLAG_TRANSFER_BI
188956 PRB: ITC Cannot Perform ASCII-type FTP Transfer
Looks like I'll need to implement using the WinInet API's directly.
ITC does not offer the option of an ASCII-type FTP file transfer even though WinInet offers the option of either a binary or ASCII transfer (INTERNET_FLAG_TRANSFER_BI
188956 PRB: ITC Cannot Perform ASCII-type FTP Transfer
Looks like I'll need to implement using the WinInet API's directly.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Richie_Simonetti: Thanks so much for taking the time to answer my question (everyone else too). If you wouldn't mind, please post the urls and if possible, can you post your FTP class or tell me where to find it? I would appreciate looking at some more sample code.
For the time you've taken to answer this question. I'll accept your answer.
Thanks.
For the time you've taken to answer this question. I'll accept your answer.
Thanks.
'Save the contents to a text file called cFTP.cls
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CFTP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
' Constantes:
Private Const MAX_PATH = 260
'************
' Tipos:
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private 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
' **************************
' Variables
Private m_InetConnect As Long
Private m_InetSession As Long
' **************************
' Enum
#If VBA = 0 Then
Public Enum enumAccessType
ACCESSDEFAULT = 0
ACCESSDIRECT = 1
ACCESSPROXY = 3
End Enum
Public Enum enumService
sFTP = 1
sGOPHER = 2
sHTTP = 3
End Enum
Public Enum enumTransferType
ttASCII = 1
ttBINARY = 2
End Enum
Public Enum enumSITE
SITELOCAL = 0
SITEREMOTE = 1
End Enum
#Else
'enum AccessType replacing constant
Const ACCESSDEFAULT = 0
Const ACCESSDIRECT = 1
Const ACCESSPROXY = 3
'enum Service replacing constant
Const sFTP = 1
Const sGOPHER = 2
constsHTTP = 3
'enum TransferType replacing constant
Const ttASCCI = 1
Const ttBINARY = 2
'enum SITE replacing constant
Const SITELOCAL = 0
Const SITEREMOTE = 1
#End If
' ********
' API: Conexión/desconexión
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, _
ByVal nServerPort As Integer, ByVal sUsername As String, _
ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
' **************************
' API: Manage Files
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" _
(ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private 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
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
'**********
' Manage directories
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long
Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' *********************
' Resolving Local host...
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const IP_SUCCESS As Long = 0
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type
Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
(ByVal hostname As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As Long)
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
'*************
' Internet connection
Private ConnState As Long
Private bolAutoConnect As Boolean
Private Const INTERNET_AUTODIAL_FORCE_ON
Private Const INTERNET_AUTODIAL_FORCE_UN
Private Declare Function InternetGetConnectedState Lib "wininet" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
Private Declare Function InternetAutodial Lib "wininet" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Boolean
Private Declare Function InternetAutodialHangup Lib "wininet" (ByVal dwReserved As Long) As Boolean
Public Function IsInetConnected() As Boolean
' check for an active connection
' to Internet.
On Error GoTo errH
Dim flags As Long
IsInetConnected = (InternetGetConnectedState
Exit Function
errH:
IsInetConnected = False
Exit Function
End Function
Public Function FTPCreateFolder(strFolderN
On Error GoTo errH
FTPCreateFolder = (FtpCreateDirectory(m_Inet
Exit Function
errH:
Err.Clear
FTPCreateFolder = False
End Function
Public Function FTPDeleteFolder(strFolderN
On Error GoTo errH
FTPDeleteFolder = (FtpRemoveDirectory(m_Inet
Exit Function
errH:
Err.Clear
FTPDeleteFolder = False
End Function
Public Function FTPGetCurrDir() As String
Attribute FTPGetCurrDir.VB_Descripti
On Error GoTo errH
If m_InetConnect <> 0 Then
Dim sRemotePath As String
sRemotePath = String$(MAX_PATH, 32)
FtpGetCurrentDirectory m_InetConnect, sRemotePath, MAX_PATH
sRemotePath = Trim$(sRemotePath)
FTPGetCurrDir = Left$(sRemotePath, Len(sRemotePath) - 1)
End If
Exit Function
errH:
Err.Clear
FTPGetCurrDir = False
End Function
Public Function FTPOpenSession(ByVal lAccessType As enumAccessType, _
Optional sProxyName As String = "Local Machine", _
Optional sBypassedIPs As String = vbNullString) As Boolean
Attribute FTPOpenSession.VB_Descript
'lAccessType:
'AccessDefault = 0
'AccessDirect = 1
'AccessProxy = 3
On Error GoTo errH
FTPOpenSession = False ' assumes error by default
Select Case lAccessType
Case 1, 0
m_InetSession = InternetOpen("FILE TRANSFER FTP Server", _
lAccessType, _
vbNullString, _
vbNullString, _
0)
Case 3
If sProxyName = "Local Machine" Or sProxyName = vbNullString Then
If SocketsInitialize() Then
'pass the local host address to the function
Dim sHostName As String * 255
Dim ret As Long
ret = GetComputerName(sHostName,
If ret <> 0 Then
sHostName = Left$(sHostName, _
InStr(1, sHostName, Chr$(0), vbTextCompare) - 1)
m_InetSession = InternetOpen("FILE TRANSFER FTP Server", _
lAccessType, _
GetIPFromHostName(sHostNam
sBypassedIPs, 0)
End If
End If
Else
m_InetSession = InternetOpen("FILE TRANSFER FTP Server", _
lAccessType, _
sProxyName, _
sBypassedIPs, _
0)
End If
End Select
FTPOpenSession = (m_InetSession <> 0)
Exit Function
errH:
Err.Clear
FTPOpenSession = False
End Function
Public Function FTPSetCurrDir(sDir As String) As Boolean
Attribute FTPSetCurrDir.VB_Descripti
On Error GoTo errH
FTPSetCurrDir = (FtpSetCurrentDirectory(m_
Exit Function
errH:
Err.Clear
FTPSetCurrDir = False
End Function
Private Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
On Error GoTo errH
SocketsInitialize = (WSAStartup(WS_VERSION_REQ
Exit Function
errH:
Err.Clear
SocketsInitialize = False
End Function
Private Sub SocketsCleanup()
On Error Resume Next
If WSACleanup() <> 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
End Sub
Private Function GetIPFromHostName(ByVal sHostName As String) As String
'converts a host name to an IP address.
On Error GoTo errH:
Dim nbytes As Long
Dim ptrHosent As Long
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String
sAddress = Space$(4)
ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent <> 0 Then
'assign pointer addresses and offset
'The Address is offset 12 bytes from the start of
'the HOSENT structure. Note: Here we are retrieving
'only the first address returned. To return more than
'one, define sAddress as a string array and loop through
'the 4-byte ptrIPAddress members returned. The last
'item is a terminating null. All addresses are returned
'in network byte order.
ptrAddress = ptrHosent + 12
'get the IP address
CopyMemory ptrAddress, ByVal ptrAddress, 4
CopyMemory ptrIPAddress, ByVal ptrAddress, 4
CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
GetIPFromHostName = IPToText(sAddress)
End If
Exit Function
errH:
Err.Clear
GetIPFromHostName = ""
End Function
Private Function IPToText(ByVal IPAddress As String) As String
On Error Resume Next
IPToText = CStr(Asc(IPAddress)) & "." & _
CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function
Public Function EnumFilesFTP(Optional sExtension As String = "*.*", Optional dwAttributes As VbFileAttribute = vbArchive)
On Error GoTo errH
Dim bSkip As Boolean
Dim arrFiles As FFiles
Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
'create a buffer
pData.cFileName = String(MAX_PATH, 0)
'find the first file
hFind = FtpFindFirstFile(m_InetCon
'if there's no file, then exit sub
If hFind = 0 Then
Set arrFiles = Nothing
Exit Function
End If
'show the filename
Dim fname As String
fname = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
bSkip = (dwAttributes And pData.dwFileAttributes) <> dwAttributes
If fname <> "." And Not bSkip Then
idx = idx + 1
ReDim arrFiles(idx)
arrFiles(idx) = fname
End If
Do
'create a buffer
pData.cFileName = String(MAX_PATH, 0)
'find the next file
lRet = InternetFindNextFile(hFind
'if there's no next file, exit do
If lRet = 0 Then Exit Do
'show the filename
fname = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
bSkip = (dwAttributes And pData.dwFileAttributes) <> dwAttributes
If fname <> ".." And Not bSkip Then
idx = idx + 1
ReDim Preserve arrFiles(idx)
arrFiles(idx) = fname
End If
Loop
'close the search handle
InternetCloseHandle hFind
'returns names of files found and quantity
intFilesFound = idx
EnumFilesFTP = arrFiles
Exit Function
errH:
Err.Clear
End Function
' *************
Public Function FTPConnect(sSvrFTP As String, _
SUser As String, _
sPwd As String, _
sService As enumService, _
Optional iFTPSvrPort As Integer = 21) _
As Boolean
Attribute FTPConnect.VB_Description = "Establece la conexión con el servidor FTP."
On Error GoTo errH
If m_InetSession <> 0 Then
m_InetConnect = InternetConnect(m_InetSess
End If
FTPConnect = (m_InetConnect <> 0)
Exit Function
errH:
Err.Clear
FTPConnect = False
End Function
Public Sub FTPCloseSession()
Attribute FTPCloseSession.VB_Descrip
On Error Resume Next
InternetCloseHandle m_InetConnect
InternetCloseHandle m_InetSession
If bolAutoConnect Then InternetAutodialHangup 0
End Sub
Public Function FTPGet(sRemoteFile As String, sLocalFile As String, Optional TransferType As enumTransferType = ttBINARY) As Boolean
Attribute FTPGet.VB_Description = "Obtiene una copia del archivo ubicadi¿o en el servidor FTP (sRemoteFile) y lo guarda localmente en el path y nombre especificado en el parámetro sLocalFile. Si se omite el parámetro TransferType (ASCII o Binary), la transferencia se realizara en forma bi"
On Error Resume Next
FTPGet = (FtpGetFile(m_InetConnect,
Exit Function
errH:
Err.Clear
FTPGet = False
End Function
Public Function FTPPut(sLocalFile As String, sRemoteFile As String, Optional TransferType As enumTransferType = ttBINARY) As Boolean
Attribute FTPPut.VB_Description = "Envia una copia del archivo local al servidor FTP. Si el parámetro TransferType se omite, la transferencia se realizará en formato Binario."
On Error GoTo errH
FTPPut = False ' assumes error by default
FTPPut = (FtpPutFile(m_InetConnect,
Exit Function
errH:
Err.Clear
FTPPut = False
End Function
Public Function FileDelete(ByVal sFileName As String, ByVal sSite As enumSITE) As Boolean
Attribute FileDelete.VB_Description = "Borra el archivo especificado en el argumento sFileName. Debe establecer si el archivo es local o remoto con el parámetro sSite."
On Error GoTo errH
FileDelete = False ' assumes error by default
Select Case sSite
Case 0
Kill sFileName
If Err.Number = 0 Then FileDelete = True
Case 1
FileDelete = (FtpDeleteFile(m_InetConne
End Select
Exit Function
errH:
Err.Clear
FileDelete = False
End Function
Public Function FileRename(sOldName As String, sNewName As String, ByVal sSite As enumSITE) As Boolean
Attribute FileRename.VB_Description = "Renombra el archivo especificado en el prámetro sOldName con el nombre de archivo especificado en el parámetro sNewName. Esttablezca el parámetro sSite para determinar si el archivo es local o remoto."
On Error GoTo errH
Select Case sSite
Case 0
Name sOldName As sNewName
If Err.Number = 0 Then _
FileRename = True
Case 1
FileRename = (FtpRenameFile(m_InetConne
End Select
Exit Function
errH:
Err.Clear
FileRename = False
End Function
Public Function EnumFilesLocal(sPath As String, _
lFileType As VbFileAttribute, _
ByRef intFilesFound As Integer, _
Optional sExtension As String = "*.*") As String()
Attribute EnumFilesLocal.VB_Descript
Dim sFileName() As String
Dim sFullName As String
Dim sPathTmp As String, sExtensionTmp As String
Dim idx As Integer, ret As String
On Error Resume Next
' cheking backslash...
If Right$(sPath, 1) <> "\" Then
sPathTmp = sPath & "\"
End If
If Left$(sExtension, 1) = "\" Then
sExtensionTmp = Mid$(sExtension, 2)
End If
' *********************
sFullName = sPathTmp & sExtensionTmp
ret = Dir$(sFullName, lFileType)
Do While ret <> ""
If ret <> "." Or ret <> ".." Then
ReDim Preserve sFileName(idx)
sFileName(idx) = sPath & ret
idx = idx + 1
End If
ret = Dir$()
Loop
intFilesFound = idx
EnumFilesLocal = sFileName
End Function
Public Function CreateInetConnection() As Boolean
' call default inet connection by itself.
On Error GoTo errH
bolAutoConnect = (InternetAutodial(INTERNET
CreateInetConnection = bolAutoConnect
Exit Function
errH:
Err.Clear
CreateInetConnection = False
End Function
'NOTE: this class works in sync which means that no return from calling functions woulb be until finished each step.
Go to www.freevbcode.com and doa search for FTP, you would be surprised in waht you will found.
Also at www.planet-source-code.com
Cheers
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CFTP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
' Constantes:
Private Const MAX_PATH = 260
'************
' Tipos:
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private 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
' **************************
' Variables
Private m_InetConnect As Long
Private m_InetSession As Long
' **************************
' Enum
#If VBA = 0 Then
Public Enum enumAccessType
ACCESSDEFAULT = 0
ACCESSDIRECT = 1
ACCESSPROXY = 3
End Enum
Public Enum enumService
sFTP = 1
sGOPHER = 2
sHTTP = 3
End Enum
Public Enum enumTransferType
ttASCII = 1
ttBINARY = 2
End Enum
Public Enum enumSITE
SITELOCAL = 0
SITEREMOTE = 1
End Enum
#Else
'enum AccessType replacing constant
Const ACCESSDEFAULT = 0
Const ACCESSDIRECT = 1
Const ACCESSPROXY = 3
'enum Service replacing constant
Const sFTP = 1
Const sGOPHER = 2
constsHTTP = 3
'enum TransferType replacing constant
Const ttASCCI = 1
Const ttBINARY = 2
'enum SITE replacing constant
Const SITELOCAL = 0
Const SITEREMOTE = 1
#End If
' ********
' API: Conexión/desconexión
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, _
ByVal nServerPort As Integer, ByVal sUsername As String, _
ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
' **************************
' API: Manage Files
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" _
(ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private 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
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
'**********
' Manage directories
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long
Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
' *********************
' Resolving Local host...
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const IP_SUCCESS As Long = 0
Private Const MAX_WSADescription As Long = 256
Private Const MAX_WSASYSStatus As Long = 128
Private Const WS_VERSION_REQD As Long = &H101
Private Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Private Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Private Const MIN_SOCKETS_REQD As Long = 1
Private Const SOCKET_ERROR As Long = -1
Private Type WSADATA
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Long
wMaxUDPDG As Long
dwVendorInfo As Long
End Type
Private Declare Function gethostbyname Lib "WSOCK32.DLL" _
(ByVal hostname As String) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(xDest As Any, _
xSource As Any, _
ByVal nbytes As Long)
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Private Declare Function WSAStartup Lib "WSOCK32.DLL" _
(ByVal wVersionRequired As Long, _
lpWSADATA As WSADATA) As Long
Private Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long
'*************
' Internet connection
Private ConnState As Long
Private bolAutoConnect As Boolean
Private Const INTERNET_AUTODIAL_FORCE_ON
Private Const INTERNET_AUTODIAL_FORCE_UN
Private Declare Function InternetGetConnectedState Lib "wininet" (lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
Private Declare Function InternetAutodial Lib "wininet" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Boolean
Private Declare Function InternetAutodialHangup Lib "wininet" (ByVal dwReserved As Long) As Boolean
Public Function IsInetConnected() As Boolean
' check for an active connection
' to Internet.
On Error GoTo errH
Dim flags As Long
IsInetConnected = (InternetGetConnectedState
Exit Function
errH:
IsInetConnected = False
Exit Function
End Function
Public Function FTPCreateFolder(strFolderN
On Error GoTo errH
FTPCreateFolder = (FtpCreateDirectory(m_Inet
Exit Function
errH:
Err.Clear
FTPCreateFolder = False
End Function
Public Function FTPDeleteFolder(strFolderN
On Error GoTo errH
FTPDeleteFolder = (FtpRemoveDirectory(m_Inet
Exit Function
errH:
Err.Clear
FTPDeleteFolder = False
End Function
Public Function FTPGetCurrDir() As String
Attribute FTPGetCurrDir.VB_Descripti
On Error GoTo errH
If m_InetConnect <> 0 Then
Dim sRemotePath As String
sRemotePath = String$(MAX_PATH, 32)
FtpGetCurrentDirectory m_InetConnect, sRemotePath, MAX_PATH
sRemotePath = Trim$(sRemotePath)
FTPGetCurrDir = Left$(sRemotePath, Len(sRemotePath) - 1)
End If
Exit Function
errH:
Err.Clear
FTPGetCurrDir = False
End Function
Public Function FTPOpenSession(ByVal lAccessType As enumAccessType, _
Optional sProxyName As String = "Local Machine", _
Optional sBypassedIPs As String = vbNullString) As Boolean
Attribute FTPOpenSession.VB_Descript
'lAccessType:
'AccessDefault = 0
'AccessDirect = 1
'AccessProxy = 3
On Error GoTo errH
FTPOpenSession = False ' assumes error by default
Select Case lAccessType
Case 1, 0
m_InetSession = InternetOpen("FILE TRANSFER FTP Server", _
lAccessType, _
vbNullString, _
vbNullString, _
0)
Case 3
If sProxyName = "Local Machine" Or sProxyName = vbNullString Then
If SocketsInitialize() Then
'pass the local host address to the function
Dim sHostName As String * 255
Dim ret As Long
ret = GetComputerName(sHostName,
If ret <> 0 Then
sHostName = Left$(sHostName, _
InStr(1, sHostName, Chr$(0), vbTextCompare) - 1)
m_InetSession = InternetOpen("FILE TRANSFER FTP Server", _
lAccessType, _
GetIPFromHostName(sHostNam
sBypassedIPs, 0)
End If
End If
Else
m_InetSession = InternetOpen("FILE TRANSFER FTP Server", _
lAccessType, _
sProxyName, _
sBypassedIPs, _
0)
End If
End Select
FTPOpenSession = (m_InetSession <> 0)
Exit Function
errH:
Err.Clear
FTPOpenSession = False
End Function
Public Function FTPSetCurrDir(sDir As String) As Boolean
Attribute FTPSetCurrDir.VB_Descripti
On Error GoTo errH
FTPSetCurrDir = (FtpSetCurrentDirectory(m_
Exit Function
errH:
Err.Clear
FTPSetCurrDir = False
End Function
Private Function SocketsInitialize() As Boolean
Dim WSAD As WSADATA
On Error GoTo errH
SocketsInitialize = (WSAStartup(WS_VERSION_REQ
Exit Function
errH:
Err.Clear
SocketsInitialize = False
End Function
Private Sub SocketsCleanup()
On Error Resume Next
If WSACleanup() <> 0 Then
MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
End If
End Sub
Private Function GetIPFromHostName(ByVal sHostName As String) As String
'converts a host name to an IP address.
On Error GoTo errH:
Dim nbytes As Long
Dim ptrHosent As Long
Dim ptrName As Long
Dim ptrAddress As Long
Dim ptrIPAddress As Long
Dim sAddress As String
sAddress = Space$(4)
ptrHosent = gethostbyname(sHostName & vbNullChar)
If ptrHosent <> 0 Then
'assign pointer addresses and offset
'The Address is offset 12 bytes from the start of
'the HOSENT structure. Note: Here we are retrieving
'only the first address returned. To return more than
'one, define sAddress as a string array and loop through
'the 4-byte ptrIPAddress members returned. The last
'item is a terminating null. All addresses are returned
'in network byte order.
ptrAddress = ptrHosent + 12
'get the IP address
CopyMemory ptrAddress, ByVal ptrAddress, 4
CopyMemory ptrIPAddress, ByVal ptrAddress, 4
CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
GetIPFromHostName = IPToText(sAddress)
End If
Exit Function
errH:
Err.Clear
GetIPFromHostName = ""
End Function
Private Function IPToText(ByVal IPAddress As String) As String
On Error Resume Next
IPToText = CStr(Asc(IPAddress)) & "." & _
CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function
Public Function EnumFilesFTP(Optional sExtension As String = "*.*", Optional dwAttributes As VbFileAttribute = vbArchive)
On Error GoTo errH
Dim bSkip As Boolean
Dim arrFiles As FFiles
Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
'create a buffer
pData.cFileName = String(MAX_PATH, 0)
'find the first file
hFind = FtpFindFirstFile(m_InetCon
'if there's no file, then exit sub
If hFind = 0 Then
Set arrFiles = Nothing
Exit Function
End If
'show the filename
Dim fname As String
fname = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
bSkip = (dwAttributes And pData.dwFileAttributes) <> dwAttributes
If fname <> "." And Not bSkip Then
idx = idx + 1
ReDim arrFiles(idx)
arrFiles(idx) = fname
End If
Do
'create a buffer
pData.cFileName = String(MAX_PATH, 0)
'find the next file
lRet = InternetFindNextFile(hFind
'if there's no next file, exit do
If lRet = 0 Then Exit Do
'show the filename
fname = Left$(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
bSkip = (dwAttributes And pData.dwFileAttributes) <> dwAttributes
If fname <> ".." And Not bSkip Then
idx = idx + 1
ReDim Preserve arrFiles(idx)
arrFiles(idx) = fname
End If
Loop
'close the search handle
InternetCloseHandle hFind
'returns names of files found and quantity
intFilesFound = idx
EnumFilesFTP = arrFiles
Exit Function
errH:
Err.Clear
End Function
' *************
Public Function FTPConnect(sSvrFTP As String, _
SUser As String, _
sPwd As String, _
sService As enumService, _
Optional iFTPSvrPort As Integer = 21) _
As Boolean
Attribute FTPConnect.VB_Description = "Establece la conexión con el servidor FTP."
On Error GoTo errH
If m_InetSession <> 0 Then
m_InetConnect = InternetConnect(m_InetSess
End If
FTPConnect = (m_InetConnect <> 0)
Exit Function
errH:
Err.Clear
FTPConnect = False
End Function
Public Sub FTPCloseSession()
Attribute FTPCloseSession.VB_Descrip
On Error Resume Next
InternetCloseHandle m_InetConnect
InternetCloseHandle m_InetSession
If bolAutoConnect Then InternetAutodialHangup 0
End Sub
Public Function FTPGet(sRemoteFile As String, sLocalFile As String, Optional TransferType As enumTransferType = ttBINARY) As Boolean
Attribute FTPGet.VB_Description = "Obtiene una copia del archivo ubicadi¿o en el servidor FTP (sRemoteFile) y lo guarda localmente en el path y nombre especificado en el parámetro sLocalFile. Si se omite el parámetro TransferType (ASCII o Binary), la transferencia se realizara en forma bi"
On Error Resume Next
FTPGet = (FtpGetFile(m_InetConnect,
Exit Function
errH:
Err.Clear
FTPGet = False
End Function
Public Function FTPPut(sLocalFile As String, sRemoteFile As String, Optional TransferType As enumTransferType = ttBINARY) As Boolean
Attribute FTPPut.VB_Description = "Envia una copia del archivo local al servidor FTP. Si el parámetro TransferType se omite, la transferencia se realizará en formato Binario."
On Error GoTo errH
FTPPut = False ' assumes error by default
FTPPut = (FtpPutFile(m_InetConnect,
Exit Function
errH:
Err.Clear
FTPPut = False
End Function
Public Function FileDelete(ByVal sFileName As String, ByVal sSite As enumSITE) As Boolean
Attribute FileDelete.VB_Description = "Borra el archivo especificado en el argumento sFileName. Debe establecer si el archivo es local o remoto con el parámetro sSite."
On Error GoTo errH
FileDelete = False ' assumes error by default
Select Case sSite
Case 0
Kill sFileName
If Err.Number = 0 Then FileDelete = True
Case 1
FileDelete = (FtpDeleteFile(m_InetConne
End Select
Exit Function
errH:
Err.Clear
FileDelete = False
End Function
Public Function FileRename(sOldName As String, sNewName As String, ByVal sSite As enumSITE) As Boolean
Attribute FileRename.VB_Description = "Renombra el archivo especificado en el prámetro sOldName con el nombre de archivo especificado en el parámetro sNewName. Esttablezca el parámetro sSite para determinar si el archivo es local o remoto."
On Error GoTo errH
Select Case sSite
Case 0
Name sOldName As sNewName
If Err.Number = 0 Then _
FileRename = True
Case 1
FileRename = (FtpRenameFile(m_InetConne
End Select
Exit Function
errH:
Err.Clear
FileRename = False
End Function
Public Function EnumFilesLocal(sPath As String, _
lFileType As VbFileAttribute, _
ByRef intFilesFound As Integer, _
Optional sExtension As String = "*.*") As String()
Attribute EnumFilesLocal.VB_Descript
Dim sFileName() As String
Dim sFullName As String
Dim sPathTmp As String, sExtensionTmp As String
Dim idx As Integer, ret As String
On Error Resume Next
' cheking backslash...
If Right$(sPath, 1) <> "\" Then
sPathTmp = sPath & "\"
End If
If Left$(sExtension, 1) = "\" Then
sExtensionTmp = Mid$(sExtension, 2)
End If
' *********************
sFullName = sPathTmp & sExtensionTmp
ret = Dir$(sFullName, lFileType)
Do While ret <> ""
If ret <> "." Or ret <> ".." Then
ReDim Preserve sFileName(idx)
sFileName(idx) = sPath & ret
idx = idx + 1
End If
ret = Dir$()
Loop
intFilesFound = idx
EnumFilesLocal = sFileName
End Function
Public Function CreateInetConnection() As Boolean
' call default inet connection by itself.
On Error GoTo errH
bolAutoConnect = (InternetAutodial(INTERNET
CreateInetConnection = bolAutoConnect
Exit Function
errH:
Err.Clear
CreateInetConnection = False
End Function
'NOTE: this class works in sync which means that no return from calling functions woulb be until finished each step.
Go to www.freevbcode.com and doa search for FTP, you would be surprised in waht you will found.
Also at www.planet-source-code.com
Cheers