Talk:Internet Transfer Control in VB6

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