FTP class (Windows 32-bit and 64-bit)

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
PaulSquires
Posts: 868
Joined: Jul 14, 2005 23:41

FTP class (Windows 32-bit and 64-bit)

Postby PaulSquires » Aug 16, 2015 14:23

Simple FTP class for Windows only because it uses the system WinInet functionality.
Tested with FreeBASIC 1.03 for both 32-bit and 64-bit.

clsFTP (this is the actual source code to the class)

Code: Select all

''
''
''   FTP class (Public Domain code - enjoy).
''   Windows only. Uses WinInet system functions.
''   Paul Squires of PlanetSquires Software (August 2015)
''
''   Compiler:  FreeBASIC 1.03 (32-bit) (64-bit)
''

#Include Once "windows.bi"
#Include Once "\win\wininet.bi"


' //
' //
' //
Type clsFTP
   Private:
      m_hSession    As HINTERNET
      m_hConnection As HINTERNET
      m_LastError   As Integer
      m_ServerPort  As Integer
      m_ServerName  As String
      m_UserName    As String
      m_Password    As String
   
   Public:                   
      Declare Constructor
      Declare Destructor
      Declare Property hSession() As HINTERNET
      Declare Property hSession( ByVal nValue As HINTERNET )
      Declare Property hConnection() As HINTERNET
      Declare Property hConnection( ByVal nValue As HINTERNET )
      Declare Property LastError() As Integer
      Declare Property ServerPort( ByVal nValue As Integer )
      Declare Property ServerPort() As Integer
      Declare Property LastError( ByVal nValue As Integer )
      Declare Property ServerName() As String
      Declare Property ServerName( ByVal sValue As String )
      Declare Property UserName() As String
      Declare Property UserName( ByVal sValue As String )
      Declare Property Password() As String
      Declare Property Password( ByVal sValue As String )
      Declare Function Connect Overload() As WINBOOL
      Declare Function Connect Overload( ByVal sServerName As String, ByVal sServerPort As Integer, _
                                ByVal sUserName As String, ByVal sPassword As String ) As WINBOOL
      Declare Sub      Disconnect()
      Declare Function SetCurrentFolder( ByVal sFolderName As String ) As WINBOOL
      Declare Function GetCurrentFolder() As String
      Declare Function RenameFile( ByVal sOldFilename As String, ByVal sNewFilename As String ) As WINBOOL
      Declare Function UploadFile( ByVal sLocal As String, ByVal sRemote As String ) As WINBOOL
      Declare Function DownloadFile( ByVal sLocal As String, ByVal sRemote As String ) As WINBOOL
      Declare Function KillFile( ByVal sRemote As String ) As WINBOOL
End Type
       

''
''  Initialize the class
''
Constructor clsFTP
   m_ServerPort = INTERNET_DEFAULT_FTP_PORT   ' port 21
End Constructor


''
''  Close any open connection and session
''
Destructor clsFTP
   this.Disconnect
End Destructor


''
''  hSession (Property)
''
Property clsFTP.hSession() As HINTERNET
   Property = this.m_hSession
End Property
   
Property clsFTp.hSession( ByVal nValue As HINTERNET )
   this.m_hSession = nValue
End Property


''
''  hConnection (Property)
''
Property clsFTP.hConnection() As HINTERNET
   Property = this.m_hConnection
End Property
   
Property clsFTp.hConnection( ByVal nValue As HINTERNET )
   this.m_hConnection = nValue
End Property


''
''  LastError (Property)
''
Property clsFTP.LastError() As Integer
   Property = this.m_LastError
End Property
   
Property clsFTp.LastError( ByVal nValue As Integer )
   this.m_LastError = nValue
End Property


''
''  ServerPort (Property)
''
Property clsFTP.ServerPort() As Integer
   Property = this.m_ServerPort
End Property
   
Property clsFTp.ServerPort( ByVal nValue As Integer )
   this.m_ServerPort = nValue
End Property


''
''  ServerName (Property)
''
Property clsFTP.ServerName() As String
   Property = this.m_ServerName
End Property
   
Property clsFTp.ServerName( ByVal sValue As String )
   this.m_ServerName = sValue
End Property


''
''  UserName (Property)
''
Property clsFTP.UserName() As String
   Property = this.m_UserName
End Property
   
Property clsFTp.UserName( ByVal sValue As String )
   this.m_UserName = sValue
End Property


''
''  Password (Property)
''
Property clsFTP.Password() As String
   Property = this.m_Password
End Property
   
Property clsFTp.Password( ByVal sValue As String )
   this.m_Password = sValue
End Property


''
''  Close current connection and end session
''
Sub clsFTP.Disconnect()
   InternetCloseHandle this.hConnection
   InternetCloseHandle this.hSession
   this.hConnection = 0: this.hSession = 0
End Sub


