VB 使用INET控件制作FTP下载,WIN7正常下载,XP却下截不了?
XP系统中,状态总是icReceivingResponse 最后因超时下载失败
Option Explicit
Private m_GettingDir As Boolean
Private Sub AddMessage(ByVal msg As String)
txtResults.Text = txtResults.Text & vbCrLf & msg
txtResults.SelStart = Len(txtResults.Text)
End Sub
Private Sub cmdDownload_Click()
Dim host_name As String
Enabled = False
MousePointer = vbHourglass
txtResults.Text = "Working"
txtResults.SelStart = Len(txtResults.Text)
DoEvents
host_name = txtHost.Text
If LCase$(Left$(host_name, 6)) <> "ftp://" Then host_name = "ftp://" & host_name
inetFTP.URL = host_name
inetFTP.UserName = txtUserName.Text
inetFTP.Password = txtPassword.Text
inetFTP.Execute , "Get " & txtRemoteFile.Text & " " & txtLocalFile.Text
End Sub
Private Sub cmdUpload_Click()
Dim host_name As String
Enabled = False
MousePointer = vbHourglass
txtResults.Text = "Working"
txtResults.SelStart = Len(txtResults.Text)
DoEvents
host_name = txtHost.Text
If LCase$(Left$(host_name, 6)) <> "ftp://" Then host_name = "ftp://" & host_name
inetFTP.URL = host_name
inetFTP.UserName = txtUserName.Text
inetFTP.Password = txtPassword.Text
inetFTP.Execute , "Put " & txtLocalFile.Text & " " & txtRemoteFile.Text
End Sub
Private Sub inetFTP_StateChanged(ByVal State As Integer)
Select Case State
Case icError
AddMessage "Error: " & _
" " & inetFTP.ResponseCode & vbCrLf & _
" " & inetFTP.ResponseInfo
Case icNone
AddMessage "None"
Case icConnecting
AddMessage "连接"
Case icConnected
AddMessage "连接"
Case icDisconnecting
AddMessage "断开"
Case icDisconnected
AddMessage "断开"
Case icRequestSent
AddMessage "请求发送"
Case icRequesting
AddMessage "请求"
Case icReceivingResponse
AddMessage "接收响应"
Case icRequestSent
AddMessage "请求发送"
Case icResponseReceived
AddMessage "收到答复"
Case icResolvingHost
AddMessage "解析主机"
Case icHostResolved
AddMessage "主机解析"
Case icResponseCompleted
AddMessage inetFTP.ResponseInfo
If m_GettingDir Then
Dim txt As String
Dim chunk As Variant
m_GettingDir = False
chunk = inetFTP.GetChunk(1024, icString)
DoEvents
Do While Len(chunk) > 0
txt = txt & chunk
chunk = inetFTP.GetChunk(1024, icString)
DoEvents
Loop
AddMessage "----------"
AddMessage txt
End If
Case Else
AddMessage "State = " & Format$(State)
End Select
Enabled = True
MousePointer = vbDefault
End Sub