Attribute VB_Name = "modFTP" Option Explicit '============================================================================================================= ' ' modFTP Module ' ------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Created On : February 13, 2001 ' Last Update : April 17, 2004 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : modWININET.bas (WININET.DLL interface module by Kevin Wilson - Wilson Media) ' At least IE 3.0 or an operating system that comes with at least IE 3.0 pre-installed. ' ' NOTE : The "FTP_Command" function requires IE 5.0 or an operating system that comes with at least ' IE 5.0 pre-installed. ' ' Description : This module gives you full access to all the documented functions of the WININET.DLL and all ' of the types (structures) and constants that are required to make use of those functions. ' ' See Also : http://msdn.microsoft.com/workshop/networking/wininet/reference/functions/all_functions.asp ' http://msdn.microsoft.com/workshop/networking/wininet/overview/appendix_a.asp ' http://msdn.microsoft.com/workshop/networking/wininet/overview/ftp.asp ' http://msdn.microsoft.com/workshop/networking/wininet/overview/introduction.asp ' ' Example: ' ' Dim ReturnString As String ' Dim FileSize As Variant ' Dim FileAttrib As Long ' Dim TimeCreated As String ' Dim TimeAccess As String ' Dim TimeWrite As String ' ' ' Check if there's an active internet connection ' If FTP_CheckIfConnected = False Then ' MsgBox "You are NOT currently connected to the internet.", vbOKOnly + vbExclamation, " Can't Continue" ' Exit Sub ' End If ' ' ' Establish a connection ' If FTP_Connect("ftp.someserver.com", , "UserName", "Password", , , True) = False Then Exit Sub ' ' ' Get a complete listing of the files and directories in the current directory ' If FTP_Dir(ReturnString, "SubDirectoryName") = True Then MsgBox ReturnString ' ' ' Get the current directory ' If FTP_GetCurDir(ReturnString) = True Then MsgBox "Current Dir = " & ReturnString ' ' ' Create a direcotry in the current directory ' If FTP_CreateDir("TESTING") = True Then MsgBox "Create Dir = SUCCESS" ' ' ' Get the information about the specified file ' If FTP_Attrib("TESTING", FileSize, FileAttrib, TimeCreated, TimeAccess, TimeWrite) = True Then ' MsgBox "File = TESTING, " & vbCrLf & _ ' "Size = " & FileSize & vbCrLf & _ ' "Time Created = " & TimeCreated & vbCrLf & _ ' "Time Last Accessed = " & TimeAccess & vbCrLf & _ ' "Time Last Written = " & TimeWrite & vbCrLf & _ ' "Attrib Archive = " & ((FileAttrib And FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE) & vbCrLf & _ ' "Attrib Compressed = " & ((FileAttrib And FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED) & vbCrLf & _ ' "Attrib Directory = " & ((FileAttrib And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) & vbCrLf & _ ' "Attrib Encrypted = " & ((FileAttrib And FILE_ATTRIBUTE_ENCRYPTED) = FILE_ATTRIBUTE_ENCRYPTED) & vbCrLf & _ ' "Attrib Hidden = " & ((FileAttrib And FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN) & vbCrLf & _ ' "Attrib Normal = " & ((FileAttrib And FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL) & vbCrLf & _ ' "Attrib Offline = " & ((FileAttrib And FILE_ATTRIBUTE_OFFLINE) = FILE_ATTRIBUTE_OFFLINE) & vbCrLf & _ ' "Attrib Read-Only = " & ((FileAttrib And FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY) & vbCrLf & _ ' "Attrib System = " & ((FileAttrib And FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM) & vbCrLf & _ ' "Attrib Temporary = " & ((FileAttrib And FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY), vbOKOnly + vbInformation, " FTP File Information" ' End If ' ' ' Rename the directory ' If FTP_Rename("TESTING", "TEST_NEW") = True Then ' ' Remove the directory (new name) ' If FTP_DeleteDir("TEST_NEW") = True Then MsgBox "Delete Dir = SUCCESS" ' Else ' ' Remove the directory (original name) ' If FTP_DeleteDir("TESTING") = True Then MsgBox "Delete Dir = SUCCESS" ' End If ' ' ' Download a file ' If FTP_DownloadFile("Image.bmp", "C:\Image.bmp", True, True, FTP_TRANSFER_TYPE_BINARY) = True Then MsgBox "Download File = SUCCESS" ' ' ' Upload a file ' If FTP_UploadFile("C:\Image.bmp", "Image.bmp", True, True, FTP_TRANSFER_TYPE_BINARY) = True Then MsgBox "Upload File = SUCCESS" ' ' ' Set the current directory ' If FTP_SetCurDir("SubDirectoryName") = True Then MsgBox "Changed Dir = SUCCESS" ' ' ' Get the current directory ' If FTP_GetCurDir(ReturnString) = True Then MsgBox "Current Dir = " & ReturnString ' ' ' Disconnect ' FTP_Disconnect ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= ' Constants - FtpGetFile.dwFlags / FtpOpenFile.dwFlags / FtpPutFile.dwFlags / GopherFindFirstFile.dwFlags / GopherOpenFile.dwFlags Private Enum FileTransferTypes FTP_TRANSFER_TYPE_ASCII = &H1 ' Transfers the file using FTP's ASCII (Type A) transfer method. Control and formatting information is converted to local equivalents. FTP_TRANSFER_TYPE_BINARY = &H2 ' Transfers the file using FTP's Image (Type I) transfer method. The file is transferred exactly as it exists with no changes. This is the default transfer method. FTP_TRANSFER_TYPE_UNKNOWN = &H0 ' Defaults to FTP_TRANSFER_TYPE_BINARY. INTERNET_FLAG_TRANSFER_ASCII = &H1 ' Transfers the file as ASCII. INTERNET_FLAG_TRANSFER_BINARY = &H2 ' Transfers the file as binary. INTERNET_FLAG_HYPERLINK = &H400 ' Forces a reload if there was no Expires time and no LastModified time returned from the server when determining whether to reload the item from the network. INTERNET_FLAG_NEED_FILE = &H10 ' Causes a temporary file to be created if the file cannot be cached. INTERNET_FLAG_RELOAD = &H80000000 ' Forces a download of the requested file, object, or directory listing from the origin server, not from the cache. INTERNET_FLAG_RESYNCHRONIZE = &H800 ' Reloads HTTP resources if the resource has been modified since the last time it was downloaded. All FTP and Gopher resources are reloaded. End Enum ' Constants - WIN32_FIND_DATA.dwFileAttributes Private Enum FileAttributes FILE_ATTRIBUTE_ARCHIVE = &H20 ' The file or directory is an archive file or directory. Applications use this attribute to mark files for backup or removal. FILE_ATTRIBUTE_COMPRESSED = &H800 ' The file or directory is compressed. For a file, this means that all of the data in the file is compressed. For a directory, this means that compression is the default for newly created files and subdirectories. FILE_ATTRIBUTE_DIRECTORY = &H10 ' The handle identifies a directory. FILE_ATTRIBUTE_ENCRYPTED = &H4000 ' The file or directory is encrypted. For a file, this means that all data in the file is encrypted. For a directory, this means that encryption is the default for newly created files and subdirectories. FILE_ATTRIBUTE_HIDDEN = &H2 ' The file or directory is hidden. It is not included in an ordinary directory listing. FILE_ATTRIBUTE_NORMAL = &H80 ' The file or directory has no other attributes set. This attribute is valid only if used alone. FILE_ATTRIBUTE_OFFLINE = &H1000 ' The file data is not immediately available. This attribute indicates that the file data has been physically moved to offline storage. This attribute is used by Remote Storage, the hierarchical storage management software in Windows 2000. Applications should not arbitrarily change this attribute. FILE_ATTRIBUTE_READONLY = &H1 ' The file or directory is read-only. Applications can read the file but cannot write to it or delete it. In the case of a directory, applications cannot delete it. FILE_ATTRIBUTE_SYSTEM = &H4 ' The file or directory is part of the operating system or is used exclusively by the operating system. FILE_ATTRIBUTE_TEMPORARY = &H100 ' The file is being used for temporary storage. File systems attempt to keep all of the data in memory for quicker access, rather than flushing it back to mass storage. A temporary file should be deleted by the application as soon as it is no longer needed. End Enum ' Constants - InternetOpen.dwFlags Private Const INTERNET_FLAG_ASYNC = &H10000000 'Makes only asynchronous requests on handles descended from the handle returned from this function. Private Const INTERNET_FLAG_FROM_CACHE = &H1000000 'Does not make network requests. All entities are returned from the cache. If the requested item is not in the cache, a suitable error, such as ERROR_FILE_NOT_FOUND, is returned. Private Const INTERNET_FLAG_OFFLINE = INTERNET_FLAG_FROM_CACHE ' Identical to INTERNET_FLAG_FROM_CACHE. Does not make network requests. All entities are returned from the cache. If the requested item is not in the cache, a suitable error, such as ERROR_FILE_NOT_FOUND, is returned. ' Constants - Columns for "FTP_Dir" return Private Const COLUMN_TOTAL = 6 Private Const COLUMN_NAME = 0 Private Const COLUMN_SIZE = 1 Private Const COLUMN_ATTRIBS = 2 Private Const COLUMN_DATE_CREATE = 3 Private Const COLUMN_DATE_ACCESS = 4 Private Const COLUMN_DATE_WRITE = 5 ' Variables used to keep track of the current internet connection Public hInternet As Long Public hConnect As Long Public hConnect1 As Long Public bConnected As Boolean Public bCallback As Boolean Private sCurrenDir As String ' Variables used to keep track of the FTP server to connect to Public sFtpAddress As String Public iServerPort As Integer Public bPassive As Boolean Public bAnonymous As Boolean Public sUserName As String Public sPassword As String ' Constants used with Win32 API calls within this module Public Const INVALID_HANDLE_VALUE = -1 ' Win32 API Function Declarations Public Declare Function FindFirstFile Lib "KERNEL32.DLL" Alias "FindFirstFileA" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long 'BOOL Public Declare Function FindNextFile Lib "KERNEL32.DLL" Alias "FindNextFileA" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long 'BOOL Public Declare Function FindClose Lib "KERNEL32.DLL" (ByVal hFindFile As Long) As Long 'BOOL '============================================================================================================= ' FTP_Attrib ' ' Purpose : ' Returns the file size, file times, and file attributes for the specified file or directory. This function ' (along with the FTP_GetFileSize function) can be used to check if the specified file exists on the FTP server. ' ' Param Use ' ------------------------------------ ' Dir_Or_File_Name The name of the file or directory to get information about ' Return_FileSize Optional. Returns the size of the file or directory ' Return_FileAttributes Optional. Returns a long value that contains the FILE_ATTRIBUTE_* flags for the file/dir ' Return_TimeCreated Optional. Returns the date & time that the file was created (not always available) ' Return_TimeLastAccess Optional. Returns the date & time that the file was last accessed (not always available) ' Return_TimeLastWrite Optional. Returns the date & time that the file was last written to ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_Attrib(ByVal Dir_Or_File_Name As String, _ Optional ByRef Return_FileSize As Variant, _ Optional ByRef Return_FileAttributes As Long, _ Optional ByRef Return_TimeCreated As String, _ Optional ByRef Return_TimeLastAccess As String, _ Optional ByRef Return_TimeLastWrite As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim FileData As WIN32_FIND_DATA Dim TestFileName As String Dim hFirstFile As Long Dim bFoundIt As Boolean ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" Return_FileSize = 0 Return_FileAttributes = 0 Return_TimeCreated = "" Return_TimeLastAccess = "" Return_TimeLastWrite = "" ' Make sure the parameters passed are valid If Trim(Dir_Or_File_Name) = "" Or Trim(Dir_Or_File_Name) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Attrib()" Return_ErrDesc = "No file or directory specified to retrieve attributes for." Exit Function End If ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect1 = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Attrib()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Make sure the string is NULL terminated If Right(Dir_Or_File_Name, 1) <> Chr(0) Then Dir_Or_File_Name = Dir_Or_File_Name & Chr(0) ' Get the information for the first file of the current directory hFirstFile = FtpFindFirstFile(hConnect1, vbNullString, FileData, INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0) If hFirstFile = 0 Then GetLastErrMsg Err.LastDllError, "FtpFindFirstFile", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_Attrib >> FtpFindFirstFile" Exit Function End If ' Check if it's the right one TestFileName = FileData.cFileName TestFileName = Trim(Left(TestFileName, InStr(TestFileName, Chr(0)) - 1)) If UCase(TestFileName & Chr(0)) = UCase(Trim(Dir_Or_File_Name)) Then bFoundIt = True ' Loop through all the following files until there are no more files If bFoundIt = False Then Do While InternetFindNextFile_FTP(hFirstFile, FileData) <> 0 TestFileName = FileData.cFileName TestFileName = Trim(Left(TestFileName, InStr(TestFileName, Chr(0)) - 1)) If UCase(TestFileName & Chr(0)) = UCase(Trim(Dir_Or_File_Name)) Then bFoundIt = True Exit Do End If Loop End If ' Return the data that was collected from the file If bFoundIt = True Then Return_FileSize = (FileData.nFileSizeHigh * (MAXDWORD + 1)) + FileData.nFileSizeLow Return_FileAttributes = FileData.dwFileAttributes Return_TimeCreated = "" If FileData.ftCreationTime <> 0 Then Return_TimeCreated = CStr(FiletimeToDate(FileData.ftCreationTime)) Return_TimeLastAccess = "" If FileData.ftLastAccessTime <> 0 Then Return_TimeLastAccess = CStr(FiletimeToDate(FileData.ftLastAccessTime)) Return_TimeLastWrite = "" If FileData.ftLastWriteTime <> 0 Then Return_TimeLastWrite = CStr(FiletimeToDate(FileData.ftLastWriteTime)) FTP_Attrib = True Else Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Attrib()" Return_ErrDesc = "The file or directory by the name " & Chr(34) & Left(Dir_Or_File_Name, Len(Dir_Or_File_Name) - 1) & Chr(34) & " was not found in the current directory on the FTP server." End If ' Calling the "FtpFindFirstFile" API makes the hConnect1 handle INVALID... so it must be ' disconnected and reconnected to continue using it properly FTP_Dis hConnect1 FTP_Con hConnect1 ' Reset the current directory If Right(sCurrenDir, 1) <> Chr(0) Then sCurrenDir = sCurrenDir & Chr(0) If FtpSetCurrentDirectory(hConnect1, sCurrenDir) <> 0 Then FTP_Attrib = True Else GetLastErrMsg Err.LastDllError, "FtpSetCurrentDirectory", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_Attrib >> FtpSetCurrentDirectory" End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_CheckIfConnected ' ' Purpose : ' Tells you if the user is currently connected to the internet. ' ' Param Use ' ------------------------------------ ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_CheckIfConnected(Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" If InternetAttemptConnect(0) = ERROR_SUCCESS Then FTP_CheckIfConnected = True Else GetLastErrMsg Err.LastDllError, "InternetAttemptConnect", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_CheckIfConnected >> InternetAttemptConnect" End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_Command ' ' Purpose : ' Sends the specified command to the FTP server that the user is currently connected to. ' ' * NOTE : This is the only function that requires Internet Explorer 5.0 to work correctly ' ' Param Use ' ------------------------------------ ' strCommand Specifies the command to send to the FTP server ' FTP_Transfer_Type Optional. Specifies if the file transfer should be done using FTP's ASCII (Type A) ' transfer method, or FTP's Image/binary (Type I) transfer method. If ' FTP_TRANSFER_TYPE_UNKNOWN is specified, binary is used. ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_Command(ByVal strCommand As String, _ Optional ByVal FTP_Transfer_Type As Long = FTP_TRANSFER_TYPE_UNKNOWN, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Make sure the parameters passed are valid If Trim(strCommand) = "" Or Trim(strCommand) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Command()" Return_ErrDesc = "No FTP command specified to send." Exit Function End If If FTP_Transfer_Type = FTP_TRANSFER_TYPE_UNKNOWN Then FTP_Transfer_Type = FTP_TRANSFER_TYPE_BINARY ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Command()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Make sure the string is NULL terminated If Right(strCommand, 1) <> Chr(0) Then strCommand = strCommand & Chr(0) ' Send the command and get the response If FtpCommand(hConnect, 0, FTP_Transfer_Type, strCommand, 0, 0) = 0 Then GetLastErrMsg Err.LastDllError, "FtpCommand", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_Command >> FtpCommand" Else FTP_Command = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_Connect ' ' Purpose : ' This function establishes a connection to the specified FTP server. ' ' * IMPORTANT - Make sure that you call the FTP_Disconnect function from this module to disconnect from the ' specified FTP server. ' ' Param Use ' ------------------------------------ ' FtpAddress Address of the FTP server to connect to (can be name, or IP) ' ServerPort Optional. The port that should be used to connect to the server (DEFAULT = 21) ' LogonAnonymously Optional. If set to TRUE, the Username and Password parameters are ignored and this ' function attempts to log into the specified FTP server anonymously. ' UserName Optional. Specifies the username to use to log into the FTP server ' Password Optional. Specifies the password to use to log into the FTP server ' PassiveConnect Optional. If set to true, this function uses passive FTP semantics for transfering ' ProxyServer Optional. If specified, this proxy server is used to make FTP requests. ' ApplicationName Optional. The name that will be used to connect (not really needed). If this is ' not specified, the "App.Title" property is used. ' UserCallback Optional. If set to TRUE, the "CallbackProc" function is sent messages by the ' WININET.DLL to let this application know what's going on. ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_Connect(ByVal FtpAddress As String, _ Optional ByVal ServerPort As Integer = 21, _ Optional ByVal LogonAnonymously As Boolean = False, _ Optional ByVal UserName As String, _ Optional ByVal Password As String, _ Optional ByVal PassiveConnect As Boolean = False, _ Optional ByVal ProxyServer As String, _ Optional ByVal ApplicationName As String, _ Optional ByVal UserCallback As Boolean = False, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim lngProxyFlag As Long Dim strProxyBypass As String ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Make sure passed parameters are valid If Trim(FtpAddress) = "" Or Trim(FtpAddress) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Connect()" Return_ErrDesc = "No FTP address specified to connect to." Exit Function ElseIf ApplicationName = "" Then ApplicationName = App.Title End If ' Get the proxy information ProxyServer = Trim(ProxyServer) If ProxyServer = "" Then ProxyServer = vbNullString strProxyBypass = vbNullString lngProxyFlag = INTERNET_OPEN_TYPE_PRECONFIG Else strProxyBypass = "" lngProxyFlag = INTERNET_OPEN_TYPE_PROXY End If ' Disconnect any existing connection FTP_Disconnect ' Open a connection to the internet hInternet = InternetOpen(ApplicationName & Chr(0), lngProxyFlag, ProxyServer & Chr(0), strProxyBypass, 0) If hInternet = 0 Then GetLastErrMsg Err.LastDllError, "InternetOpen", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_Connect >> InternetOpen" Exit Function End If ' If the user specified to, set the callback function If UserCallback = True Then If CallbackSetup(hInternet, , Return_ErrNum, Return_ErrSrc, Return_ErrDesc) = True Then bCallback = True Else Err.Raise -1, "FTP_Connect >> CallbackSetup", "Failed to successfully setup a callback for the internet connection" End If End If ' Remember the information for future use sFtpAddress = FtpAddress iServerPort = ServerPort bPassive = PassiveConnect bAnonymous = LogonAnonymously sUserName = UserName sPassword = Password ' Make a connection to the specified FTP server with the open connection just made If FTP_Con(hConnect, Return_ErrNum, Return_ErrSrc, Return_ErrDesc) = True Then If FTP_Con(hConnect1, Return_ErrNum, Return_ErrSrc, Return_ErrDesc) = True Then FTP_Connect = True bConnected = True Else FTP_Disconnect End If Else FTP_Disconnect End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_CreateDir ' ' Purpose : ' Creates the specified sub-directory in the current directory (use the FTP_SetCurDir function to change ' directories) ' ' Param Use ' ------------------------------------ ' DirName The name of the sub-directory to be created in the current directory ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_CreateDir(ByVal DirName As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Make sure parameters passed are valid If Trim(DirName) = "" Or Trim(DirName) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_CreateDir()" Return_ErrDesc = "No directory specified to create." Exit Function End If ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_CreateDir()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Make sure the string is NULL terminated If Right(DirName, 1) <> Chr(0) Then DirName = DirName & Chr(0) ' Set the current direcotry If FtpCreateDirectory(hConnect, DirName) = 0 Then GetLastErrMsg Err.LastDllError, "FtpCreateDirectory", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_CreateDir >> FtpCreateDirectory" Else FTP_CreateDir = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_DeleteDir ' ' Purpose : ' Deletes the specified sub-directory in the current directory ' ' Param Use ' ------------------------------------ ' DirName The name of the sub-directory to delete from the current directory ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_DeleteDir(ByVal DirName As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Make sure the parameters passed are valid If Trim(DirName) = "" Or Trim(DirName) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_DeleteDir()" Return_ErrDesc = "No directory specified to delete." Exit Function End If ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_DeleteDir()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Make sure the string is NULL terminated If Right(DirName, 1) <> Chr(0) Then DirName = DirName & Chr(0) ' Set the current direcotry If FtpRemoveDirectory(hConnect, DirName) = 0 Then GetLastErrMsg Err.LastDllError, "FtpRemoveDirectory", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_DeleteDir >> FtpRemoveDirectory" Else FTP_DeleteDir = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_DeleteFile ' ' Purpose : ' Deletes the specified file from the current directory ' ' Param Use ' ------------------------------------ ' FileName Name of the file to delete ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_DeleteFile(ByVal FileName As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Make sure the parameters passed are valid If Trim(FileName) = "" Or Trim(FileName) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_DeleteFile()" Return_ErrDesc = "No file specified to delete." Exit Function End If ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_DeleteFile()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Make sure the string is NULL terminated If Right(FileName, 1) <> Chr(0) Then FileName = FileName & Chr(0) ' Set the current direcotry If FtpDeleteFile(hConnect, FileName) = 0 Then GetLastErrMsg Err.LastDllError, "FtpDeleteFile", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_DeleteFile >> FtpDeleteFile" Else FTP_DeleteFile = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_Dir ' ' Purpose : ' Retrieves a listing of all the files and folders in the current directory. The results are returned in ' the form of a string with each line seperated by a CR + LF (vbCrLf). ' ' Param Use ' ------------------------------------ ' Return_String Recieves the directory information ' DirectoryToGet Optional. Specifies a directory other than the current one to get the information ' from. If this is left out, the current directory is retrieved. ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_Dir(ByRef Return_InformationGrid As Variant, _ Optional ByRef Return_RowCount As Long, _ Optional ByRef Return_ColCount As Long, _ Optional ByVal DirectoryToGet As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim hFirstFile As Long Dim WFD_Find As WIN32_FIND_DATA ' Set return values to defaults Return_RowCount = -1 Return_ColCount = -1 If IsArray(Return_InformationGrid) = True Then Erase Return_InformationGrid Return_InformationGrid = Empty Return_ErrNum = 0 Return_ErrDesc = "" Return_ErrSrc = "" ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect1 = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Dir()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Find the first file If Right(DirectoryToGet, 1) <> Chr(0) Then DirectoryToGet = DirectoryToGet & Chr(0) hFirstFile = FtpFindFirstFile(hConnect1, DirectoryToGet, WFD_Find, INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD, 0) If hFirstFile = 0 Then GetLastErrMsg Err.LastDllError, "FtpFindFirstFile", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_Dir >> FtpFindFirstFile" Exit Function End If ' Setup the variables that hold the information Return_ColCount = COLUMN_TOTAL Return_RowCount = 1 ReDim Return_InformationGrid(0 To COLUMN_TOTAL - 1, 0 To Return_RowCount - 1) As Variant ' Set the values to be returned Return_InformationGrid(COLUMN_NAME, Return_RowCount - 1) = Left(WFD_Find.cFileName, InStr(WFD_Find.cFileName, Chr(0)) - 1) Return_InformationGrid(COLUMN_SIZE, Return_RowCount - 1) = (WFD_Find.nFileSizeHigh * (MAXDWORD + 1)) + WFD_Find.nFileSizeLow Return_InformationGrid(COLUMN_ATTRIBS, Return_RowCount - 1) = WFD_Find.dwFileAttributes Return_InformationGrid(COLUMN_DATE_CREATE, Return_RowCount - 1) = "" If WFD_Find.ftCreationTime <> 0 Then Return_InformationGrid(COLUMN_DATE_CREATE, Return_RowCount - 1) = CStr(FiletimeToDate(WFD_Find.ftCreationTime)) Return_InformationGrid(COLUMN_DATE_ACCESS, Return_RowCount - 1) = "" If WFD_Find.ftLastAccessTime <> 0 Then Return_InformationGrid(COLUMN_DATE_ACCESS, Return_RowCount - 1) = CStr(FiletimeToDate(WFD_Find.ftLastAccessTime)) Return_InformationGrid(COLUMN_DATE_WRITE, Return_RowCount - 1) = "" If WFD_Find.ftLastWriteTime <> 0 Then Return_InformationGrid(COLUMN_DATE_WRITE, Return_RowCount - 1) = CStr(FiletimeToDate(WFD_Find.ftLastWriteTime)) ' Loop through all the following files until there are no more files Do While InternetFindNextFile_FTP(hFirstFile, WFD_Find) <> 0 ' Setup the variables that hold the information Return_RowCount = Return_RowCount + 1 ReDim Preserve Return_InformationGrid(0 To COLUMN_TOTAL - 1, 0 To Return_RowCount - 1) As Variant ' Set the values to be returned Return_InformationGrid(COLUMN_NAME, Return_RowCount - 1) = Left(WFD_Find.cFileName, InStr(WFD_Find.cFileName, Chr(0)) - 1) Return_InformationGrid(COLUMN_SIZE, Return_RowCount - 1) = (WFD_Find.nFileSizeHigh * (MAXDWORD + 1)) + WFD_Find.nFileSizeLow Return_InformationGrid(COLUMN_ATTRIBS, Return_RowCount - 1) = WFD_Find.dwFileAttributes Return_InformationGrid(COLUMN_DATE_CREATE, Return_RowCount - 1) = "" If WFD_Find.ftCreationTime <> 0 Then Return_InformationGrid(COLUMN_DATE_CREATE, Return_RowCount - 1) = CStr(FiletimeToDate(WFD_Find.ftCreationTime)) Return_InformationGrid(COLUMN_DATE_ACCESS, Return_RowCount - 1) = "" If WFD_Find.ftLastAccessTime <> 0 Then Return_InformationGrid(COLUMN_DATE_ACCESS, Return_RowCount - 1) = CStr(FiletimeToDate(WFD_Find.ftLastAccessTime)) Return_InformationGrid(COLUMN_DATE_WRITE, Return_RowCount - 1) = "" If WFD_Find.ftLastWriteTime <> 0 Then Return_InformationGrid(COLUMN_DATE_WRITE, Return_RowCount - 1) = CStr(FiletimeToDate(WFD_Find.ftLastWriteTime)) Loop ' Calling the "FtpFindFirstFile" API makes the hConnect1 handle INVALID... so it must be ' disconnected and reconnected to continue using it properly FTP_Dis hConnect1 FTP_Con hConnect1 ' Reset the current directory If Right(sCurrenDir, 1) <> Chr(0) Then sCurrenDir = sCurrenDir & Chr(0) If FtpSetCurrentDirectory(hConnect1, sCurrenDir) <> 0 Then FTP_Dir = True Else GetLastErrMsg Err.LastDllError, "FtpSetCurrentDirectory", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_Dir >> FtpSetCurrentDirectory" End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_Disconnect ' ' Purpose : ' Disconnects the current connection to the internet and FTP server. You must call this function after ' calling the FTP_Connect function. ' ' Param Use ' ------------------------------------ ' None ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_Disconnect() As Boolean On Error Resume Next ' If the user specified to use the callback function, reset it If bCallback = True Then CallbackReset hInternet bCallback = False End If ' Disconnect the FTP connection first, then the internet connection If hConnect <> 0 Then InternetCloseHandle hConnect If hConnect1 <> 0 Then InternetCloseHandle hConnect1 If hInternet <> 0 Then InternetCloseHandle hInternet hConnect = 0 hConnect1 = 0 hInternet = 0 sFtpAddress = "" bAnonymous = False sUserName = "" sPassword = "" bPassive = False bConnected = False ' Function succeeded FTP_Disconnect = True End Function '============================================================================================================= ' FTP_DownloadFile ' ' Purpose : ' Downloads the specified file to the specified local location. ' ' Param Use ' ------------------------------------ ' RemoteFileName Specifies the file on the FTP server to download ' LocalFilePath Specifies where the file should be downloaded to ' CheckForOverwrite Optional. If set to FALSE, no checking is made to see if the file already exists on ' the local machine. If set to FALSE, this function will execute quicker and more ' efficiently, but may overwrite important data without the user knowing. ' PromptToOverwrite Optional. If set to true and the "CheckForOverwrite" parameter is set to FALSE and ' the file already exists on the local machine, the user is prompted to overwrite it. ' FTP_Transfer_Type Optional. Specifies if the file transfer should be done using FTP's ASCII (Type A) ' transfer method, or FTP's Image/binary (Type I) transfer method. If ' FTP_TRANSFER_TYPE_UNKNOWN is specified, binary is used. ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_DownloadFile(ByVal RemoteFileName As String, _ ByVal LocalFilePath As String, _ Optional ByVal CheckForOverwrite As Boolean = True, _ Optional ByVal PromptToOverwrite As Boolean = True, _ Optional ByVal FTP_Transfer_Type As Long = FTP_TRANSFER_TYPE_UNKNOWN, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim hOpenFile As Long Dim Attributes As Long Dim FileSize As Long ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Make sure the parameters passed are valid LocalFilePath = Trim(LocalFilePath) RemoteFileName = Trim(RemoteFileName) If LocalFilePath = "" Or LocalFilePath = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_DownloadFile()" Return_ErrDesc = "No file specified to download to." Exit Function ElseIf RemoteFileName = "" Or RemoteFileName = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_DownloadFile()" Return_ErrDesc = "No file specified to download." Exit Function End If ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_DownloadFile()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Check if the file already exists, and if so, check if it's OK to replace it If CheckForOverwrite = True Then If Dir(LocalFilePath, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" Then If PromptToOverwrite = True Then If MsgBox(LocalFilePath & Chr(13) & "This file already exists." & Chr(13) & "Replace existing file?", vbYesNo + vbExclamation, " Confirm File Overwrite") <> vbYes Then FTP_DownloadFile = True Exit Function Else SetAttr LocalFilePath, vbNormal: Kill LocalFilePath End If Else SetAttr LocalFilePath, vbNormal: Kill LocalFilePath End If End If Else On Error Resume Next If Dir(LocalFilePath, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) <> "" Then SetAttr LocalFilePath, vbNormal: Kill LocalFilePath End If Err.Clear On Error GoTo ErrorTrap End If ' Make sure the strings are NULL terminated If Right(RemoteFileName, 1) <> Chr(0) Then RemoteFileName = RemoteFileName & Chr(0) If Right(LocalFilePath, 1) <> Chr(0) Then LocalFilePath = LocalFilePath & Chr(0) ' Get the file's attributes (used to create the new file once downloaded with the same attributes) If FTP_Attrib(RemoteFileName, FileSize, Attributes, , , , Return_ErrNum, Return_ErrSrc, Return_ErrDesc) = False Then Exit Function ' Set the correct flags for transfer FTP_Transfer_Type = FTP_Transfer_Type Or INTERNET_FLAG_RELOAD Or INTERNET_FLAG_RESYNCHRONIZE ' Open the file for READ access If FtpGetFile(hConnect, RemoteFileName, LocalFilePath, 0, Attributes, FTP_Transfer_Type, 0) = 0 Then GetLastErrMsg Err.LastDllError, "FtpGetFile", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_DownloadFile >> FtpGetFile" Else FTP_DownloadFile = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_GetCurDir ' ' Purpose : ' Returns the full qualified path of the current directory on the FTP server ' ' Param Use ' ------------------------------------ ' Return_String Receives the current directory path ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_GetCurDir(ByRef Return_String As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" Return_String = "" ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_GetCurDir()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Get the current directory Return_String = String(MAX_PATH, Chr(0)) If FtpGetCurrentDirectory(hConnect, Return_String, MAX_PATH) = 0 Then GetLastErrMsg Err.LastDllError, "FtpGetCurrentDirectory", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_GetCurDir >> FtpGetCurrentDirectory" Else Return_String = Left(Return_String, InStr(Return_String, Chr(0)) - 1) If Right(Return_String, Len(vbCrLf)) = vbCrLf Then Return_String = Left(Return_String, Len(Return_String) - Len(vbCrLf)) FTP_GetCurDir = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_GetFileSize ' ' Purpose : ' Returns the size in bytes of the specified file. This function (along with the FTP_Attrib function) can ' be used to check if the specified file exists on the FTP server. ' ' Param Use ' ------------------------------------ ' FileName Name of the file on the FTP server to get the size of ' Return_FileSize Optional. Receives the size of the file in bytes ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_GetFileSize(ByVal FileName As String, _ Optional ByRef Return_FileSize As Variant, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim hFile As Long Dim SizeLoOrder As Long Dim SizeHiOrder As Long Dim LastErr As Long ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" Return_FileSize = 0 ' Make sure the parameters passed are valid If Trim(FileName) = "" Or Trim(FileName) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_GetFileSize()" Return_ErrDesc = "No file specified to get info from." Exit Function End If ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect1 = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_GetFileSize()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Make sure the string is NULL terminated If Right(FileName, 1) <> Chr(0) Then FileName = FileName & Chr(0) ' Open the file hFile = FtpOpenFile(hConnect1, FileName, GENERIC_READ, FTP_TRANSFER_TYPE_BINARY Or INTERNET_FLAG_RELOAD Or INTERNET_FLAG_RESYNCHRONIZE, 0) If hFile = 0 Then GetLastErrMsg Err.LastDllError, "FtpOpenFile", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_GetFileSize >> FtpOpenFile" Exit Function End If ' Get the file size SetLastError 0 SizeLoOrder = FtpGetFileSize(hFile, SizeHiOrder) LastErr = Err.LastDllError If LastErr <> 0 Then GetLastErrMsg LastErr, "FtpGetFileSize", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_GetFileSize >> FtpGetFileSize" Else Return_FileSize = (SizeHiOrder * (MAXDWORD + 1)) + SizeLoOrder FTP_GetFileSize = True End If ' Close the file InternetCloseHandle hFile Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_Rename ' ' Purpose : ' Renames the specified file *OR* folder in the current FTP directory ' ' Param Use ' ------------------------------------ ' CurrentName Current name of the file or folder ' NewName Name to rename the file or folder to ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_Rename(ByVal CurrentName As String, _ ByVal NewName As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Make sure the parameters passed are valid If Trim(CurrentName) = "" Or Trim(CurrentName) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Rename()" Return_ErrDesc = "No file or directory specified to rename." Exit Function ElseIf Trim(NewName) = "" Or Trim(NewName) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Rename()" Return_ErrDesc = "Invalid name specified to rename the file or directory to." Exit Function End If ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_Rename()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Make sure the string is NULL terminated If Right(CurrentName, 1) <> Chr(0) Then CurrentName = CurrentName & Chr(0) If Right(NewName, 1) <> Chr(0) Then NewName = NewName & Chr(0) ' Rename the file or directory If FtpRenameFile(hConnect, CurrentName, NewName) = 0 Then GetLastErrMsg Err.LastDllError, "FtpRenameFile", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_Rename >> FtpRenameFile" Else FTP_Rename = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_SetCurDir ' ' Purpose : ' Sets the current directory on the FTP server ' ' Param Use ' ------------------------------------ ' DirName Name or path to the directory to change to ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_SetCurDir(ByVal DirName As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Make sure parameters passed are valid If Trim(DirName) = "" Or Trim(DirName) = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_SetCurDir()" Return_ErrDesc = "No directory specified to change to." Exit Function End If ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect = 0 Or hConnect1 = 0 Then Call FTP_Disconnect Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_SetCurDir()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Make sure the string is NULL terminated If Right(DirName, 1) <> Chr(0) Then DirName = DirName & Chr(0) ' Set the current direcotry If FtpSetCurrentDirectory(hConnect, DirName) <> 0 Then If FtpSetCurrentDirectory(hConnect1, DirName) <> 0 Then If FTP_GetCurDir(sCurrenDir, Return_ErrNum, Return_ErrSrc, Return_ErrDesc) = True Then FTP_SetCurDir = True Else Return_ErrSrc = "FTP_SetCurDir >> " & Return_ErrSrc End If Else GetLastErrMsg Err.LastDllError, "FtpSetCurrentDirectory", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_SetCurDir >> FtpSetCurrentDirectory" End If Else GetLastErrMsg Err.LastDllError, "FtpSetCurrentDirectory", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_SetCurDir >> FtpSetCurrentDirectory" End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function '============================================================================================================= ' FTP_UploadFile ' ' Purpose : ' Uploads the specified file to the FTP server ' ' Param Use ' ------------------------------------ ' LocalFilePath Path to the file to upload to the FTP server ' RemoteFileName Name the file will be stored on the FTP server as ' CheckForOverwrite Optional. If set to FALSE, no checking is made to see if the file already exists on ' the FTP server. If set to FALSE, this function will execute quicker and more ' efficiently, but may overwrite important data on the server without the user knowing. ' PromptToOverwrite Optional. If set to true and the "CheckForOverwrite" parameter is set to FALSE and ' the file already exists on the FTP server, the user is prompted to overwrite it. ' FTP_Transfer_Type Optional. Specifies if the file transfer should be done using FTP's ASCII (Type A) ' transfer method, or FTP's Image/binary (Type I) transfer method. If ' FTP_TRANSFER_TYPE_UNKNOWN is specified, binary is used. ' Return_ErrNum Optional. If an error occurs, returns the number of the error that occured. ' Return_ErrSrc Optional. If an error occurs, returns the source of the error that occured. ' Return_ErrDesc Optional. If an error occurs, returns the description of the error that occured. ' ' Return ' ------ ' Returns TRUE if the function succeeds. Otherwise returns FALSE. ' '============================================================================================================= Public Function FTP_UploadFile(ByVal LocalFilePath As String, _ ByVal RemoteFileName As String, _ Optional ByVal CheckForOverwrite As Boolean = True, _ Optional ByVal PromptToOverwrite As Boolean = True, _ Optional ByVal FTP_Transfer_Type As Long = FTP_TRANSFER_TYPE_UNKNOWN, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim FileData As WIN32_FIND_DATA Dim hFind As Long Dim hOpenFile As Long Dim Attributes As Long Dim FileSize As Long ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" ' Make sure the parameters passed are valid LocalFilePath = Trim(LocalFilePath) RemoteFileName = Trim(RemoteFileName) If LocalFilePath = "" Or LocalFilePath = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_UploadFile()" Return_ErrDesc = "No file specified to upload." Exit Function ElseIf RemoteFileName = "" Or RemoteFileName = Chr(0) Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_UploadFile()" Return_ErrDesc = "No file specified to upload to." Exit Function End If If Dir(LocalFilePath) = "" Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_UploadFile()" Return_ErrDesc = "Could not find the file " & Chr(34) & LocalFilePath & Chr(34) & " to upload." Exit Function End If ' Make sure there is an internet connection made before continuing If bConnected = False Or hConnect = 0 Then Return_ErrNum = -1 Return_ErrSrc = "modFTP.FTP_UploadFile()" Return_ErrDesc = "No connection established yet. Call 'FTP_Connect' to establish a connection" Exit Function End If ' Make sure the strings are NULL terminated If Right(LocalFilePath, 1) <> Chr(0) Then LocalFilePath = LocalFilePath & Chr(0) If Right(RemoteFileName, 1) <> Chr(0) Then RemoteFileName = RemoteFileName & Chr(0) ' Get the file's attributes hFind = FindFirstFile(LocalFilePath, FileData) If hFind = 0 Then GetLastErrMsg Err.LastDllError, "FindFirstFile", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_UploadFile >> FindFirstFile" Exit Function End If FindClose hFind Attributes = FileData.dwFileAttributes FileSize = (FileData.nFileSizeHigh * (MAXDWORD + 1)) + FileData.nFileSizeLow ' Check if the file already exists, and if so, check if it's OK to replace it If CheckForOverwrite = True Then If FTP_GetFileSize(RemoteFileName, , False) = True Then ' This function call is simply to see if the file exists... so we don't display errors and don't collect returns If PromptToOverwrite = True Then If MsgBox(Left(RemoteFileName, Len(RemoteFileName) - 1) & Chr(13) & "This file already exists on the FTP server." & Chr(13) & Chr(13) & "Replace existing file on the server with this one?", vbYesNoCancel + vbExclamation, " Confirm File Overwrite") <> vbYes Then FTP_UploadFile = True Exit Function Else If FTP_DeleteFile(RemoteFileName) = False Then Exit Function End If Else If FTP_DeleteFile(RemoteFileName) = False Then Exit Function End If End If Else Call FTP_DeleteFile(RemoteFileName) End If ' Set the correct flags for transfer FTP_Transfer_Type = FTP_Transfer_Type Or INTERNET_FLAG_RELOAD Or INTERNET_FLAG_RESYNCHRONIZE ' Open the file for READ access If FtpPutFile(hConnect, LocalFilePath, RemoteFileName, FTP_Transfer_Type, 0) = 0 Then GetLastErrMsg Err.LastDllError, "FtpPutFile", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_UploadFile >> FtpPutFile" Else FTP_UploadFile = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' This function is ONLY to be used within this module. ' This module is required because after calling certain FTP and internet commands, ' the hConnect handle becomes invalid and can't be used again without receiving errors. ' By establishing a connection to the servers for every call, then disconnecting... ' you aviod this problem. Private Function FTP_Con(ByRef Return_hConnect As Long, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrSrc As String, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim ConnFlags As Long ' Set default return values Return_ErrNum = 0 Return_ErrSrc = "" Return_ErrDesc = "" Return_hConnect = 0 ' Make sure that there is a connection to the internet first If hInternet = 0 Then Exit Function ElseIf iServerPort = 0 Then iServerPort = 21 End If ' Set the parameters according to what the user specified If bPassive = True Then ConnFlags = INTERNET_FLAG_PASSIVE End If If bAnonymous = True Then sUserName = "anonymous" sPassword = "123@123.com" End If ' Establish a connection to the FTP server specified Return_hConnect = InternetConnect(hInternet, sFtpAddress & Chr(0), iServerPort, sUserName & Chr(0), sPassword & Chr(0), INTERNET_SERVICE_FTP, ConnFlags, 0) If Return_hConnect = 0 Then GetLastErrMsg Err.LastDllError, "InternetConnect", Return_ErrNum, Return_ErrDesc, False Return_ErrSrc = "modFTP.FTP_Con >> InternetConnect" FTP_Disconnect Else FTP_Con = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrSrc = Err.Source Return_ErrDesc = Err.Description Err.Clear End Function ' This function is ONLY to be used within this module. ' This function is the counter part for the FTP_Con function - see it for more details. Private Function FTP_Dis(ByRef ConnectionToClose As Long) As Boolean On Error Resume Next If ConnectionToClose <> 0 Then InternetCloseHandle ConnectionToClose ConnectionToClose = 0 End If FTP_Dis = True End Function