Upload/Download files in Chunks on FTP

  • Thread starter Thread starter Hemant
  • Start date Start date
H

Hemant

Hi,

I want to upload and download files to FTP in chunks as my file size is
large .
please help me .

Thanks,
Hemant
 
Hello ,,,


This is a verry low level sockets method wich is capable of sending every
command and or file to a FTP server ( i should upgrade it one time )


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
 
or a somehow higher level method


'FTP engine met system.net.webrequest

'Michel Posseth 29-02-2008

'

Imports System.Net

Imports System.IO

Public Class FTP

Public Event eError(ByVal ex As Exception)


Private _Uri As String

''' <summary>

''' Gets or sets the URI voor de FTP site

''' </summary>

''' <value>The URI.</value>

Public Property Uri() As String

Get

Return _Uri

End Get

Set(ByVal value As String)

_Uri = value

End Set

End Property

Private _UserName As String

''' <summary>

''' Gets or sets the name of the user.

''' </summary>

''' <value>The name of the user.</value>

Public Property UserName() As String

Get

Return _UserName

End Get

Set(ByVal value As String)

_UserName = value

End Set

End Property

Private _Password As String

''' <summary>

''' Gets or sets the password.

''' </summary>

''' <value>The password.</value>

Public Property Password() As String

Get

Return _Password

End Get

Set(ByVal value As String)

_Password = value

End Set

End Property



Public Sub New(ByVal Uri As String, Optional ByVal UserName As String = "",
Optional ByVal Password As String = "")

Me.Uri = Uri

Me.UserName = UserName

Me.Password = Password

End Sub


Public Event eDirecToryList(ByVal ListItems As String)

Public Sub List(Optional ByVal Details As Boolean = False)

List(Uri, Details)

End Sub


Public Event eStartFTPMethod(ByVal TaskId As String)

Public Event eStopFTPMethod(ByVal TaskId As String)


Public Sub List(ByVal listUrl As String, Optional ByVal Details As Boolean =
False, Optional ByVal Taskid As String = "")

RaiseEvent eStartFTPMethod(Taskid)

Dim reader As StreamReader = Nothing

Try

Dim listRequest As FtpWebRequest = CType(WebRequest.Create(listUrl),
FtpWebRequest)

If String.IsNullOrEmpty(Me.UserName) Then

listRequest.Credentials = New NetworkCredential(Me.UserName, Me.Password)

End If

If Details Then

listRequest.Method = WebRequestMethods.Ftp.ListDirectoryDetails

Else

listRequest.Method = WebRequestMethods.Ftp.ListDirectory

End If

Dim listResponse As FtpWebResponse = CType(listRequest.GetResponse(),
FtpWebResponse)

reader = New StreamReader(listResponse.GetResponseStream())

RaiseEvent eDirecToryList(reader.ReadToEnd())

'Catch ex As UriFormatException

'Catch ex As WebException

Catch ex As Exception

RaiseEvent eError(ex)

Finally

If reader IsNot Nothing Then

reader.Close()

End If

RaiseEvent eStopFTPMethod(Taskid)

End Try

End Sub

''' <summary>

''' Uploads the asynch.

''' </summary>

''' Name of the file.

''' The upload URL.

''' The task id.

Public Sub UploadAsynch(ByVal fileName As String, ByVal uploadUrl As String,
Optional ByVal TaskId As String = "")

If String.IsNullOrEmpty(TaskId) Then

TaskId = Guid.NewGuid.ToString

End If

Dim AsyncUpload As New InvokeThreeStringMeth(AddressOf Me.Upload)

AsyncUpload.BeginInvoke(fileName, uploadUrl, TaskId, Nothing, Nothing)

End Sub

''' <summary>

''' Uploads the specified file name.

''' </summary>

''' Name of the file.

''' The upload URL.

''' The task id.

Public Sub Upload(ByVal fileName As String, ByVal uploadUrl As String,
Optional ByVal TaskId As String = "")

RaiseEvent eStartFTPMethod(TaskId)

Dim requestStream As Stream = Nothing

