FTP上传大文件失败！

Question

各位大侠：
    小弟最近编程解决一个FTP上传文件的问题。当文件比较小的时候我用我的代码上传可以成功，并且可以得到结束上传的回执（我的程序可以继续执行下一步操作），但是当我上传个7~8M的大文件的时候，上传也可以成功，但是上传成功之后，程序一直在执行上传那一步的操作！
    一开始我以为是我的程序的问题，我尝试了两种不同的方法，一种是VB的Inet控件来上传有这个问题，现在我用API来上传还是遇到这个问题！文件已经上传成功，可就是程序停不下来！
    我把我的代码粘在下面，是我程序的问题还是需要设置FTP站点的某些属性呢？
Private Sub Command1_Click()
    Command1.Enabled = False
    Dim n As String
    Set FtpforPDF = New clsFtp
    With FtpforPDF
        .FtpServer = "218.25.89.118"
        .Username = "**************"
        .Password = "************"
        .ServerPort = 21
        If .OpenConnection(10) <= 0 Then
            Debug.Print "Timeout"
            Exit Sub
        End If
    
        .UpLoadFtpFile Text1.Text, .GetCurrentPath & "/123", FSO.GetFileName(Text1.Text)        .CloseConnection
    Command1.Enabled = True
    End WithEnd SubPublic Function UpLoadFtpFile(ByVal LocalName As String, ByVal SavePath As String, ByVal FileName As String) As Long
    On Error GoTo ErrHandler
    If hConn <= 0 Then
        GoTo ErrHandler
    End If
    'Set Path to Root Path
    FtpSetCurrentDirectory hConn, "/"
    FtpSetCurrentDirectory hConn, SavePath
    Dim hFile As Long
    Dim WriteBuffer() As Byte
    Dim BytesWritten As Long
    Dim TotalWritten As Long
    Dim RetWrite As Long
    Const BlockSize As Long = 1024& * 1024&
    hFile = FtpOpenFile(hConn, FileName, GENERIC_WRITE, FTP_TRANSFER_TYPE_BINARY, 0)
    If hFile <= 0 Then
        GoTo ErrHandler
    End If
    If Dir(LocalName) = "" Then
        GoTo ErrHandler
    End If
    Dim hFileRead As Long
    hFileRead = FreeFile
    Open LocalName For Binary As #hFileRead
    If LOF(hFileRead) > BlockSize Then
        ReDim WriteBuffer(BlockSize)
    Else
        ReDim WriteBuffer(LOF(hFileRead) - 1)
    End If
    Get #hFileRead, 1, WriteBuffer
    Do While True
        DoEvents
        RetWrite = InternetWriteFile(hFile, WriteBuffer(0), UBound(WriteBuffer) + 1, BytesWritten)
        TotalWritten = TotalWritten + BytesWritten
        RaiseEvent UpLoadFileProgress(TotalWritten)
        If RetWrite > 0 And BytesWritten > 0 Then
            If LOF(hFileRead) - Loc(hFileRead) - 1 > BlockSize Then
                ReDim WriteBuffer(BlockSize)
            Else
                If LOF(hFileRead) - Loc(hFileRead) > 0 Then
                    ReDim WriteBuffer(LOF(hFileRead) - Loc(hFileRead) - 1)
                Else
                    Exit Do
                End If
            End If
            Get #hFileRead, , WriteBuffer
        Else
            Exit Do
        End If
        SleepEx 10, True
    Loop
    Close #hFileRead
    InternetCloseHandle hFile
    
    UpLoadFtpFile = TotalWritten
    
    Exit Function
ErrHandler:
    Close #hFileRead
    InternetCloseHandle hFile
    UpLoadFtpFile = 0
End Function
如果分不够，我可以加！不过我一共没有多少分呵呵！谢谢各位了！

Answer 1

楼上：并不是没有结束循环，而是
.UpLoadFtpFile Text1.Text, .GetCurrentPath & "/123", FSO.GetFileName(Text1.Text) 
函数一直在执行，没有执行到下一步！

Answer 2

下个Chilkat FTP（免费的），简单好用，我玩几百M都没问题

Answer 3

问题应该出在DoEvents，当循环中过多使用DoEvents时，往往会出现这种情形，不用吧，又会因不及时更新UI造成程序假死，左右为难，好的解决办法是少用DoEvents，多用多线程。

Answer 4

楼上：我程序里没有DoEvents，我用FlashFXP上传也是上传结束后不终止，要不就连接错误要不就继续上传，继续上传又会弹出连接错误！我是不是要设置FTP的某个属性呢？对于小文件是正常的，上传结束后自动空闲（FlashFXP）

Answer 5

ReDim WriteBuffer(BlockSize)
如果你没有设置 Option Base 1 的话，整个数组的长度是 BlockSize+1，与你后面分段的逻辑不一致。又：UpLoadFtpFile 单步跟踪进去。

Answer 6

整个模块最前面加
Option Base 1

Answer 7

那就不加 Option Base 1，但是在 ReDim 中减1。
自己将长度算清楚！
错误都不显示，有你这样写程序的？

Answer 8

各位大侠，现在确定不是分块的原因，而是InternetCloseHandle hFile的问题，是它没有响应！这是怎么回事？怎么解决！

Answer 9

速度慢 
程序中在能保证窗体不死,少用Wait,DoEvents传输中断,可以考虑一下断点续传.

Answer 10

谁有clsFtp这个类包   发一个给我  谢谢   [email protected]