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

来源：互联网发布：兄弟7060扫描软件编辑：程序博客网时间：2024/05/17 07:24

以下是代码部分，采用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