Dim fileStream As FileStream = Nothing

Dim uploadResponse As FtpWebResponse = Nothing

Try

Dim uploadRequest As FtpWebRequest = CType(WebRequest.Create(uploadUrl),
FtpWebRequest)

If String.IsNullOrEmpty(Me.UserName) Then

uploadRequest.Credentials = New NetworkCredential(Me.UserName, Me.Password)

End If

uploadRequest.Method = WebRequestMethods.Ftp.UploadFile

'disable eventuele proxy ( uploaden door proxy is niet ondersteund )

uploadRequest.Proxy = Nothing

requestStream = uploadRequest.GetRequestStream()

fileStream = File.Open(fileName, FileMode.Open)

Dim buffer(1024) As Byte

Dim bytesRead As Integer

While True

bytesRead = fileStream.Read(buffer, 0, buffer.Length)

If bytesRead = 0 Then

Exit While

End If

requestStream.Write(buffer, 0, bytesRead)

End While

requestStream.Close()

uploadResponse = CType(uploadRequest.GetResponse(), FtpWebResponse)

Catch ex As Exception

RaiseEvent eError(ex)

'Catch ex As UriFormatException

'

'Catch ex As IOException

'

'Catch ex As WebException

'

Finally

If uploadResponse IsNot Nothing Then

uploadResponse.Close()

End If

If fileStream IsNot Nothing Then

fileStream.Close()

End If

If requestStream IsNot Nothing Then

requestStream.Close()

End If

RaiseEvent eStopFTPMethod(TaskId)

End Try

End Sub

Delegate Sub InvokeThreeStringMeth(ByVal ParA As String, ByVal ParB As
String, ByVal ParC As String)

''' <summary>

''' Download een file asynchroon

''' </summary>

''' The download URL.

''' The target location.

''' The task id.

Public Sub DownLoadAsynch(ByVal downloadUrl As String, Optional ByVal
TargetLocation As String = "", Optional ByVal TaskId As String = "")

If String.IsNullOrEmpty(TaskId) Then

TaskId = Guid.NewGuid.ToString

End If

Dim AsyncDownLoad As New InvokeThreeStringMeth(AddressOf Me.Download)

AsyncDownLoad.BeginInvoke(downloadUrl, TargetLocation, TaskId, Nothing,
Nothing)

End Sub

''' <summary>

''' Download een file synchroon

'''

''' </summary>

''' The download URL.

''' The target location.

