Prev: Sync Framework with multiple branch
Next: How to send email with no outlook and SMTP server ?
From: Michel Posseth [MCP] on 29 Apr 2010 01:11


Hello Bill,


This is a verry low level sockets method wich is capable of sending every
command and or file to a FTP server


Imports System.IO
Imports System.Net.Sockets
Imports System.Text
Imports System.Threading
Imports System.Security
Imports System.Management

Module FTP

Enum TransferMode
Ascii
Binary
End Enum

Public Class FtpClient
Const BUFFSIZE As Integer = 4096
Private strErrorCode As String = ""
Private strErrorMessage As String = ""
Private bConnectionOpen As Boolean = False
Private m_LogFileDirectory As String = "C:\"
Private m_sUsername As String = ""
Private m_sPassword As String = ""
Private m_sHost As String = ""
Private m_iPort As Integer = 21
Private m_tcpClient As TcpClient
Private m_commandStream As NetworkStream
Dim intFTPLog As Integer = FreeFile()

Private Sub SendFTPCommand(ByVal command As String)
If command.Length > 4 AndAlso command.Substring(0, 4) = "PASS"
Then
WriteToFTPLog("PASS")
Else
WriteToFTPLog(command)
End If
Try
m_commandStream.Write(System.Text.Encoding.ASCII.GetBytes(command
& vbCrLf), 0, command.Length + 2)
Catch EX As Exception
Throw New FtpClientException(0, "SendFTPCommand" & vbCrLf &
EX.Message)
End Try
End Sub

Friend Sub FtpClient(ByVal sHost As String, ByVal sUser As String,
ByVal sPassword As String)
m_sHost = sHost
m_sUsername = sUser
m_sPassword = sPassword
End Sub
Friend Sub FtpClient(ByVal sHost As String)
m_sHost = sHost
End Sub

Public Sub FtpClient(ByVal sHost As String, ByVal iPort As Integer)
m_sHost = sHost
m_iPort = iPort
End Sub
Friend Property Username() As String
Get
Return m_sUsername
End Get
Set(ByVal Value As String)
m_sUsername = Value
End Set
End Property

Friend Property Password() As String
Get
Return m_sPassword
End Get
Set(ByVal Value As String)
m_sPassword = Value
End Set
End Property

Friend Property Host() As String
Get
Return m_sHost
End Get
Set(ByVal Value As String)
m_sHost = Value
End Set
End Property

Friend Property Port() As Integer
Get
Return m_iPort
End Get
Set(ByVal Value As Integer)
m_iPort = Value
End Set
End Property

