Difference between revisions of "Talk:Internet Transfer Control in VB6"

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

Latest revision as of 07:36, 7 February 2008

 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
Retrieved from "https://wiki.robotz.com/index.php?title=Talk:Internet_Transfer_Control_in_VB6&oldid=2079"