'------------------------------------- --------------- 'Class: CLSFTP.VB' Description: This Class Will Enable A Developer to 'Perform Ftp Processing in VB.Net.' The Class Supports Such Features As: '- Uploading a file. '- Remove a file.' - And Much Much More ... 'Date: 7th February 2002.' Conversion: The code WAS Converted from C # code. 'NOTE: IF THIS Code Works It Was Converted By 'Vick S. If IT DOESN' 'VICK S. IT' BY Someone Else. :-) 'Also Note That The Code Does Not' Accomodate for Proxy Servers. Only 'Direct Connections To FTP Sites.' ' Bit Shifting With VB.NET 2002 Is Not Supported Via The 'Traditional Bit SH Ifting Operators (IE << - Bitwise Left 'and >> - Bitwise Right).' Dividing a Number By 2 ^ 16 in VB.NET 2002 Is The Same as Bit- 'Shifting Right 16 Positions.' Multiplying a Number By 2 ^ 16 in VB.NET 2002 Is The Same As 'Bit-Shifting Left 16 Positions.' 'Check Out The Following Msdn Article On Bitshifting in' VB.Net 2003: '- Visual Basic .NET 2003 Language Changes' - by Duncan Mackenzie. '------------------------------------- --------------- Imports SystemImports System.Netimports System.Ioimports System.Textimports System.Net.Sockets
'Main ftp class.
Public Class clsFTP # Region "Main Class Variable Declarations" Private m_sRemoteHost, m_sRemotePath, m_sRemoteUser As String Private m_sRemotePassword, m_sMess As String Private m_iRemotePort, m_iBytes As Int32 Private m_objClientSocket As Socket
Private M_IRetValue As INT32 Private M_Bloggedin As Boolean 'Change To Loggedin Private M_smes, M_SReply As String
'Set the size of the packet that is used to read and' write data to the FTP Server to the spcified size below. Public Const BLOCK_SIZE = 512 Private m_aBuffer (BLOCK_SIZE) As Byte Private ASCII As Encoding = Encoding.ASCII
'General Variables Private M_sMessageString As String # end region
#Region "Class Constructors" '' Main class constructor. Public Sub New () m_sRemoteHost = "microsoft" m_sRemotePath = "." M_sRemoteUser = "anonymous" m_sRemotePassword = "" m_sMessageString = "" m_iRemotePort = 21 m_bLoggedIn = False End Sub
'Parametized constructor. Public Sub New (ByVal sRemoteHost As String, _ ByVal sRemotePath As String, _ ByVal sRemoteUser As String, _ ByVal sRemotePassword As String, _ ByVal iRemotePort As Int32) m_sRemoteHost = sRemoteHost m_sRemotePath = sRemotePath m_sRemoteUser = sRemoteUser m_sRemotePassword = sRemotePassword m_sMessageString = "" "M_iremoteport = IREMOTEPORT M_BLOGGEDIN = FALSE END SUB # End Region
#Region "event" Public Event DownloadFileBytes (ByVal Count As Integer) #End Region # Region "Public Properties" '' Set / Get the name of the FTP Server. Public Property RemoteHost () As String Get Return m_sRemoteHost End Get Set (ByVal Value as string) m_sremotehost = value end vendy
'Set / get the ftp port number. Public property remoteport () AS INT32 GET RETURN M_IREMOTEPORT END GET SET (BYVAL VALUE AS INT32) M_IREMOTEPORT = VALUE END SET End Property
'Set / get the remote path () AS STRING GET RETURN M_SREMOTEPATH END GET SET (BYVAL VALUE AS STRING) M_SREMOTEPATH = VALUE END SET End Property
'Set the remote password. Public property recotepassword () AS STRING GET RETURN M_SREMOTEPASSWORD END GET (BYVAL VALUE AS STRING) M_SREMOTEPASSWORD = VALUE END SET End Property
'Set / get the remote user () AS STRING GET RETURN M_SREMOTEUSER END GET SET (BYVAL VALUE AS STRING) M_SREMOTEUSER = VALUE END SET End Property
'Set the class messageString () AS STRING GET RETURN M_SMESSAGESTRING END GET SET (BYVAL VALUE AS STRING) M_SMESSAGESTRING = Value End End Property
#End region
#Region "Public Subs and Functions" '' Return a list of files within a string () array from the 'file system. Public Function GetFileList (ByVal sMask As String) As String () Dim cSocket As Socket Dim bytes As Int32 Dim seperator As char = controlchars.lf Dim Mess () as stringm_smes = "" IF (not (m_bloggedin) THEN login () endiff
Csocket = createdataDataSocket () Sendcommand ("NLST" & smask)
IF (NOT (m_iRetvalue = 150 or m_iRetvalue = 125)) Then MessageString = m_sreply throw new oException (m_sreply.substring (4)) Endiff
m_smes = "" Do while (true) m_abuffer.clear (m_abuffer, 0, m_abuffer.length) Bytes = csocket.receive (m_abuffer, m_abuffer.length, 0) m_smes = ascii.getstring (m_abuffer, 0, Bytes)
IF (Bytes Mess = m_smes.split (seperator) csocket.close () ReadReply () IF (M_IRetValue <> 226) Then MessageString = m_sreply throw new oException (m_sreply.substring (4)) Endix Return Mess End Function '' Get the size of the file on the ftp server. Public function getFilesize (Byval sfilename as string) AS Long Dim Size As Long IF (not (m_bloggedin) THEN LOGIN () END IF Sendcommand ("Size" & sfileName) size = 0 IF (m_iRetvalue = 213) THEN SIZE = INT64.PARSE (m_sreply.substring (4)) Else MessageString = m_sreply throw new oException (m_sreply.substring (4)) end ifreturn size end function '' Log into the FTP Server. Public Function Login () As Boolean m_objClientSocket = New Socket (AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) Dim ep As New IPEndPoint (Dns.Resolve (m_sRemoteHost) .AddressList (0), m_iremoteport) Try m_objclientsocket.connect (EP) Catch EX EX AS Exception MessageString = M_SReply Throw New IOException ("COULDN'T TO Remote Server) End Try ReadReply () IF (M_IRetValue <> 220) Then CloseConnection () MessageString = m_sreply throw new oException (m_sreply.substring (4)) endiff Sendcommand ("User" & m_Sremoteuser) IF (not (m_iRetvalue = 331 or m_iRetvalue = 230)) THEN CLANUP () MessageString = m_sreply throw new oException (m_sreply.substring (4)) end if If (m_iRetValue <> 230) Then SendCommand ( "PASS" & m_sRemotePassword) If (Not (m_iRetValue = 230 Or m_iRetValue = 202)) Then Cleanup () MessageString = m_sReply Throw New IOException (m_sReply.Substring (4)) End If End IF m_bloggedin = true changeirectory (m_sremotepath) 'Return the end result. Return M_Bloggedin End Function '' If the value of mode is true, set binary mode for 'downloads.' Else, set Ascii mode. Public Sub SetBinaryMode (ByVal bMode As Boolean) If (bMode) Then SendCommand ( "TYPE I") Else SendCommand ( "TYPE A ") End IF IF (M_IRetValue <> 200) Then MessageString = m_sreply throw new oException (m_sreply.substring (4)) End if End Sub '' Download A File to the assembly's local directory, 'Keeping The Same File name. Public Sub Downloadfile (Byval SfileName As String) Downloadfile (SfileName, ", FALSE) End Sub '' Download a remote file to the Assembly's local 'directory, keeping the same file name, and set' the resume flag. Public Sub DownloadFile (ByVal sFileName As String, ByVal bResume As Boolean) DownloadFile (sFileName, "", bResume) End Sub '' Download a remote file to a local file name which can 'include a path. The local file name will be created or' overwritten, but the path must exist. Public Sub DownloadFile (ByVal sFileName As String, ByVal sLocalFileName As String) DownloadFile (sfilename, slocalfilename, false) End Sub '' Download a remote file to a local file name which can 'include a path, and set the resume flag. The local file' name will be created or overwritten, but the path must 'exist. Public Sub DownloadFile (ByVal sFileName As String , BYVAL SLOCALFILENAME AS STRING, BYVAL BRESUME AS Boolean Dim St AS STREAM DIM OUTPUT AS FILESTREAM DIM CSOCKET AS SOCKET DIM OFFSET, NPOS as Longif (NOT (M_BLoggedin) THEN Login () endiff SetBinaryMode (True) IF (SlocalFilename.equals (")) THEN SLOCALFILENAME = SFileName End IF IF (not (file.exists (slocalfilename)). ST = file.create (slocalfilename) st.close () endiff Output = new filestream (slocalfilename, filemode.open) csocket = createDataSocket () offset = 0 IF (BRESUME) THEN OFFSET = OUTPUT.LENGTH IF (Offset> 0) Then Sendcommand ("REST" & Offset) IF (M_IRetValue <> 350) THEN 'Throw new oException (reply.substring (4));' Some Servers May Not Support Resuming. Offset = 0 end if End IF IF (Offset> 0) THEN NPOS = Output.seek (offset, seekorigin.begin) end if endiff Sendcommand ("Retr" & sfileName) IF (NOT (m_iRetvalue = 150 or m_iRetvalue = 125)) Then MessageString = m_sreply throw new oException (m_sreply.substring (4)) Endiff Do While (True) m_aBuffer.Clear (m_aBuffer, 0, m_aBuffer.Length) m_iBytes = cSocket.Receive (m_aBuffer, m_aBuffer.Length, 0) output.Write (m_aBuffer, 0, m_iBytes) RaiseEvent DownloadFileBytes (m_iBytes) IF (m_ibytes <= 0) THEN EXIT DO END IF LOOP Output.close () IF (CSocket.Connected) Then csocket.close () endiff ReadReply () IF (not (m_iRetvalue = 226 or m_iRetvalue = 250)) Then MessageString = m_sreply throw new oException (m_sreply.substring (4)) endiff End Sub '' UPLOAD A File (Byval SfileName As String) UploadFile (SFileName, False) End Sub '' Upload a file and set the resume flag. Public Sub UploadFile (ByVal sFileName As String, ByVal bResume As Boolean) Dim cSocket As Socket Dim offset As Long Dim input As FileStream Dim bFileNotFound As Boolean IF (not (m_bloggedin) THEN LOGIN () END IF CSocket = createdataSocket () OFFSET = 0 IF (strue) the try set = getFilesize (sfilename) catch ex achieveption offset = 0 END TRY END IF IF (Offset> 0) THEN SENDCOMMAND ("REST" & Offset) IF (M_IRetValue <> 350) THEN 'Throw new oException (reply.substring (4));' Remote Server May Not Support Resuming. Offset = 0 end if end IF SendCommand ( "STOR" & Path.GetFileName (sFileName)) If (Not (m_iRetValue = 125 Or m_iRetValue = 150)) Then MessageString = m_sReply Throw New IOException (m_sReply.Substring (4)) End If 'Check to see if the file exists before the upload. bFileNotFound = False If (File.Exists (sFileName)) Then 'Open input stream to read source file input = New FileStream (sFileName, FileMode.Open) If (offset <> 0) Then input.Seek (offset , SEEKORIGIN.BEGIN) END IF 'Upload the file m_iBytes = input.Read (m_aBuffer, 0, m_aBuffer.Length) Do While (m_iBytes> 0) cSocket.Send (m_aBuffer, m_iBytes, 0) m_iBytes = input.Read (m_aBuffer, 0, m_aBuffer.Length) Loop INPUT.CLOSE () else bfilenotfound = true endiff IF (csocket.connected) THEN CSOCKET.CLOSE () endiff 'No point in reading the return value if the file was' not found If (bFileNotFound) Then MessageString = m_sReply Throw New IOException ( "The file:".. & SFileName & "was not found Can not upload the file to the FTP Site END IF ReadReply () if (NOT (m_iRetvalue = 226 or m_iRetvalue = 250)) Then MessageString = m_sreply throw new oException (m_sreply.substring (4)) end if End Sub '' Delete a file from the remote ftp server. Public function deletefile (byval sfilename as string) AS Boolean Dim BRESULT AS BOOLEAN BRESULT = True if (NOT (M_Bloggedin)) THEN Login () End ifsendcommand ("DELE" & sfilename) IF (M_IRetValue <> 250) Then BRESULT = false MessageString = m_sreply endiff 'Return The Final Result. Return BRESULT END FUNCTION '' Rename A File on The Remote FTP Server. Public Function Renamefile (Byval SnewFileName As String) AS Boolean Dim BRESULT AS BOOLEAN BRESULT = True IF (not (m_bloggedin) THEN Login () endiff Sendcommand ("RNFR" & soldfilename) IF (m_iRetvalue <> 350) Then MessageString = m_sreply throw new oException (m_sreply.substring (4)) endiff 'Known problem' rnto will not take care of existing file. 'Ie It will overwrite if newFileName exist SendCommand ( "RNTO" & sNewFileName) If (m_iRetValue <> 250) Then MessageString = m_sReply Throw New IOException (m_sReply.Substring (4) ) End IF Return BRESULT END FUNCTION '' Create A Directory on The Remote FTP Server. Public Function CreateDirectory (byval sdirname as string) AS Boolean Dim BRESULT AS BOOLEAN BRESULT = True IF (not (m_bloggedin) THEN Login () endiff Sendcommand ("MKD" & SDIRNAME) IF (M_IRetValue <> 257) Then BRESULT = false messageString = m_sreply endiff 'Return The Final Result. Return BRESULT END FUNCTION '' Delete a Directory on The Remote FTP Server. Public Function Removedirectory (BYVAL SDIRNAME AS STRING) AS Boolean Dim Bresult As BooleanBresult = True IF (not (m_bloggedin) THEN Login () End IF Sendcommand ("RMD" & SDIRNAME) IF (M_iRetValue <> 250) Then BRESULT = false messagestrument = m_sreply endiff 'Return The Final Result. Return BRESULT END FUNCTION '' Change The Current Working Directory on The Remote FTP 'Server. Public Function Changedirectory (Byval SDIRNAME AS STRING) AS Boolean Dim BRESULT AS BOOLEAN BRESULT = TRUE IF (SDIRNAME.EQUALS (")) The EXIT FUNCTION END IF IF (not (m_bloggedin) THEN LOGIN () END IF Sendcommand ("CWD" & SDIRNAME) IF (M_iRetValue <> 250) Then BRESULT = false MessageString = m_sreply Endix Me.m_sremotepath = sdirname 'Return The Final Result. Return BRESULT END FUNCTION '' Close the FTP Connection. Public Sub CloseConnection () IF (NOT (m_objclientsocket is nothing) The sendcommand ("quit" Endiff Cleanup () End Sub #End region #Region "Private Subs and Functions" '' Read the reply from the FTP Server Private Sub ReadReply () m_sMes = "" m_sReply = ReadLine () m_iRetValue = Int32.Parse (m_sReply.Substring (0, 3)) End Sub '' Clean Up Some Variables. Private Sub Cleanup () IF NOT (M_ObjClientSocket IS Nothing) Then m_objclientsocket.close () m_objclientsocket = nothing end ifm_bloggedin = false End Sub '' Read a line from the server. Private byval Bclearmes as boolean = false AS String Dim seperator as char = controlchars.lf Dim Mess () AS String If (bClearMes) Then m_sMes = "" End If Do While (True) m_aBuffer.Clear (m_aBuffer, 0, BLOCK_SIZE) m_iBytes = m_objClientSocket.Receive (m_aBuffer, m_aBuffer.Length, 0) m_sMes = ASCII.GetString (m_aBuffer, 0 , m_ibytes) IF (m_ibytes Mess = m_smes.split (seperator) if (m_smes.length> 2) THEN M_SMES = Mess (Mess.Length - 2) Else M_smes = Mess (0) end if IF (NOT (m_smes.substring (3, 1) .Equals ("))) THEN RETURN READLINE (TRUE) End IF Return M_SMES End Function '' Send A Command To The FTP Server. Private Sub Sendcommand (Byval Scommand As String) Scommand = Scommand & ControlChars.crlf Dim Cmdbytes As Byte () = asCII.GetBytes (Scommand) m_objclientsocket.send (cmdbytes, cmdbytes.length, 0) Readreply () End Sub '' Create a Data socket. Private Function CreateDataSocket () As Socket Dim index1, index2, len As Int32 Dim partCount, i, port As Int32 Dim ipData, buf, ipAddress As String Dim parts (6) As Int32 Dim ch As Char Dim SAS Socket Dim EP As IpendPointsendCommand ("PASV") IF (M_IRetValue <> 227) Then MessageString = m_sreply throw new oException (m_sreply.substring (4)) endiff Index1 = m_sreply.indexof (") Index2 = m_sreply.indexof (") ") ipdata = m_sreply.substring (Index1 1, Index2 - Index1 - 1) Len = ipdata.length partcount = 0 buf = "" " For i = 0 TO ((LEN - 1) and partcount <= 6) CH = char.parse (iPdata.Substring (i, 1)) IF (Char.Indigit (CH)) THEN BUF = CH elseif (CH < > ",") Then MessageString = m_sreply throw new oException ("Malformed Pasv reply:" & m_sreply) end if IF ((CH = ") or (i 1 = len)) THEN TRY Parts (Partcount) = Int32.Parse (BUF) Partcount = 1 BUF =" "" Catch EX AS Exception MessageString = m_sreply throw new oException "Malformed Pasv reply:" & m_sreply) End end if next ipaddress = parts (0) & "& parts (1) &". "& parts (2) &". "& parts (3) 'Make this call in vb.net 2002. We would like to' Bitshift the number by 8 bits, so in vb.net 2002 we 'multiply the number by 2 to the power of 8. port = parts (4) * (2 ^ 8) 'make this call and comment out the Above line for' vb.net 2003. 'Port = Parts (4) << 8 'DETERMINE THE DATA Port Number. Port = Port Parts (5) S = new socket (addressfamily.internetwork, sockettype.stream, protocoltype.tcp) ep = new iPndPoint (DNS.Resolve (iPaddress) .addresslist (0), Port) Try S.Connect (EP) Catch EX AS exception messageSteracings = m_sreply throw new oException ("Can't Connect To Remote Server) End Try Return S end function #End region #Region "*** esample code ***" '' Copy and Paste The Code Below Into a VB Webform or Winform 'Application and the Do The Following:' 1). From WITHIN THE ASP.NET or WINFORM APP SET A 'Reference to the ftp.dll and bitoperators.dll' files. '2). At the top of the application code file' (eg Webform1.aspx.vb or form1.vb) Type in 'Imports FTP' 3). Compile the Application and Run. '4). Have Fun. 'Protected sub testf ()' DIM FF AS CLSFTP 'Try' '-----------------------------------------' Option 1 '' -------- '' 'Create An Instance of The FTP Class.' 'FF = New CLSFTP () '' Setup the appropriate property. '' Ff.remotehost = "microsoft" 'ff.remoteuser = "ftpuser"' 'ff.remotepassword = "password"' -------------- --------------------------------------- ---------------------- "'Option 2' '--------' 'PASS THE VALUES INTO The Constructor' 'INSTEAD. THESE CAN Be Overridden by Simply '' Setting The Appropriate Properties on The '' Instance of The Clsftp Class. 'Ff = New CLSFTP ("Microsoft", _' ".", _ '"Ftpuser", _' "password", _ ' twenty one) '' Attempt to Log Into the FTP Server. 'IF (ff.login ()) Then' '' 'Move The To Area1 / Section1 / Subby1 / Directory.' Ff.changedirectory ("Area1") 'ff.changedirectory (" Section1 ") '' Ff.createdirectory ("subby1") 'ff.changedirectory ("Subby1")' ff.setbinarymode (true) '' Upload a file. '' Ff.uploadfile ("D: /General/secureApps.pdf") '' Download a file. '' Ff.downloadfile ("SecureApps.pdf", "D: /General/secureApps.pdf") '' Remove A File from the ftp site. 'IF ("SecureApps.pdf") "" File Has Been Removed from FTP Site "' 'MessageBox.show (" File Has Been Removed from FTP Site ") 'Else' response.write (" Unable to remove file from ftp site. Message from Server: ") '' MessageBox.show (" Unable to remove file from FTP Site ") 'end if' 'rename a file on the ftp site.' '' IF (ff.renamefile (" secureApps.pdf "," newapp.pdf ")) THEN '' RESPONSE.WRITE (" File Has Been Renamed ") '' MessageBox.show (" File Has Been Renamed ") '' End IF '' Ff.changedirectory ("..") '' IF (ff.removedirectory) Then '' response.write ("Directory Has Been Removed 'Catch ex ask' 'ASP.NET' response.write (ex.Message & " #End region END CLASS
) '' 'MeSsageBox.show (" Directory Has Been Removed ") '' Else '' response.write (" Unable to remove the Directory. Message from Server: "& ff.MessageString &"
") '' 'MeSsageBox.SHOW (" Unable to remove the Directory 'End if' endiff
") 'response.write ("Message from FTP Server Was:" & ff.MessageString)' 'WinForms' Messagebox.Show (ex.Message) '' MessageBox.show ( "Message from FTP Server was:" & ff.MessageString) 'Finally' '' 'Always close down the connection to ensure that' 'there are no "stray" Fido's Fetching Data. In '' Other Words, No Stray / Limbo / NOT-IN-USE FTP '' Connections. 'Ff.closeconnection ()' end 'end Sub