''' The task id.

Public Sub Download(ByVal downloadUrl As String, Optional ByVal
TargetLocation As String = "", Optional ByVal TaskId As String = "")

RaiseEvent eStartFTPMethod(TaskId)

Dim responseStream As Stream = Nothing

Dim fileStream As FileStream = Nothing

Dim reader As StreamReader = Nothing

Try

Dim downloadRequest As FtpWebRequest = _

CType(WebRequest.Create(downloadUrl), FtpWebRequest)

Dim downloadResponse As FtpWebResponse = _

CType(downloadRequest.GetResponse(), FtpWebResponse)

responseStream = downloadResponse.GetResponseStream()

Dim fileName As String = _

Path.GetFileName(downloadRequest.RequestUri.AbsolutePath)

If fileName.Length = 0 Then

reader = New StreamReader(responseStream)

Else

Dim IOPath As String = fileName

'als we geen targetpath hebben dan gaat de file naar de assembly directory

If Not String.IsNullOrEmpty(TargetLocation) AndAlso
Directory.Exists(TargetLocation) Then

IOPath = Path.Combine(TargetLocation, fileName)

End If

fileStream = File.Create(IOPath) 'als de file al bestaat wordt deze
overschreven

Dim buffer(1024) As Byte

Dim bytesRead As Integer

While True

'vul de buffer met bytes

bytesRead = responseStream.Read(buffer, 0, buffer.Length)

If bytesRead = 0 Then

'als we geen bytes meer krijgen uit de stream dan is de file compleet over

Exit While 'dus stoppen met de loop

End If

fileStream.Write(buffer, 0, bytesRead)

End While

'de finally zorgt voor het netjes afsluiten van de stream en file

End If

Catch ex As Exception

RaiseEvent eError(ex)

'Catch ex As UriFormatException

'

'Catch ex As WebException

'

'Catch ex As IOException

'

Finally

If reader IsNot Nothing Then

reader.Close()

ElseIf responseStream IsNot Nothing Then

responseStream.Close()

End If

If fileStream IsNot Nothing Then

fileStream.Close()

End If

RaiseEvent eStopFTPMethod(TaskId)

End Try

End Sub

End Class




And here is i test application drag and drop a new form in the ide

now drag a textbox , a button and a listbox and a folderbrowserdialog

on the form go to code view and copy paste this code


Imports System.Net

Imports System.IO

Imports ista.FTP

Public Class Form1

'' Dim Uri As String = "ftp://nl_sdm1_r23/"

Delegate Sub ParA(ByVal parA As String)

Delegate Sub ParB(ByVal parB As Exception)

Private WithEvents ftpmp As ista.FTP

Private Sub ftpmp_eDirecToryList(ByVal ListItems As String) Handles
ftpmp.eDirecToryList

Me.ListBox1.Items.Clear()

Me.ListBox1.BeginUpdate()

For Each item In ListItems.Split(CChar(vbCrLf))

If item.Trim.Length > 0 Then

Me.ListBox1.Items.Add(item)

End If

Next

Me.ListBox1.EndUpdate()

End Sub

Private Sub ftpmp_eError(ByVal ex As System.Exception) Handles ftpmp.eError

MsgBox(ex.ToString)

End Sub

Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As
System.EventArgs) Handles Button1.Click

Navigate()

End Sub

Private Sub Navigate()

Button1.Enabled = False

ftpmp = New ista.FTP(Me.TextBox1.Text)

ftpmp.List()

Button1.Enabled = True

End Sub

Private Sub ftpmp_eStartFTPMethod(ByVal TaskId As String) Handles
ftpmp.eStartFTPMethod

If Me.InvokeRequired Then

Dim d As New ParA(AddressOf Me.ftpmp_eStartFTPMethod)

Me.Invoke(d, New Object() {TaskId})

Else

Me.Cursor = Cursors.WaitCursor

End If

End Sub

Private Sub ftpmp_eStopFTPMethod(ByVal TaskId As String) Handles
ftpmp.eStopFTPMethod

If Me.InvokeRequired Then

Dim d As New ParA(AddressOf Me.ftpmp_eStopFTPMethod)

Me.Invoke(d, New Object() {TaskId})

Else

Me.Cursor = Cursors.Default

End If

End Sub

Private Sub ListBox1_DoubleClick(ByVal sender As Object, ByVal e As
System.EventArgs) Handles ListBox1.DoubleClick

If Not ListBox1.SelectedItem Is Nothing Then

If ListBox1.SelectedItem.ToString.Length > 1 Then

If ListBox1.SelectedItem.ToString.Contains(".") Then

'een file

If Me.FolderBrowserDialog1.ShowDialog(Me) = Windows.Forms.DialogResult.OK
AndAlso Me.FolderBrowserDialog1.SelectedPath.Length > 0 Then

ftpmp.DownLoadAsynch(Path.Combine(Me.TextBox1.Text,
ListBox1.SelectedItem.ToString.Trim), Me.FolderBrowserDialog1.SelectedPath)



End If



Else

'een subdirectory

Me.TextBox1.Text = Path.Combine(Me.TextBox1.Text,
ListBox1.SelectedItem.ToString)

Navigate()

End If

End If

End If

End Sub

End Class



note that my apps are all standard contained in the ista root namespace you
might change that to your own

for the rest it should work out of the box


ofcourse uploading is as easy as

Dim FTpUpl As New ista.FTP("ftp://nl_sdm1_r40/")

FTpUpl.Upload("C:\micheltest.txt", "ftp://nl_sdm1_r40/XMLOL/test/hallo.txt")

MsgBox("klaar")



HTH

Michel
 
Back
Top