uploading and down loading files

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • mra
    New Member
    • Sep 2006
    • 15

    uploading and down loading files

    Hi
    I Need Help For Uploading And Down Loading Files Using Internet Tansfer Control. When Assign The Name Of File In A Variable, It Does Not Execute The State Change Event. When I Give The File Name Directly It Execute The State Change Event And Down Load And Uploadin Process Success.

    My Requirement Is To Down Load Selected Files From A List Of Server Files

    Very Urgent
  • sashi
    Recognized Expert Top Contributor
    • Jun 2006
    • 1749

    #2
    Hi there,

    Can you pls show your code segment on your next post, i feel it's alot more easier to troubleshoot, take care my fren.. :)

    Comment

    • mra
      New Member
      • Sep 2006
      • 15

      #3
      thank you
      this is my code
      '************** ********
      Code:
      Dim CnTest As New ADODB.Connection
      Dim i As Integer
      Dim ConnectedFlag As Boolean
      Dim ServerDirFlag As Boolean
      Dim DownloadFlag As Boolean
      Dim UploadFlag As Boolean
      Dim FileSizeFlag As Boolean
      Dim homeLen As Integer
      Dim LocFilespec As String
      Dim SerFilespec As String
      Dim gFileSize As String
      Private Sub cmdConnect_Click()
      Dim tmp As String
      Dim i As Integer
      Dim tmpPath As String
      Dim tmpFile As String
      Dim bExist As Boolean
      Dim lFileSize As Long
      ConnectedFlag = False
      ClearFlags
      lblStatus.Caption = "To connect ...."
      With Inet1
       .AccessType = icDirect
       .RequestTimeout = 0
        .URL = "ftp://urlname"
      .UserName = "username"
       .Password = "password"
      End With
      If RptFlag = 9 Then
      ServerDirFlag = True
      Inet1.Execute , "DIR wwwroot/*.mdb"
      Do While Inet1.StillExecuting
      DoEvents
      Loop
      End If
      If IsNetConnected() Then
      ConnectedFlag = True
      UpdButtons
      Else
      GoTo errHandler
      End If
      Exit Sub
      errHandler:
      End Sub
      Private Sub cmdDisconnect_Click()
      On Error Resume Next
      Inet1.Cancel
      Inet1.Execute , "CLOSE"
      lblStatus.Caption = "Unconnected"
      ConnectedFlag = False
      lisServerFiles.Clear
      ClearFlags
      UpdButtons
      End Sub
      Private Sub CmdDownLoad_Click()
      If ConnectedFlag = False Then
      MsgBox "No connection yet"
      Exit Sub
      End If
      lblStatus.Caption = "Retreiving file..."
      If lisServerFiles.SelCount > 1 Then
      MsgBox "INVALID SELECTION,PLEASE SELECT SINGLE FILE FOR DOWNLOADING AT A TIME", vbInformation, Me.Caption
      Exit Sub
      ElseIf lisServerFiles.SelCount = 1 Then
      SerFilespec = " ftp://urlname.com/wwwroot/" & lisServerFiles.List(i)
      Else
      MsgBox "INVALID SELECTION,PLEASE SELECT A FILE U WANT TO DOWNLOAD", vbInformation, Me.Caption
      Exit Sub
      End If
      LocFilespec = SerFilespec
      Do While InStr(LocFilespec, "/") <> 0
      LocFilespec = Right(LocFilespec, Len(LocFilespec) - _
      InStr(LocFilespec, "/"))
      Loop
      If IsFileThere(LocFilespec) Then
      If MsgBox(LocFilespec & " already exist. Overwrite?", _
      vbYesNo + vbQuestion) = vbNo Then
      Else
      Kill LocFilespec
      End If
      End If
      lblStatus.Caption = "Requesting for file size..."
      gFileSize = ""
      SerFilespec = " wwwroot/FACTORY1.MDB"
      LocFilespec = "C:\CASHEWORIG\PRODUCTION\FACTORY1.mdb"
      DownloadFlag = True
      Inet1.Execute "GET " & SerFilespec & LocFilespec
      '     Inet1.Execute , "GET wwwroot/FACTORY1.mdb C:\CASHEWORIG\PRODUCTION\FACTORY1.mdb"
      '     Inet1.Execute , "GET wwwroot/" & lisServerFiles.List(i) & App.Path & "\" & lisServerFiles.List(i)
      '     Inet1.Execute , "Get " & SerFilespec & LocFilespec
      Do While Inet1.StillExecuting
      DoEvents
      If ConnectedFlag = False Then
      Exit Sub
      End If
      Loop
      lblStatus.Caption = "Connected"
      Exit Sub
      End Sub
      Private Sub CmdUpLink_Click()
      On Error Resume Next
      If ConnectedFlag = False Then
      MsgBox "No connection yet"
      Exit Sub
      End If
      LocFilespec = App.Path & "\CSTOCK.MDB"
      lFileSize = FileLen(LocFilespec)
      lblStatus.Caption = "Uploading file..."
      UploadFlag = True
      Inet1.Execute , "PUT " & App.Path & "\CSTOCK.MDB" & " wwwroot/CSTOCK.MDB"
      Do While Inet1.StillExecuting
      DoEvents
      If ConnectedFlag = False Then
      Exit Sub
      End If
      Loop
      lblStatus.Caption = "Connected"
      Exit Sub
      errHandler:
      If icExecuting Then
      If ConnectedFlag = False Then
      Exit Sub
      End If
      If MsgBox("Executing job. Cancel it?", vbYesNo + vbQuestion) = vbYes Then
      Inet1.Cancel
      If Inet1.StillExecuting Then
      lblStatus.Caption = "System failed to cancel job"
      End If
      Else
      Resume
      End If
      End If
      'ErrMsgProc "cmdConnect_Click"
      End Sub
      Sub ErrMsgProc(mMsg As String)
      MsgBox mMsg & vbCrLf & Err.Number & Space(5) & Err.Description
      End Sub
      Private Sub Form_Load()
      ConnectedFlag = False
      ClearFlags
      Select Case RptFlag
      Case 9  ' DOWN LOAD
      Me.Caption = "DOWN LOAD"
      CmdDownLoad.Enabled = True
      CmdDownLoad.Visible = True
      CmdUpLink.Enabled = False
      CmdUpLink.Visible = False
      lisServerFiles.Visible = True
      Case 10 ' UPLINK
      Me.Caption = "UPLOAD"
      CmdDownLoad.Enabled = False
      CmdDownLoad.Visible = False
      CmdUpLink.Enabled = False
      CmdUpLink.Visible = True
      lisServerFiles.Visible = False
      End Select
      'DIR_OBJ
      UpdButtons
      End Sub
      Private Sub Form_Unload(Cancel As Integer)
      On Error Resume Next
      Inet1.Execute , "CLOSE"
      Unload Me
      End Sub
      Private Sub Inet1_StateChanged(ByVal State As Integer)
      On Error Resume Next
      Select Case State
      Case icError                                      ' 11
      lblStatus = Inet1.ResponseCode & ": " & Inet1.ResponseInfo
      Inet1.Execute , "CLOSE"
      lisServerFiles.Clear
      ConnectedFlag = False
      ServerDirFlag = False
      DownloadFlag = False
      UpdButtons
      Case icResponseCompleted                          ' 12
      Dim bDone As Boolean
      Dim tmpData As Variant
      If ServerDirFlag = True Then
      Dim dirData As String
      Dim strEntry As String
      Dim i As Integer, k As Integer
      tmpData = Inet1.GetChunk(4096, icString)
      dirData = dirData & tmpData
      If dirData <> "" Then
      lisServerFiles.Clear
       For i = 1 To Len(dirData) - 1
      k = InStr(i, dirData, vbCrLf)
      strEntry = Mid(dirData, i, k - i)
      If Right(strEntry, 1) = "/" Then
       strEntry = Left(strEntry, Len(strEntry) - 1) & "/"
      End If
      If Trim(strEntry) <> "" Then
       lisServerFiles.AddItem strEntry
      End If
      i = k + 1
      DoEvents
      Next i
      lisServerFiles.ListIndex = 0
      End If
      ServerDirFlag = False
      lblStatus.Caption = "Dir completed"
      ElseIf DownloadFlag Then
      Dim varData As Variant
      bDone = False
      Open LocFilespec For Binary Access Write As #1
      ' Get first chunk
       tmpData = Inet1.GetChunk(10240, icByteArray)
                       DoEvents
                       If Len(tmpData) = 0 Then
                            bDone = True
                       End If
                       Do While Not bDone
                            varData = tmpData
                            Put #1, , varData
                            tmpData = Inet1.GetChunk(10240, icByteArray)
                            DoEvents
                            If ConnectedFlag = False Then
                                 Exit Sub
                            End If
                            If Len(tmpData) = 0 Then
                                  bDone = True
                            End If
                       Loop
                       Close #1
                       DownloadFlag = False
                       DoEvents
                       lblStatus.Caption = "Download completed"
                       DownloadFlag = False
                       MsgBox "Download completed:" & vbCrLf & vbCrLf & _
                           "File in current dir, named  " & LocFilespec
                   ElseIf UploadFlag Then
                       lblStatus.Caption = "Connected"
                       UploadFlag = False
                       MsgBox "Upload completed"
                    ElseIf FileSizeFlag Then
                       Dim sizeData As String           
                       tmpData = Inet1.GetChunk(1024, icString)
                       DoEvents
                       If Len(tmpData) > 0 Then
                            sizeData = sizeData & tmpData
                       End If
                        gFileSize = sizeData
                       FileSizeFlag = False
                    Else
                       lblStatus.Caption = "Connected"
                  End If
              Case icNone                                       ' 0
                  lblStatus.Caption = "No state to report"
              Case icResolvingHost                              ' 1
                  lblStatus.Caption = "Resolving host..."
              Case icHostResolved                               ' 2
                  lblStatus.Caption = "Host resolved - found its IP address"
              Case icConnecting                                 ' 3
                  lblStatus.Caption = "Connecting..."
              Case icConnected                                  ' 4
                  lblStatus.Caption = "Connected"
              Case icRequesting                                 ' 5
                  lblStatus.Caption = "Sending requesst..."
              Case icRequestSent                                ' 6
                  lblStatus.Caption = "Request sent"
              Case icReceivingResponse                          ' 7
                  lblStatus = "Receiving data..."
              Case icResponseReceived                           ' 8
                  lblStatus = "Response received"
              Case icDisconnecting                              ' 9
                  lblStatus.Caption = "Disconnecting..."
              Case icDisconnected                               '10
                  lblStatus = "Disconnected"
          End Select
      End Sub
      Private Sub ClearFlags()
          ServerDirFlag = False
          DownloadFlag = False
          UploadFlag = False
          FileSizeFlag = False
      End Sub
      Private Sub UpdButtons()
          cmdConnect.Enabled = False
          CmdDownLoad.Enabled = False
          CmdUpLink.Enabled = False
          cmdDisconnect.Enabled = False
          If ConnectedFlag Then
               CmdDownLoad.Enabled = True
               cmdDisconnect.Enabled = True
          Else
               cmdConnect.Enabled = True
          End If
      End Sub
      '*********************************************************
      'MODULE
      Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags _
            As Long, ByVal dwReserved As Long) As Long
      Public RptFlag As Integer
      Function IsNetConnected() As Boolean
          IsNetConnected = InternetGetConnectedState(0, 0)
      End Function
      Function IsFileThere(inFileSpec As String) As Boolean
          On Error Resume Next
          Dim i
          i = FreeFile
          Open inFileSpec For Input As i
          If Err Then
              IsFileThere = False
          Else
              Close i
              IsFileThere = True
          End If
      End Function
      Please give me a solution

      Comment

      • mra
        New Member
        • Sep 2006
        • 15

        #4
        Originally posted by sashi
        Hi there,

        Can you pls show your code segment on your next post, i feel it's alot more easier to troubleshoot, take care my fren.. :)
        I GOT IT IT IS A SIMPLE MISTAKE Lack OF A COMMA

        Comment

        Working...