Friend Property LogFileDirectory() As String
Get
Return m_LogFileDirectory
End Get
Set(ByVal Value As String)
m_LogFileDirectory = Value
If Not m_LogFileDirectory.EndsWith("\") Then
m_LogFileDirectory += "\"
End If
End Set
End Property

Friend Sub Open()
Dim sOut As String = ""
'
' FTP Log File
'
Dim strLogFile As String = m_LogFileDirectory &
Application.ProductName & "_FTP.LOG"
If File.Exists(strLogFile) AndAlso
File.GetLastWriteTime(strLogFile).Date = Now.Date Then
Try
' Open file for logging.
FileOpen(intFTPLog, strLogFile, OpenMode.Append,
OpenAccess.Write, OpenShare.LockWrite)
Catch MyException As System.Exception
Throw New FtpClientException(0, _
String.Concat("Unable to create ", strLogFile, _
vbNewLine, _
MyException.Message))
End Try
Else
Try
' Open file for logging.
FileOpen(intFTPLog, strLogFile, OpenMode.Output,
OpenAccess.Write, OpenShare.LockWrite)
Catch MyException As System.Exception
Throw New FtpClientException(0, _
String.Concat("Unable to create ", strLogFile, _
vbNewLine, _
MyException.Message))
End Try
End If
'
'
'
If (bConnectionOpen) Then
Throw New FtpClientException(0, "Open" & vbCrLf & "FTP
Connection already open")
End If

Try
m_tcpClient = New TcpClient
WriteToFTPLog("FTP " & m_sHost)
m_tcpClient.SendTimeout = 5000
m_tcpClient.ReceiveTimeout = 5000
m_tcpClient.Connect(m_sHost, m_iPort)
m_tcpClient.ReceiveBufferSize = 4096 ' allocate a 4kb buffer
m_tcpClient.SendBufferSize = 4096
m_tcpClient.NoDelay = True
Catch e As SocketException
Throw New FtpClientException(e.ErrorCode, _
& " on Port " & m_iPort.ToString & vbCrLf & _
e.Message)
End Try
m_commandStream = m_tcpClient.GetStream ' Get the command stream
' We just successfully connected so the server welcomes us with
a 220 response
sOut = ReadReply(True)
If Not ReplyContains("220", sOut, strErrorCode, strErrorMessage)
Then
Throw New FtpClientException(CInt(strErrorCode), "Open" &
vbCrLf & strErrorMessage)
End If

SendFTPCommand("USER " & m_sUsername) ' send our user name
' the server must reply with 331
sOut = ReadReply()
If Not ReplyContains("331", sOut, strErrorCode, strErrorMessage)
Then
Throw New FtpClientException(CInt(strErrorCode), "User" &
vbCrLf & strErrorMessage)
End If

SendFTPCommand("PASS " & m_sPassword) ' send our password
sOut = ReadReply(True)
If Not ReplyContains("230", sOut, strErrorCode, strErrorMessage)
Then
Throw New FtpClientException(CInt(strErrorCode), "Password"
& vbCrLf & strErrorMessage)
End If
bConnectionOpen = True
End Sub

Friend Sub SetCurrentDirectory(ByVal sDirectory As String)
If (Not bConnectionOpen) Then
Throw New FtpClientException(0, "SetCurrentDirectory" &
vbCrLf & "Connection not open")
End If
SendFTPCommand("CWD " & sDirectory) ' send the command to change
directory
Dim sOut As String = ReadReply()
' FTP server must reply with 250, else the directory does not
exist
If Not ReplyContains("250", sOut, strErrorCode, strErrorMessage)
Then
Throw New FtpClientException(CInt(strErrorCode),
strErrorMessage)
End If
End Sub

Friend Sub ReceiveFile( _
ByVal sLocalFilename As String, _
ByVal sRemoteFilename As String, _
ByVal XferMode As TransferMode)

Dim objLocalFileStream As FileStream
Dim mTCPData As New TcpClient
Dim mDataStream As NetworkStream
Dim Port As Integer = 20
Dim strIPAddress As String
Dim sOut As String = ""

If (Not bConnectionOpen) Then
Throw New FtpClientException(0, "ReceiveFile" & vbCrLf &
End If
Try
objLocalFileStream = New FileStream(sLocalFilename,
FileMode.Create, FileAccess.ReadWrite, FileShare.Read, BUFFSIZE, False)
Catch ex As FileNotFoundException
Throw New FtpClientException(0, "Open Local File - File Not
Found" & vbCrLf & sLocalFilename & vbCrLf & ex.Message)
Catch ex As DirectoryNotFoundException
Throw New FtpClientException(0, "Open Local File - Directory
Not Found" & vbCrLf & sLocalFilename & vbCrLf & ex.Message)
Catch ex As SecurityException
Throw New FtpClientException(0, "Open Local File" & vbCrLf &
sLocalFilename & vbCrLf & ex.Message)
Catch ex As UnauthorizedAccessException
Throw New FtpClientException(0, "Open Local File" & vbCrLf &
sLocalFilename & vbCrLf & ex.Message)
Catch ex As Exception
Throw New FtpClientException(0, "Open Local File" & vbCrLf &
sLocalFilename & vbCrLf & ex.Message)
End Try
' Set transfer mode
Select Case XferMode
Case TransferMode.Ascii
SendFTPCommand("TYPE A")
sOut = ReadReply()
Case TransferMode.Binary
SendFTPCommand("TYPE I")
sOut = ReadReply()
End Select
Application.DoEvents()
'
'
Call ReadyDataSocketAndSendCommand("RETR " &
Path.GetFileName(sLocalFilename), _
Dim bData(1024) As Byte
Dim bytesRead As Integer = 0
' Retrieve the file
bytesRead = mDataStream.Read(bData, 0, BUFFSIZE)
Do While (bytesRead > 0)
objLocalFileStream.Write(bData, 0, bytesRead)
bytesRead = mDataStream.Read(bData, 0, BUFFSIZE)
Application.DoEvents()
Loop
objLocalFileStream.Close()
objLocalFileStream = Nothing
mDataStream.Close()
mDataStream = Nothing
mTCPData.Close()
mTCPData = Nothing
Thread.Sleep(200)
sOut = ReadReply()
End Sub

Friend Sub SendFile( _
ByVal sLocalFilename As String, _
ByVal sRemoteFilename As String, _
ByVal XferMode As TransferMode)
Dim objLocalFileStream As FileStream
Dim mTCPData As New TcpClient
Dim mDataStream As NetworkStream
Dim Port As Integer = 20
Dim strIPAddress As String
Dim sOut As String = ""
If (Not bConnectionOpen) Then
Throw New FtpClientException(0, "SendFile" & vbCrLf &
End If
Try
objLocalFileStream = New FileStream(sLocalFilename,
FileMode.Open, FileAccess.Read, FileShare.Read, BUFFSIZE, False)
Catch ex As FileNotFoundException
Throw New FtpClientException(0, "Open Local File" & vbCrLf &
sLocalFilename & vbCrLf & ex.Message)
Catch ex As DirectoryNotFoundException
Throw New FtpClientException(0, "Open Local File" & vbCrLf &
sLocalFilename & vbCrLf & ex.Message)
Catch ex As SecurityException
Throw New FtpClientException(0, "Open Local File" & vbCrLf &
sLocalFilename & vbCrLf & ex.Message)
Catch ex As UnauthorizedAccessException
Throw New FtpClientException(0, "Open Local File" & vbCrLf &
sLocalFilename & vbCrLf & ex.Message)
Catch ex As Exception
Throw New FtpClientException(0, "Open Local File" & vbCrLf &
sLocalFilename & vbCrLf & ex.Message)
End Try
' Set transfer mode
Select Case XferMode
Case TransferMode.Ascii
SendFTPCommand("TYPE A")
sOut = ReadReply()
Case TransferMode.Binary
SendFTPCommand("TYPE I")
sOut = ReadReply()
End Select
Application.DoEvents()

Call ReadyDataSocketAndSendCommand("STOR " &
Path.GetFileName(sLocalFilename), _

Dim bData(BUFFSIZE) As Byte
Dim bytesRead As Integer = 0
' Upload the file
bytesRead = objLocalFileStream.Read(bData, 0, BUFFSIZE)
Do While (bytesRead > 0)
mDataStream.Write(bData, 0, bytesRead)
bytesRead = objLocalFileStream.Read(bData, 0, BUFFSIZE)
Application.DoEvents()
Loop
objLocalFileStream.Close()
objLocalFileStream = Nothing
mDataStream.Close()
mDataStream = Nothing
mTCPData.Close()
mTCPData = Nothing
Thread.Sleep(200)
sOut = ReadReply()
End Sub

Friend Sub CloseConnection()
Dim sOut As String = ""
If bConnectionOpen Then
bConnectionOpen = False
SendFTPCommand("QUIT")
sOut = ReadReply()
If Not ReplyContains("221", sOut, strErrorCode,
strErrorMessage) Then
FileClose(intFTPLog)
Throw New FtpClientException(CInt(strErrorCode),
strErrorMessage)
End If
End If
FileClose(intFTPLog)
End Sub

Friend Function GetFileList(ByVal mask As String) As Collection
Dim mTCPData As New TcpClient
Dim mDataStream As NetworkStream
Dim Port As Integer = 20
Dim strIPAddress As String
Dim sOut As String = ""

Dim ASCII As Encoding = Encoding.ASCII
'
Call ReadyDataSocketAndSendCommand("NLST " & mask, _
Dim bData(BUFFSIZE) As Byte
Dim bytesRead As Integer = 0
Dim strFileNames As String = ""
' Retrieve the directory listing
bytesRead = mDataStream.Read(bData, 0, BUFFSIZE)
Do While (bytesRead > 0)
strFileNames += ASCII.GetString(bData, 0, bytesRead)
bytesRead = mDataStream.Read(bData, 0, BUFFSIZE)
Application.DoEvents()
Loop
mDataStream.Close()
mDataStream = Nothing
mTCPData.Close()
mTCPData = Nothing
Thread.Sleep(200)
sOut = ReadReply()
'
' Move from String to Collection
'
Dim x As Integer = 0
Dim y As Integer = 0
GetFileList = New Collection
While x < strFileNames.Length
y = strFileNames.IndexOf(CChar(vbCr), x)
GetFileList.Add(strFileNames.Substring(x, y - x))
Debug.WriteLine( _
GetFileList.Count.ToString & " " & _
strFileNames.Substring(x, y - x) & _
x).Length.ToString)
x = y + 2
End While

End Function

Private Function ReadReply(Optional ByVal bMultiLine As Boolean =
False) As String
Dim strCompleteMessage As String = ""
Dim strLastRecordRead As String = ""
Dim tmStart As Date = Now
Do
Application.DoEvents()
If m_commandStream.CanRead Then
Dim myReadBuffer(1024) As Byte
Dim numberOfBytesRead As Integer = 0
Do
Application.DoEvents()
Try
numberOfBytesRead = 0
If m_commandStream.DataAvailable Then
numberOfBytesRead =
m_commandStream.Read(myReadBuffer, 0, myReadBuffer.Length)
End If
Catch ex As Exception
Debug.WriteLine("m_commandStream.Read: " &
ex.Message)
Throw New FtpClientException(0, "ReadReply" &
vbCrLf & ex.Message)
End Try
If numberOfBytesRead > 0 Then
strLastRecordRead =
Encoding.ASCII.GetString(myReadBuffer, 0, numberOfBytesRead)
Debug.Write(Format(Now, "HH:mm:ss.ffff") & " FTP
Response: " & strLastRecordRead)
WriteToFTPLog(strLastRecordRead)
strCompleteMessage =
String.Concat(strCompleteMessage, strLastRecordRead)
End If
Loop While m_commandStream.DataAvailable
End If
Loop Until DateDiff(DateInterval.Second, tmStart, Now) > 5 Or _
(Not bMultiLine AndAlso _
strLastRecordRead.Length > 2 AndAlso
IsNumeric(strLastRecordRead.Substring(0, 3)))
If strCompleteMessage.Length = 0 Then
strCompleteMessage = "No response received"
End If
ReadReply = strCompleteMessage
End Function

Private Function ReplyContains(ByVal strCode As String, ByVal sOut
As String, _
ByRef strErrorCode As String, ByRef strErrorMessage As String)
As Boolean
ReplyContains = sOut.IndexOf(strCode) > -1
strErrorMessage = ""
strErrorCode = "0"
If sOut.Length > 3 AndAlso IsNumeric(sOut.Substring(0, 3)) Then
strErrorCode = sOut.Substring(0, 3)
strErrorMessage = sOut.Substring(3).Trim
End If
End Function

Private Sub ParsePASVResult(ByVal sOut As String, ByRef strIPAddress
As String, ByRef intPortNumber As Integer)
Dim arTokens() As String
Dim x As Integer
Dim y As Integer
Try
x = sOut.IndexOf("(")
y = sOut.IndexOf(")", x)
arTokens = sOut.Substring(x + 1, y - x -
1).Split(CChar(","))
strIPAddress = String.Concat(arTokens(0), ".", arTokens(1),
intPortNumber = (CInt(arTokens(4)) * 256) +
CInt(arTokens(5))
Catch ex As Exception
Throw New FtpClientException(0, "Malformed PASV result." &
vbCrLf & ex.Message)
End Try
End Sub

Private Sub WriteToFTPLog(ByVal strMessage As String)
Print(intFTPLog, Format(Now, "MM/dd/yyyy HH:mm:ss.ffff") & " " &
_
strMessage & DirectCast(IIf(strMessage.EndsWith(vbCrLf), "",
vbCrLf), String))
End Sub

Sub ReadyDataSocketAndSendCommand(ByVal strCommand As String, _
ByVal strMethodName As String, _
ByRef mTCPData As TcpClient, _
ByRef mDataStream As NetworkStream)
Dim sOut As String
Dim strIPAddress As String

If (Not bConnectionOpen) Then
Throw New FtpClientException(0, strMethodName & vbCrLf &
End If
'
' Set Passive Mode
'
' Passive mode opens the connection on the remote computer and
returns
' a port number to use. Later, this causes message 125. No
worries!
' That's what is supposed to happen.
'
SendFTPCommand("PASV")
sOut = ReadReply()
If Not ReplyContains("227", sOut, strErrorCode, strErrorMessage)
Then
Throw New FtpClientException(CInt(strErrorCode), "PASV" &
vbCrLf & strErrorMessage)
End If
ParsePASVResult(sOut, strIPAddress, Port)
Application.DoEvents()
'
' Open a socket
'
Try
mTCPData = New TcpClient(strIPAddress, Port)
Catch ex As Exception
Throw New FtpClientException(0, "Open Socket" & vbCrLf & _
strIPAddress & " " & Port.ToString & vbCrLf &
ex.Message)
End Try
mTCPData.ReceiveBufferSize = BUFFSIZE
mTCPData.SendBufferSize = BUFFSIZE
Try
mDataStream = mTCPData.GetStream()
Catch ex As Exception
Throw New FtpClientException(0, "GetStream" & vbCrLf & _
strIPAddress & " " & Port.ToString & vbCrLf &
ex.Message)
End Try
' Send the FTP Command to the FTP Server
SendFTPCommand(strCommand)
sOut = ReadReply()
' We will get either a confirmation of the download or an error
message
If Not ReplyContains("150", sOut, strErrorCode, strErrorMessage)
AndAlso _
Not ReplyContains("125", sOut, strErrorCode,
strErrorMessage) Then
Throw New FtpClientException(CInt(strErrorCode), strCommand
& vbCrLf & strErrorMessage)
End If
End Sub

Protected Overrides Sub Finalize()
If bConnectionOpen Then
Call CloseConnection()
End If
End Sub
End Class

Friend Class FtpClientException
Inherits Exception
Dim m_iErrorCode As Integer = 0
Dim m_ErrorMessage As String = ""
Friend Sub New(ByVal code As Integer, ByVal message As String)
m_iErrorCode = code
m_ErrorMessage = message
Throw Me
End Sub
Friend ReadOnly Property ErrorCode() As Integer
Get
Return m_iErrorCode
End Get
End Property
Friend ReadOnly Property ErrorMessage() As String
Get
Return m_ErrorMessage
End Get
End Property
End Class

Function CheckDiskDrive(ByVal strFileTitle As String) As String
Try
Dim d As String = strFileTitle.Substring(0, 2).ToUpper
CheckDiskDrive = ""
If d.Substring(1, 1) = ":" Then
Dim searcher As New ManagementObjectSearcher( _
& d & Chr(34))
If searcher.Get.Count > 0 Then
Dim share As ManagementObject
For Each share In searcher.Get
Dim decFreespace As Decimal =
System.Convert.ToDecimal(DirectCast(share("FreeSpace"), UInt64)) / (1024 *
1024)
Dim s As String = "=" &
share("Name").ToString.ToUpper
If s.Substring(1) = d Then
s = ""
End If
CheckDiskDrive = d & s & vbNewLine & _
Format(decFreespace,
DirectCast(IIf(decFreespace < 5, "WARNING:
Severe shortage of disk space", ""), String)
Next share
End If
End If
Catch ex As Exception
CheckDiskDrive = ""
End Try
End Function
End Module


Regards

Michel Posseth





















"Bill N" <billn(a)jaco.com> schreef in bericht
news:esmGL$W5KHA.3292(a)TK2MSFTNGP06.phx.gbl...
> Thank you Cor and Patrice!
> I have 2 questions:
> 1. Can I use this with VS2005 instead of VS 2008?
> 2. I am not well versed with C# (that's why my question is in this NG). I
> believe the codes below can help me with the GET command line I mentioned
> previously, but I don't know how to do it in VB.
> Can someone please give me a hint?
>
> Thanks
> Bill
>
> --------------------------
>
>
> public static bool DisplayFileFromServer(Uri serverUri)
> {
> // The serverUri parameter should start with the ftp:// scheme.
> if (serverUri.Scheme != Uri.UriSchemeFtp)
> {
> return false;
> }
> // Get the object used to communicate with the server.
> WebClient request = new WebClient();
>
> // This example assumes the FTP site uses anonymous logon.
> request.Credentials = new NetworkCredential
> ("anonymous","janeDoe(a)contoso.com");
> try
> {
> byte [] newFileData = request.DownloadData (serverUri.ToString());
> string fileString =
> System.Text.Encoding.UTF8.GetString(newFileData);
> Console.WriteLine(fileString);
> }
> catch (WebException e)
> {
> Console.WriteLine(e.ToString());
> }
> return true;
> }
>
>
>
> "Cor Ligthert[MVP]" <Notmyfirstname(a)planet.nl> wrote in message
> news:O3d0SXW5KHA.5952(a)TK2MSFTNGP04.phx.gbl...
> Why not the ftpwebrequest class?
>
>
> http://msdn.microsoft.com/en-us/library/system.net.ftpwebrequest(VS.80).aspx
>
> "Bill N" <billn(a)jaco.com> wrote in message
> news:unVZzDW5KHA.4644(a)TK2MSFTNGP02.phx.gbl...
>> I have the need to access an ftp server within a VB.NET app to issue GET
>> command to download files.
>> The ftp command lines are below (with actual loin info withhold):
>>
>>> ftp
>>> open ftp.myftpserver.com
>> User: myuserID
>> Password: mypassword
>>> /get ./ReceiveFiles/GetFileV2/MyAccount {myLocalFilePath}
>>
>> It's the GET command that caused problem for me. This GET command will
>> trigger the FTP server to render the file and send it to the specified
>> localFilePath.
>>
>> I prefer to use MS Utilities.FTP.FTPClient (System.Net) to get the thing
>> done, but cannot figure out how to pass this GET command line to the ftp
>> server. All I found in Utilities.FTP.FTPClient is
>> GetFileSize
>> GetHashCode
>> GetType
>>
>> If it's not possible to use System.Net FTP.FTPCLient utilities then I
>> need
>> help forming the ftp script to run with ProcessStart.
>> Your help is greatly appreciated.
>>
>> Bill
>>
>>
>>
>>

First  |  Prev  | 
Pages: 1 2
Prev: Sync Framework with multiple branch
Next: How to send email with no outlook and SMTP server ?