''
''  Connect to an ftp host (overload). Returns TRUE if successful.
''
Function clsFTP.Connect Overload() As WINBOOL
       
   this.hSession = InternetOpen("ftpClass", INTERNET_OPEN_TYPE_DIRECT, "", "", 0)
   If this.hSession = 0 Then
      this.LastError = GetLastError 
      Function = False: Exit Function
   End If
   
   this.hConnection = InternetConnect( _
                          this.hSession, this.ServerName, this.ServerPort, _
                          this.UserName, this.Password, _
                          INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0 _
                          )
   If this.hConnection = 0 Then
      this.LastError = GetLastError
      InternetCloseHandle(this.hSession)
      Function = False: Exit Function
   End If
   
   Function = True

End Function


''
''  Connect to an ftp host (overload). Returns TRUE if successful.
''
Function clsFTP.Connect Overload ( ByVal sServerName As String, _
                                   ByVal nServerPort As Integer, _
                                   ByVal sUserName   As String, _
                                   ByVal sPassword   As String _
                                   ) As WINBOOL

   this.ServerName = sServerName
   this.ServerPort = nServerPort
   this.UserName   = sUserName
   this.Password   = sPassword
   
   Function = this.Connect
End Function


''
''  Change to a folder on the server. Returns TRUE if successful.
''
Function clsFTP.SetCurrentFolder( ByVal sFolderName As String ) As WINBOOL
   Function = FtpSetCurrentDirectory(this.hConnection, sFolderName)
   this.LastError = GetLastError
End Function


''
''  Retrieves the name of current folder on the server.
''
Function clsFTP.GetCurrentFolder() As String
   Dim zBuffer As ZString * MAX_PATH
   Dim nLength As Integer = MAX_PATH
   FtpGetCurrentDirectory(this.hConnection, zBuffer, Cast(LPDWORD, @nLength))
   this.LastError = GetLastError                             
   Function = zBuffer
End Function


''
''  Rename a file on the server. Returns TRUE if successful.
''
Function clsFTP.RenameFile( ByVal sOldFilename As String, ByVal sNewFilename As String ) As WINBOOL
   Function = FtpRenameFile(this.hConnection, sOldFilename, sNewFilename)
   this.LastError = GetLastError
End Function


''
''  Upload a file to the server. Returns TRUE if successful.
''
Function clsFTP.UploadFile( ByVal sLocal As String, ByVal sRemote As String ) As WINBOOL
   Function = FtpPutFile(this.hConnection, sLocal, sRemote, FTP_TRANSFER_TYPE_BINARY, 0)
   this.LastError = GetLastError
End Function


''
''  Download a file from the server. Returns TRUE if successful.
''
Function clsFTP.DownloadFile( ByVal sLocal As String, ByVal sRemote As String ) As WINBOOL
   Function = FtpGetFile(this.hConnection, sRemote, sLocal, False, FILE_ATTRIBUTE_NORMAL, FTP_TRANSFER_TYPE_BINARY Or INTERNET_FLAG_RELOAD, 0)
   this.LastError = GetLastError
End Function


''
''  Remove a file from the server. Returns TRUE if successful.
''
Function clsFTP.KillFile( ByVal sRemote As String ) As WINBOOL
   Function = FtpDeleteFile(this.hConnection, sRemote)
   this.LastError = GetLastError
End Function



text.bas (this is a simple program to test the ftp class)

Code: Select all


#Include Once "windows.bi"
#Include Once "clsFTP.bas"


 Dim ftp As clsFTP
 
 ' Replace the connection information with your specific information. The following
 ' just shows that we can connect to the NASA ftp server.
 If ftp.Connect( "ftp.hq.nasa.gov", 21, "anonymous", "eannahei@hq.nasa.gov" ) = False Then
    ? "Error connecting to server. LastError = "; ftp.LastError
 End If   
 
 If ftp.SetCurrentFolder( "pub" ) = False Then
    ? "Error setting current folder. LastError = "; ftp.LastError
 End If   

 ? "Current folder = "; ftp.GetCurrentFolder()

 ' The following function calls will obviously generate errors because we can not
 ' upload files to the NASA server.
 If ftp.UploadFile("testdb.db3","testdb.db3") = False Then
    ? "Error uploading file. LastError = "; ftp.LastError
 End If
 
 If ftp.RenameFile("testdb.db3","Newtestdb.db3") = False Then
    ? "Error renaming file. LastError = "; ftp.LastError
 End If

 If ftp.DownloadFile("Newtestdb.db3", "Newtestdb.db3") = False Then
    ? "Error downloading file. LastError = "; ftp.LastError
 End If

 If ftp.KillFile("Newtestdb.db3") = False Then
    ? "Error deleting file. LastError = "; ftp.LastError
 End If

 ftp.Disconnect
 
 ? "Done."

Sleep
PaulSquires
Posts: 868
Joined: Jul 14, 2005 23:41

Re: FTP class (Windows 32-bit and 64-bit)

Postby PaulSquires » Feb 02, 2016 23:09

Updated clsFTP.DownloadFile to correct FLAG error.
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Re: FTP class (Windows 32-bit and 64-bit)

Postby phishguy » Feb 03, 2016 0:06

This looks useful. Is there anyway to get a list of files in the selected directory?

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 6 guests