Talk:Internet Transfer Control in VB6

 i '  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