Recently, I had a need to make a FTP client, since our webhosting FTP server was kind of exotic, and very restrictive, and most of uploads, even though they reach 100% would crash... File would be uploaded to a server, but FTP clients just froze upon completion, waiting for the 226 (OK) from FTP server... So, I had to make my own, one who would not wait for 226, but instead, watch the file pload progress...

This tutorial is not fuly complete, in the sense that it does not offer COMPLETE FTP client functionality (for example, I ddn't write the code for FTP download, though it is fairly easy to add it, since all the necessary functions are already written)... I was ofcourse guided by the thought that tutorials sould encourage someone to do some further reading and exploration of their own, not just copy/paste...

First, let's start off with how FTP works... FTP uses 2 ports to communicate: port 21 for command communication, and some other port for data transmission... So, knowing this, let's begin:

First off, we need to declare some variables we'll use in our code:
CODE
Option Explicit
Dim CData   As String ' We'll use this to store incoming FTP data
Dim CResp   As String ' We'll use this to store response from FTP server
Dim DataOK  As Boolean ' Is the data sent?
Dim CmdOK   As Boolean ' Is the command sent?
Dim ATS     As Single ' Approximate transfer speed
Dim ATT     As Single ' Approximate transfer time
Dim Data    As String ' We take chunks of data we receive from the server, and merge them in this variable

Dim p_Log   As Boolean ' Should we log FTP activity?

Private Const C_TIMEOUT As Single = 1 ' Default timeout value of 1 second
Dim ConnLog As New Collection


OK, next, we'll need several of the controls on the Form:
2x Winsock controls: wskFTPC and wskFTPD
1x Command button: Command1
1x Text box: Text1
1x Timer: Timer1; resolution 100ms

OK, that set, let's add some actual FTP code.. Since many of FTP commands will often be called, so to avoid repetition, we'll write several of the functions and subs:
CODE
Private Function CSend(ByVal Command As String) As Boolean
If CmdOK Then
  CmdOK = False
  CSend = False
  wskFTPC.SendData Command & vbCrLf
  ConnLog.Add "-> " & Command
  If p_Log Then
    Text1.Text = Text1.Text & ("-> " & Command & vbCrLf)
  End If
  CSend = WaitCOK
End If
End Function

Private Function DSend(ByVal Data As String) As Boolean
If DataOK Then
  DataOK = False
  wskFTPD.SendData Data
  DSend = WaitOK
End If
End Function


We will call CSend() every time we want to send a command, and DSend() every time we send data chunk to a server. Let's move on... You must have noticed some more of the functions here, so let's write them (and others) too:

CODE
Public Sub Wait(ByVal ms As Single)
Dim t1 As Single, t2 As Single
t1 = Timer
While t2 < t1 + ms
  DoEvents
  t2 = Timer
Wend
End Sub

Public Function GetCode(Optional ByVal Timeout As Single = C_TIMEOUT) As String
Dim t1 As Single, t2 As Single

CResp = ""
GetCode = ""
t1 = Timer
While CResp = ""
  t2 = Timer
  If t2 > t1 + Timeout Then Exit Function
  DoEvents
Wend
GetCode = CResp
End Function

Public Function WaitCode(ByVal Code As String, Optional ByVal Timeout As Single = C_TIMEOUT) As Boolean
Dim t1 As Single, t2 As Single
t1 = Timer
WaitCode = False
While CResp <> Code
  t2 = Timer
  If t2 > t1 + Timeout Then Exit Function
  DoEvents
Wend
WaitCode = True
End Function

Public Function WaitOK(Optional ByVal Timeout As Single = C_TIMEOUT) As Boolean
Dim t1 As Single, t2 As Single
t1 = Timer
WaitOK = False
While DataOK = False
  t2 = Timer
  If t2 > t1 + Timeout Then Exit Function
  DoEvents
Wend
WaitOK = True
End Function

Public Function WaitCOK(Optional ByVal Timeout As Single = C_TIMEOUT) As Boolean
Dim t1 As Single, t2 As Single
t1 = Timer
WaitCOK = False
While CmdOK = False
  t2 = Timer
  If t2 > t1 + Timeout Then Exit Function
  DoEvents
Wend
WaitCOK = True
End Function

Public Function WaitConn(Optional ByVal Timeout As Single = C_TIMEOUT) As Boolean
Dim t1 As Single, t2 As Single
t1 = Timer
WaitConn = False
While wskFTPD.State <> sckConnected
  t2 = Timer
  If t2 > t1 + Timeout Then Exit Function
  If wskFTPD.State = sckConnecting Then t1 = Timer
  DoEvents
Wend
WaitConn = True
End Function

Private Function SendPORT() As Boolean
Dim pIP   As String
Dim pPort As String
Dim pH    As Long
Dim pL    As Long
Dim lPort As Long


Randomize Timer
lPort = Int(12000 * Rnd + 6000)

SendPORT = False

pH = lPort \ 256
pL = lPort - (pH * 256)
pPort = Trim(CStr(pH)) & "," & Trim(CStr(pL))

With wskFTPD
  .LocalPort = pH * 256 + pL
  pIP = .LocalIP
  .Listen
End With

pIP = Replace(pIP, ".", ",")
CSend ("PORT " & pIP & "," & pPort)

If Not WaitCode("200") Then Exit Function
SendPORT = True
End Function

Private Function SendLIST(Optional ByVal FilePath As String = "") As Boolean
Data = ""
CSend ("LIST" & IIf((FilePath = ""), "", " " & FilePath))
If Not WaitCode("150") Then Exit Function

While wskFTPD.State = sckConnected
  DoEvents
  Label3.Caption = CResp
Wend

Open "c:\incoming" For Binary As #120
Put #120, 1, Data
Close #120
Data = ""

SendLIST = True
End Function

Private Function SendFile(ByVal FileName As String, Optional ByVal BuffSize As Long = 2048) As Boolean
Dim hFile As Integer
Dim fBuff As String
Dim lBuff As Long
Dim t1    As Single
Dim t2    As Single

Dim s As Long, i As Long, r As Long

hFile = FreeFile
lBuff = BuffSize

t1 = Timer
Open FileName For Binary As #hFile
  If LOF(hFile) >= lBuff Then
    s = LOF(hFile) \ lBuff
    Picture1.ScaleWidth = s
    Label1.Width = 0
    fBuff = Space(lBuff)
    For i = 1 To s
      Get #hFile, , fBuff
      DSend fBuff
      Label1.Width = i
      DoEvents
    Next i
    r = LOF(hFile)
    r = r - (lBuff * s)
    If r > 0 Then
      fBuff = Space(r)
      Get #hFile, , fBuff
      DSend fBuff
    End If
    Label1.Width = LOF(hFile)
  Else
    Picture1.ScaleWidth = LOF(hFile)
    fBuff = Space(LOF(hFile))
    Get #hFile, , fBuff
    DSend fBuff
    Label1.Width = LOF(hFile)
  End If
  DoEvents
  t2 = Timer
  ATS = LOF(hFile) / ((t2 - t1) + 1)
  ATT = t2 - t1
Close #hFile
wskFTPD.Close
SendFile = True
End Function


Okie, now we've written all of the functions we'll need... Next on, we need to add some event handlers:
CODE
Private Sub Timer1_Timer()
Label2.Caption = wskFTPD.State
If wskFTPD.State = sckClosing Then wskFTPD.Close
End Sub

Private Sub wskFTPC_SendComplete()
CmdOK = True
DoEvents
End Sub

Private Sub Form_Unload(Cancel As Integer)
If wskFTPC.State = 7 Then
  Text1.Text = Text1.Text & CSend("QUIT")
  wskFTPC.Close
Else
  wskFTPC.Close
End If
End Sub

Private Sub wskFTPD_ConnectionRequest(ByVal requestID As Long)
wskFTPD.Close
wskFTPD.Accept requestID
Text1.Text = Text1.Text & "*** Data connection established" & vbCrLf
End Sub

Private Sub wskFTPD_DataArrival(ByVal bytesTotal As Long)
Dim s As String
wskFTPD.GetData s
Data = Data & s
End Sub

Private Sub wskFTPD_SendComplete()
DataOK = True
DoEvents
End Sub


OK, that's settled too... We've written basic FTP handling, upload will work, download too, but you'll have to come up with your own download function, that wraps around existing functions wink.gif

Now that we've got all the ingredients, let's make a juicy FTP soup:
CODE
Private Sub Command1_Click()
CmdOK = True
DataOK = True

p_Log = True


wskFTPC.RemoteHost = "ftphost.com"
wskFTPC.RemotePort = 21
wskFTPC.Connect

If Not WaitCode("220") Then Exit Sub

CSend ("USER username")
If Not WaitCode("331") Then Exit Sub

CSend ("PASS password")
If Not WaitCode("230") Then Exit Sub

CSend ("TYPE I")
If Not WaitCode("200") Then Exit Sub

CSend ("CWD sautpro.com/proba")
If Not WaitCode("250") Then Exit Sub

If Not SendPORT Then Exit Sub
CSend ("STOR somefile")
If Not WaitCode("200") Then Exit Sub
If Not WaitConn Then Exit Sub
If Not SendFile("c:\.somefile") Then Exit Sub
If Not WaitCode("226", 10) Then
  CSend "NOOP"
  If Not WaitCode("226", 20) Then Exit Sub
End If

Text1.Text = Text1.Text & "*** File transfer complete. (Approx. upload speed " & Format(ATS / 1024, "###,##0.00") & "kb/s, Approx. upload time " & Format(ATT, "#,##0.00") & " seconds)" & vbCrLf
Text1.Text = Text1.Text & "*** Closing data connection." & vbCrLf

CSend ("TYPE A")
If Not WaitCode("200") Then Exit Sub
If Not SendPORT Then Exit Sub
SendLIST
If Not WaitCode("226", 5) Then
  CSend "NOOP"
  If Not WaitCode("226", 10) Then Exit Sub
End If

Text1.Text = Text1.Text & "*** Directory LISTing received." & vbCrLf
End Sub


Now, remember to replace ftphost.com, yourfile, username and password with actual values, or this won't work... So, what are we doing? First, we're initializing variables, set wskFTPC to connect to ftphost.com on port 21 (FTP command port)... Then, we send our login info, and inbetween we wait for appropriate responses... Since I made this for specific purpose, error handling is virtualy non-existent, but it's easy to add to this code. You can find a list of FTP responses on the net...

I believe code is rather self-explanatory, but if you have any questions regarding this, I'm at your service, just post here, or drop me a PM...

You can play around with the code, optimise buffer size for upload, for download, since I used a value that suited best to my internet connection and FTP server type...

This ofcourse is not a complete FTP client, it's only a core functionality of FTP... If you wish to build some sort of full blown FTP client, you'll have to work some more on this code...

Oh, and if you do make that FTP client based on this code, I'd like it if you put my name somewhere in the credits smile.gif

Cheers, and I hope you will find this usefull in some way...

 

 

 


Reply