LotusScript Class to do client or server side FTP on Win32 platform. FTP using script and wininet.dll.

Doc Type	Tricks & Tips
Email Setting	Make Public
Email Address	steve dot robinson at notes411 dot com
Keep informed?	Yes
Author	SCRobinson
Company Name	Notes411
Category	LotusScript, Design & Development, Microsoft, Other
Modified	30/03/2006 09:39:45
Subject	LotusScript Class to do client or server side FTP on Win32 platform. FTP using script and wininet.dll.
--------------------------- LotusScript Class to do client or server side FTP on Win32 platform. --------------------------- Private Const MAX_PATH = 260 Private Const vbBinaryCompare=0 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 Private Const ERROR_NO_MORE_FILES = 18 Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _ (Byval hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long Declare Function NEMProgressBegin Lib "nnotesws.dll" ( Byval wFlags As Integer ) As Long 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 Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _ (Byval hFtpSession As Long, Byval lpszRemoteFile As String, _ Byval lpszNewFile As String, Byval fFailIfExists As Integer, Byval dwFlagsAndAttributes As Long, _ Byval dwFlags As Long, Byval dwContext As Long) As Integer 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 Integer Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _ (Byval hFtpSession As Long, Byval lpszDirectory As String) As Integer ' Initializes an application's use of the Win32 Internet functions 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 ' Use registry access settings. Private Const INTERNET_OPEN_TYPE_DIRECT = 1 Private Const INTERNET_OPEN_TYPE_PROXY = 3 Private Const INTERNET_INVALID_PORT_NUMBER = 0 Private Const FTP_TRANSFER_TYPE_ASCII = &H1 Private Const FTP_TRANSFER_TYPE_BINARY = &H1 Private Const INTERNET_FLAG_PASSIVE = &H8000000 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 Const ERROR_INTERNET_EXTENDED_ERROR = 12003 Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _ lpdwError As Long, _ Byval lpszBuffer As String, _ lpdwBufferLength As Long) As Integer ' Type of service to access. Private Const INTERNET_SERVICE_FTP = 1 'private Const INTERNET_SERVICE_GOPHER = 2 'private Const INTERNET_SERVICE_HTTP = 3 Private Const INTERNET_FLAG_RELOAD = &H80000000 Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000 Private Const INTERNET_FLAG_MULTIPART = &H200000 Declare Function FtpOpenFile Lib "wininet.dll" Alias _ "FtpOpenFileA" (Byval hFtpSession As Long, _ Byval sFileName As String, Byval lAccess As Long, _ Byval lFlags As Long, Byval lContext As Long) As Long Declare Function FtpDeleteFile Lib "wininet.dll" _ Alias "FtpDeleteFileA" (Byval hFtpSession As Long, _ Byval lpszFileName As String) As Integer Declare Function FtpRenameFile Lib "wininet.dll" Alias  "FtpRenameFileA" _ (Byval hFtpSession As Long,Byval sExistingName As String, Byval sNewName As String) As Integer ' Closes a single Internet handle or a subtree of Internet handles. Declare Function InternetCloseHandle Lib "wininet.dll" _ (Byval hInet As Long) As Integer ' ' Our Defined Errors ' %REM 'Public Enum errFtpErrors     errCannotConnect = vbObjectError + 2001     errNoDirChange = vbObjectError + 2002     errCannotRename = vbObjectError + 2003     errCannotDelete = vbObjectError + 2004     errNotConnectedToSite = vbObjectError + 2005     errGetFileError = vbObjectError + 2006     errInvalidProperty = vbObjectError + 2007     errFatal = vbObjectError + 2008 End Enum %END REM ' ' File Transfer types ' %REM Public Enum FileTransferType     ftAscii = FTP_TRANSFER_TYPE_ASCII     ftBinary = FTP_TRANSFER_TYPE_BINARY End Enum %END REM ' ' Error messages ' Private Const ERRCHANGEDIRSTR = "Cannot Change Directory to %s. It either doesn't exist, or is protected" Private Const ERRCONNECTERROR = "Cannot Connect to %s using User and Password Parameters" Private Const ERRNOCONNECTION = "Not Connected to FTP Site" Private Const ERRNODOWNLOAD  = "Couldn't Get File %s from Server" Private Const ERRNORENAME  = "Couldn't Rename File %s" Private Const ERRNODELETE  = "Couldn't Delete File %s from Server" Private Const ERRALREADYCONNECTED  = "You cannot change this property while connected to an FTP server" Private Const ERRFATALERROR  = "Cannot get Connection to WinInet.dll !" ' ' Session Identifier to Windows ' Private Const SESSION  = "CGFtp Instance" Class cFTP         Private temp As Integer         ' ' Our INET handle '         Private mlINetHandle As Long ' ' Our FTP Connection Handle '         Private mlConnection As Long ' ' Standard FTP properties for this class '         Private msHostAddress As String         Private msUser As String         Private msPassword As String         Private msDirectory As String                                 Private Sub Initialise() ' ' Create Internet session handle '                 mlINetHandle = InternetOpen(SESSION, INTERNET_OPEN_TYPE_DIRECT, Null, Null, 0)                 mlINetHandle = InternetOpen(SESSION, INTERNET_OPEN_TYPE_DIRECT, Null, Null, 0)                                 If mlINetHandle = 0 Then                         mlConnection = 0         'Err.Raise errFatal, "CGFTP::Class_Initialise", ERRFATALERROR                 End If                                 mlConnection = 0                         End Sub         'GET and SET Host #############################################                         Public Property Set Host (sHostName As String) ' ' Set the Host Name - only if not connected '                 If mlConnection <> 0 Then         REM Err.Raise errInvalidProperty, "ACNFTP:Host_Let", ERRALREADYCONNECTED                 End If                 msHostAddress = sHostName         End Property                 Public Property Get Host(sHostName As String) ' ' Get Host Name '                 Host = msHostAddress         End Property                 'GET and SET User #############################################                         Public Property Set User(sUserName As String) ' ' Set the user - only if not connected '                 If mlConnection <> 0 Then         REM Err.Raise errInvalidProperty, "CGFTP::User_Let", ERRALREADYCONNECTED                 End If                 msUser = sUserName         End Property                 Public Property Get User(sUserName As String) ' ' Get the user information '                 User = msUser         End Property                 'GET and SET Password #############################################                         Public Property Set Password( sPassword As String) ' ' Set the password - only if not connected '                 If mlConnection <> 0 Then         REM Err.Raise errInvalidProperty, "CGFTP::Password_Let", ERRALREADYCONNECTED                 End If                 msPassword = sPassword         End Property                 Public Property Get Password(sPassword As String) ' ' Get the password '                 Password = msPassword         End Property                 Public Property Get Directory(sDirectory As String) ' ' Get the directory '                 Directory = msDirectory         End Property                 'GET and SET Directory #############################################                         Public Property Set Directory(sDirectory As String) ' ' Set the directory - only if connected '                 On Error Goto vbErrorHandler                                 Dim sError As String                                 If Not (mlConnection = 0) Then                         RemoteChDir sDirectory                         msDirectory = sDirectory                 Else                         On Error Goto 0         REM Err.Raise errNotConnectedToSite, "CGFTP::Directory_Let", ERRNOCONNECTION                 End If                                 Exit Property                 vbErrorHandler:                     REM Err.Raise errNoDirChange, "CGFTP::Directory[Let]", Err.Description                         End Property                 'GET and SET Connected #############################################                         Public Property Get Connected() As Integer ' ' Are we connected to an FTP Server ? T/F '                 Connected = (mlConnection <> 0)         End Property                                                 Private Sub Terminate() ' ' Kill off any connection '                 If mlConnection <> 0 Then                         InternetCloseHandle mlConnection                 End If ' ' Kill off API Handle '                 If mlINetHandle <> 0 Then                         InternetCloseHandle mlINetHandle                 End If                 mlConnection = 0                 mlINetHandle = 0                         End Sub                         Public Function Disconnect() As Integer ' ' Disconnect, only if connected ! '                 If mlConnection <> 0 Then                         InternetCloseHandle mlConnection                         mlConnection = 0                 Else         REM Err.Raise errNotConnectedToSite, "CGFTP::Disconnect", ERRNOCONNECTION                 End If                 msHostAddress = ""                 msUser = ""                 msPassword = ""                 msDirectory = ""                         End Function                         Public Function Connect(Host As String, User As String, Password As String) As Integer ' ' Connect to the FTP server '                 On Error Goto vbErrorHandler                                 Dim sError As String ' ' If we already have a connection then raise an error '                 If mlConnection <> 0 Then                         On Error Goto 0         REM Err.Raise errInvalidProperty, "CGFTP::Connect", "You are already connected to FTP Server " & msHostAddress                         Exit Function                 End If ' ' Overwrite any existing properties if they were supplied in the ' arguments to this method '                 If Len(Host) > 0 Then                         msHostAddress = Host                 End If                                 If Len(User) > 0 Then                         msUser = User                 End If                                 If Len(Password) > 0 Then                         msPassword = Password                 End If                 ' ' Connect ! '                                 If Len(msHostAddress) = 0 Then         REM Err.Raise errInvalidProperty, "CGFTP::Connect", "No Host Address Specified!"                 End If                                 mlConnection = InternetConnect(mlINetHandle, msHostAddress, INTERNET_INVALID_PORT_NUMBER, _                 msUser, msPassword, INTERNET_SERVICE_FTP, 0, 0) ' ' Check for connection errors '                 If mlConnection = 0 Then                         'sError = Replace(ERRCONNECTERROR, "%s", msHostAddress)                         On Error Goto 0        'sError = sError & chr(10) & chr(13) & GetINETErrorMsg(Err.LastDllError)         REM Err.Raise errCannotConnect, "CGFTP::Connect", sError                 End If                                 Connect = True                                 Exit Function                 vbErrorHandler:                     REM Err.Raise Err.Number, "cFTP::Connect", Err.Description                         End Function                                 Public Function GetDirectoryList(Directory As String, FilterString As String) As Variant ' ' Returns a Disconnected record set for the ' directory and filterstring ' ' eg.  "/NTFFiles", "*.ntf" '                 On Error Goto vbErrorHandler                                 Dim oFileColl As Variant                 Dim lFind As Long                 Dim lLastError As Long                 Dim lPtr As Long                 Dim pData As WIN32_FIND_DATA                 Dim sFilter As String                 Dim lError As Long                 Dim bRet As Integer                 Dim sItemName As String                 Dim oRS As Variant                 Redim oRS(0)                 Dim ElementCount                 ElementCount=0                 'Dim oRS List As String                 ' ' Check if already connected, else raise an error '                 If mlConnection = 0 Then         REM Err.Raise errNotConnectedToSite, "CGFTP::GetDirectoryList", ERRNOCONNECTION                 End If                 ' ' Build the disconnected recordset structure. '     REM Set oRS = New ADOR.Recordset                 REM oRS.CursorLocation = adUseClient                 REM oRS.Fields.Append "Name", adBSTR                 REM oRS.Open ' ' Change directory if required '                 If Len(Directory) > 0 Then                         RemoteChDir Directory                 End If                                 pData.cFileName = String$(MAX_PATH, Chr(0))                                 If Len(FilterString) > 0 Then                         sFilter = FilterString                 Else                         sFilter = "*.*"                 End If ' ' Get the first file in the directory '                 lFind = FtpFindFirstFile(mlConnection, sFilter, pData, 0, 0)     REM lLastError = Err.LastDllError ' ' If no files, then return an empty recordset. '                 If lFind = 0 Then                         If lLastError = ERROR_NO_MORE_FILES Then         ' Empty directory                                 GetDirectoryList = oRS                                 Exit Function                         Else                                 On Error Goto 0             REM Err.Raise lLastError, "cFTP::GetDirectoryList", "Error looking at directory " & Directory & "/" & FilterString                         End If                         Exit Function                 End If ' ' Add the first found file into the recordset                                 '                 sItemName = Left$(pData.cFileName, Instr(1, pData.cFileName, Chr(0),vbBinaryCompare) - 1)                 oRS(ElementCount)=sItemName                                 REM oRS.AddNew "Name", sItemName ' ' Get the rest of the files in the list '                                 Do                         pData.cFileName = String(MAX_PATH,Chr(0))                         bRet = InternetFindNextFile(lFind, pData)                         'If Not (bRet) Then                         If (bRet=0) Then                                 lLastError = Err                                 'If lLastError = ERROR_NO_MORE_FILES Then                                 If lLastError = 0 Then                                         Exit Do                                 Else                                         InternetCloseHandle lFind                                         On Error Goto 0                                         Error 1001, "cFTP::GetDirectoryList .. Error looking at directory " & Directory & "/" & FilterString                                         temp=Err                                         Msgbox  "cFTP::GetDirectoryList" & "Error looking at directory " & Directory & "/" & FilterString                                         Exit Function                                 End If                         Else                                 sItemName = Left$(pData.cFileName, Instr(1, pData.cFileName, Chr(0),vbBinaryCompare) - 1)                                 ElementCount=ElementCount+1                                 Redim Preserve oRS(elementCount)                                 oRS(ElementCount)=sItemName                         End If                 Loop ' ' Close the 'find' handle '                 InternetCloseHandle lFind                                 On Error Resume Next                 REM oRS.MoveFirst     REM Err.Clear                 On Error Goto 0                                 GetDirectoryList = oRS                                 Exit Function                 vbErrorHandler: ' ' Tidy up & raise an error '                 If lFind <> 0 Then                         InternetCloseHandle lFind                 End If                 REM Set GetDirectoryList = oRS                     REM Err.Raise Err.Number, "cFTP::GetDirectoryList", Err.Description                         End Function         Private Sub RemoteChDir(Byval sDir As String)                 On Error Goto vbErrorHandler ' ' Remote Change Directory Command through WININET '                 Dim sPathFromRoot As String                 Dim bRet As Integer                 Dim sError As String ' ' Needs standard Unix Convention '                 sDir = Replace(sDir, "/", "/") ' ' Check for a connection '                 If mlConnection = 0 Then                         On Error Goto 0         REM Err.Raise errNotConnectedToSite, "CGFTP::RemoteChDir", ERRNOCONNECTION                         Exit Sub                 End If                                 If Len(sDir) = 0 Then                         Exit Sub                 Else                         sPathFromRoot = sDir                         If Len(sPathFromRoot) = 0 Then                                 sPathFromRoot = "/"                         End If                         bRet = FtpSetCurrentDirectory(mlConnection, sPathFromRoot) ' ' If we couldn't change directory - raise an error '                         If bRet = False Then                                 sError = ERRCHANGEDIRSTR                                 sError = Replace(sError, "%s", sDir)                                 On Error Goto 0             REM Err.Raise errNoDirChange, "CGFTP::ChangeDirectory", sError                         End If                 End If                                 Exit Sub                 vbErrorHandler:     REM Err.Raise Err.Number, "cFTP::RemoteChDir", Err.Description                         End Sub         Public Function DeleteFile(Byval ExistingName As String) As Integer                 Dim bRet As Integer                 Dim sError As String                                 On Error Goto vbErrorHandler ' ' Check for a connection '                 If mlConnection = 0 Then                         On Error Goto 0         REM Err.Raise errNotConnectedToSite, "CGFTP::DeleteFile", ERRNOCONNECTION                 End If                                 bRet = FtpDeleteFile(mlConnection, ExistingName) ' ' Raise an error if the file couldn't be deleted '                 If bRet = False Then                         sError = ERRNODELETE                         sError = Replace(sError, "%s", ExistingName)                         On Error Goto 0         REM Err.Raise errCannotDelete, "CGFTP::DeleteFile", sError                 End If                                 DeleteFile = True                                 Exit Function                 vbErrorHandler:     REM Err.Raise Err.Number, "cFTP::DeleteFile", Err.Description                         End Function                 'Public Function GetFile(Byval ServerFileAndPath As String, Byval DestinationFileAndPath As String, TransferType As FileTransferType) As Integer         Public Function GetFile(Byval ServerFileAndPath As String, Byval DestinationFileAndPath As String, TransferType As Long) As Integer ' ' Get the specified file to the desired location using the specified ' file transfer type '                 Dim bRet As Integer                 Dim sFileRemote As String                 Dim sDirRemote As String                 Dim sFileLocal As String                 Dim sTemp As String                 Dim lPos As Long                 Dim sError As String                                 On Error Goto vbErrorHandler ' ' If not connected, raise an error '                 If mlConnection = 0 Then                         On Error Goto 0         REM Err.Raise errNotConnectedToSite, "CGFTP::GetFile", ERRNOCONNECTION                 End If                 ' ' Get the file '                 bRet = FtpGetFile(mlConnection, ServerFileAndPath, DestinationFileAndPath, False, INTERNET_FLAG_RELOAD, TransferType, 0)                                 If bRet = False Then                         sError = ERRNODOWNLOAD                         sError = Replace(sError, "%s", ServerFileAndPath)                         On Error Goto 0                         GetFile = False        REM Err.Raise errGetFileError, "CGFTP::GetFile", sError                 End If                                 GetFile = True                                 Exit Function                 vbErrorHandler:                 GetFile = False    REM Err.Raise errGetFileError, "cFTP::GetFile", Err.Description                         End Function                 'Public Function PutFile(Byval LocalFileAndPath As String, Byval ServerFileAndPath As String,TransferType As FileTransferType) As Integer         Public Function PutFile(Byval LocalFileAndPath As String, Byval ServerFileAndPath As String,TransferType As Long) As Integer                 Dim bRet As Integer                 Dim sFileRemote As String                 Dim sDirRemote As String                 Dim sFileLocal As String                 Dim sTemp As String                 Dim lPos As Long                 Dim sError As String                                 On Error Goto vbErrorHandler ' ' If not connected, raise an error! '                 If mlConnection = 0 Then                         On Error Goto 0         REM Err.Raise errNotConnectedToSite, "CGFTP::PutFile", ERRNOCONNECTION                 End If                                 bRet = FtpPutFile(mlConnection, LocalFileAndPath, ServerFileAndPath, _                 TransferType, 0)                                 If bRet = False Then                         sError = ERRNODOWNLOAD                         sError = Replace(sError, "%s", ServerFileAndPath)                         On Error Goto 0                         PutFile = False        REM sError = sError & vbCrLf & GetINETErrorMsg(Err.LastDllError)         REM Err.Raise errCannotRename, "CGFTP::PutFile", sError                 End If                                 PutFile = True                                 Exit Function                 vbErrorHandler:     REM Err.Raise Err.Number, "cFTP::PutFile", Err.Description                         End Function                 Public Function RenameFile(Byval ExistingName As String, Byval NewName As String) As Integer                 Dim bRet As Integer                 Dim sError As String                                 On Error Goto vbErrorHandler ' ' If not connected, raise an error '                 If mlConnection = 0 Then                         On Error Goto 0         REM Err.Raise errNotConnectedToSite, "CGFTP::RenameFile", ERRNOCONNECTION                 End If                                 bRet = FtpRenameFile(mlConnection, ExistingName, NewName) ' ' Raise an error if we couldn't rename the file (most likely that ' a file with the new name already exists '                 If bRet = False Then                         sError = ERRNORENAME                         sError = Replace(sError, "%s", ExistingName)                         On Error Goto 0                         RenameFile = False         REM sError = sError & vbCrLf & GetINETErrorMsg(Err.LastDllError)         REM Err.Raise errCannotRename, "CGFTP::RenameFile", sError                 End If                                 RenameFile = True                                                 Exit Function                 vbErrorHandler:     REM Err.Raise Err.Number, "cFTP::RenameFile", Err.Description                         End Function                 Private Function GetINETErrorMsg(Byval ErrNum As Long) As String                 Dim lError As Long                 Dim lLen As Long                 Dim sBuffer As String ' ' Get Extra Info from the WinInet.DLL '                 If ErrNum = ERROR_INTERNET_EXTENDED_ERROR Then ' ' Get Message Size and Number '                         InternetGetLastResponseInfo lError, Null, lLen                         sBuffer = String$(lLen + 1, Chr(0)) ' ' Get Message '                         InternetGetLastResponseInfo lError, sBuffer, lLen                         GetINETErrorMsg = Chr(10) +Chr(13) & sBuffer                 End If         End Function                 Public Sub new()                 Call Me.initialise                 End Sub                 Public Sub delete()                 Call Me.terminate         End Sub                 End Class --------------------------- Implementation using an Agent --------------------------- Sub Initialize         Const FTP_TRANSFER_TYPE_ASCII = &H1         Const FTP_TRANSFER_TYPE_BINARY = &H0 'I think this is correct         On Error Goto ErrorHandler         Set moFTP = New cFTP         Dim DirectoryList As Variant  ' Returned list of files in directory                 Call moFTP.Connect("62.189.x.x","username","password")         DirectoryList = moFTP.GetDirectoryList("/temp", "*.*")         returnval=moFTP.GetFile("*.*", "c:/temp/*.*", FTP_TRANSFER_TYPE_ASCII)         If (returnVal) Then                 Msgbox "File successfully transfered"         Else                 Msgbox "File NOT sucesfully transfered"         End If         Exit Sub         ErrorHandler:         Msgbox Error$(Err)         Exit Sub End Sub