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

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

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

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

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

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

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

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

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

Public serfilename As StringPublic URL As StringPublic UserName As StringPublic UserPassword As StringPublic 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