frmFTP
' Here's the code for frmFTP
Option Explicit
Private msCurrentFile As String
Friend Sub FTPFile(ByVal sFTPServer As String, _
ByVal sFTPCommand As String, _
ByVal sFTPUser As String, _
ByVal sFTPPwd As String, _
ByVal sFTPSrcFileName As String, _
ByVal sFTPTgtFileName As String)
Dim oFS As Scripting.FileSystemObject
Dim sURL As String
On Error GoTo FTPFileExit
Me.HRG True
msCurrentFile = ""
Set oFS = New Scripting.FileSystemObject
sURL = "ftp://" & sFTPServer
Inet1.Protocol = icFTP
Inet1.RequestTimeout = 60
Inet1.RemotePort = 21
Inet1.AccessType = icDirect
Inet1.URL = sURL
Inet1.UserName = sFTPUser
Inet1.Password = sFTPPwd
Select Case sFTPCommand
Case "PUT"
msCurrentFile = sFTPSrcFileName
If oFS.FileExists(sFTPSrcFileName) = False Then GoTo FTPFileExit
Inet1.Execute sURL, sFTPCommand & Space(1) & sFTPSrcFileName & " " & sFTPTgtFileName
Case "GET"
msCurrentFile = sFTPTgtFileName
If oFS.FileExists(sFTPTgtFileName) = True Then
oFS.DeleteFile sFTPTgtFileName, True
end if
Inet1.Execute sURL, sFTPCommand & Space(1) & sFTPSrcFileName & " " & sFTPTgtFileName
End Select
Me.WaitForResponse
Inet1.Execute sURL, "quit"
Me.WaitForResponse
FTPFileExit:
Set oFS = Nothing HRG False
End Sub
Friend Sub WaitForResponse()
Dim fWait As Boolean
On Error GoTo ErrHandler
fWait = True
Do Until fWait = False
DoEvents
fWait = Inet1.StillExecuting
Loop
ErrHandler:
Err.Clear
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
On Error Resume Next
Select Case State
Case icNone
Case icResolvingHost: Me.lblRESPONSE.Caption = "Resolving Host"
Case icHostResolved: Me.lblRESPONSE.Caption = "Host Resolved"
Case icConnecting: Me.lblRESPONSE.Caption = "Connecting..."
Case icConnected: Me.lblRESPONSE.Caption = "Connected"
Case icResponseReceived: Me.lblRESPONSE.Caption = "Transferring File..."
Case icDisconnecting: Me.lblRESPONSE.Caption = "Disconnecting..."
Case icDisconnected: Me.lblRESPONSE.Caption = "Disconnected"
Case icError: MsgBox "Error:" & Inet1.ResponseCode & " " & Inet1.ResponseInfo
Case icResponseCompleted: Me.lblRESPONSE.Caption = "Process Complete."
End Select
Me.lblRESPONSE.Refresh
Err.Clear
End Sub
Friend Sub HRG(fShowHourGlass As Boolean)
If fShowHourGlass = True Then
Screen.MousePointer = 11
Else
Screen.MousePointer = 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmFTP = Nothing
End Sub
' Here's the code for FTPMain.bas ' Remember to set your project start up to Sub Main()
Public Sub Main()
Load frmFTP
frmFTP.Show
frmFTP.FTPFile "my ip address", "PUT", "myuser", "mypwd", "C:\temp\test.txt", "test.txt"
frmFTP.FTPFile "my ip address", "GET", "myuser", "mypwd", "test.txt", "c:\temp\test2.txt"
Unload frmFTP
End Sub