VB开发的上传实例,实现上传进度

以下是代码部分,采用Inet控件实现上传,实现进度显示和上传更名,比较遗憾的是由于先做的EXE版的,然后再改为了控件版,其中又修改了一些小地方,所以没有写完整的注释,不过在前面的一篇文章中已经将关键部分的代码都注释过了,所以下面这些部分应该是很容易看懂的。

在网上看过很多资料,关于VB实现上传的,其中很少提到上传进度的问题,大多是下载进度。问过一些朋友,据说用WINSOCK做上传进度要好些INET因为封装后留出来的灵活的方法不多,所以很少有人用他来做上传,更别说上传进度的问题了。

但是我工作中所需要的功能相当简单,唯一需要的就是加一个上传进度显示的东西,以免用户在上传非常大的文件的时候无法判断当前状态。

在代码中 inet1 是作为执行上传的inet实例,而 inet2就是作为检查上传进度的inet实例。

通过使用一个TIMER 每隔1秒 inet2执行一次 size命令,获得正在上传的这个文件在服务器上的当前文件大小。

就这样简单的实现了上传进度的显示。

当然,如果当用户和服务器通信速度很慢的时候,1秒内获取文件当前大小并计算显示出来可能不太理想,可以根据实际情况调整TIMER的执行频率。

'''''''''''''''''''''''''''''''''''''''''
'周飞 2007-9-25
'''''''''''''''''''''''''''''''''''''''''

Public serfilename As String
Public URL As String
Public UserName As String
Public UserPassword As String
Public filesize As Double


Private Sub UserControl_Initialize()

    URL = "ftp://192.168.1.17"
    UserName = "Anonymous"
    UserPassword = ""
   
    Inet1.URL = URL
    Inet1.UserName = UserName
    Inet1.Password = UserPassword
    Inet1.Protocol = icFTP
       
    Inet2.URL = URL
    Inet2.UserName = UserName
    Inet2.Password = UserPassword
    Inet2.Protocol = icFTP
   
End Sub

 

Private Sub Cancel_Click()
    
    Inet1.Cancel
           
    Upload.Visible = True
   
    Cancel.Visible = False
       
End Sub

Private Sub Findfile_Click()

    CommonDialog1.ShowOpen
       
    txtfile.Text = CommonDialog1.FileName
   
    If txtfile.Text <> "" Then
   
    filesize = FileLen(txtfile.Text)
   
    Else
   
    txtfile.Text = "请先浏览文件"
   
    End If
   
    'MsgBox filesize

End Sub

Private Sub Inet2_StateChanged(ByVal State As Integer)
   
    If State = 12 Then
   
        Dim i As Integer
       
        i = CInt((CDbl(Inet2.GetChunk(1024, icString)) / filesize) * 100)
   
        txtData.Caption = CStr(i) + "%"
       
        process.Width = i * 50
       
    End If
   
    If txtData.Caption = "100%" Then
   
        MsgBox "上传完成!"
   
        serfilename = ""
   
    End If
   
       
End Sub

Private Sub Timer_Timer()
   
    If serfilename <> "" Then
   
    Inet2.Execute URL, "size " & serfilename
   
    Do While Inet2.StillExecuting
   
    DoEvents
   
    Loop
   
    End If
   
End Sub

Private Sub Upload_Click()

    If txtfile.Text = "请先浏览文件" Then

       MsgBox "请先选择文件"
   
    Else
       
        Upload.Visible = False
       
        Cancel.Visible = True
       

        DoUpLoad ("""" + txtfile.Text + """")
                 
    End If
   
End Sub

Private Sub DoUpLoad(ByVal filestr As String)

    txtData.Caption = ""
 
    Dim isRight As Boolean
   
    Dim savefile As String
   
    savefile = Mid(filestr, InStrRev(filestr, "/") + 1, Len(filestr))
   
    savefile = CStr(Year(Now)) + CStr(Month(Now)) + CStr(Day(Now)) + CStr(Hour(Now)) + CStr(Minute(Now)) + CStr(Second(Now)) + "_" + Replace(savefile, " ", "")

    serfilename = savefile
  
   
    Inet1.Execute URL, "PUT " & filestr & " " & savefile
   
    isRight = Inet1.StillExecuting
   
   
    Do While isRight
   
    isRight = Inet1.StillExecuting
    DoEvents
   
    Loop

End Sub


Private Sub Inet1_StateChanged(ByVal State As Integer)

      '显示当前执行状态
      'txtData.Caption = ShowInfo(State)
     
      If State = 12 Then
              
        Upload.Visible = True
       
        Cancel.Visible = False
               
        txtfile.Text = "请先选择文件"
                                       
      End If
     
     
     
End Sub

Private Function ShowInfo(ByVal i As Integer) As String

Select Case i

    Case 0
        ShowInfo = "未报告状态"
    Case 1
        ShowInfo = "正在寻找指定主机的IP地址"
    Case 2
        ShowInfo = "已成功找到指定主机的IP地址"
    Case 3
        ShowInfo = "正在与指定主机进行连接"
    Case 4
        ShowInfo = "已成功与指定主机连接"
    Case 5
        ShowInfo = "正在向主机发出请求"
    Case 6
        ShowInfo = "已成功向主机发出请求"
    Case 7
        ShowInfo = "正在从主机接收反馈信息"
    Case 8
        ShowInfo = "已成功从主机接受反馈信息"
    Case 9
        ShowInfo = "正在与主机断开"
    Case 10
        ShowInfo = "已与主机断开"
    Case 11
        ShowInfo = "在与主机通信的过程中发生了错误"
    Case 12
        ShowInfo = "100%请求结束且数据已经接收到,上传成功"
       
End Select

End Function

 

 

你可能感兴趣的:(vb)