FTP上传大文件失败！解决办法

FTP上传大文件失败！
各位大侠：
  小弟最近编程解决一个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 With

End Sub

Public 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


如果分不够，我可以加！不过我一共没有多少分呵呵！谢谢各位了！

[解决办法]
单步调试一下，看结束循环的条件为什么不对
[解决办法]
问题应该出在DoEvents，当循环中过多使用DoEvents时，往往会出现这种情形，不用吧，又会因不及时更新UI造成程序假死，左右为难，好的解决办法是少用DoEvents，多用多线程。

[解决办法]

VB code

ReDim WriteBuffer(BlockSize)
[解决办法]
整个模块最前面加
VB code
Option Base 1
[解决办法]
速度慢  
程序中在能保证窗体不死,少用Wait,DoEvents

传输中断,可以考虑一下断点续传.