Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Info() As String, TimerCountA As LongPrivate WithEvents wscControl As MSWinsockLib.Winsock
Private WithEvents wscData As MSWinsockLib.Winsock
Private Tmp As String, FileSize As String, DFile As StringPrivate Sub Form_Load()End SubPrivate Sub TimerControl_Timer()
LabelControl.Caption = "控制连接状态:" & WinSState(wscControl.State)
End SubPrivate Sub TimerData_Timer()
LabelData.Caption = "数据连接状态:" & WinSState(wscData.State)
End SubPrivate Sub wscControl_DataArrival(ByVal bytesTotal As Long)
Dim i As String
wscControl.GetData Tmp
End SubPrivate Sub wscData_DataArrival(ByVal bytesTotal As Long)
Dim ByteData() As Byte
wscData.GetData ByteData(), vbByte
Open DFile For Binary Lock Write As #1
ProgressBar.Value = FileLen(DFile)
If LOF(1) > 0 Then
Seek #1, LOF(1) + 1
End If
Put #1, , ByteData()
Close #1
End SubPrivate Sub wscData_Close()
wscData.Close
End SubFunction ChkTime()
Dim i As Integer
i = 50
Do While i > 0
If Tmp <> "" Then Exit Function
Sleep (100)
DoEvents
i = i - 1
Loop
wscControl.Close
ChkTime = True
End FunctionFunction ConnFtp(HostIp, HostPort, User, Pass)
If wscControl Is Nothing Then
Set wscControl = Controls.Add("MSWinsock.Winsock", "wscControl", Me)
TimerControl.Interval = 100
TimerControl.Enabled = True
End If
With wscControl
.RemoteHost = HostIp
.RemotePort = HostPort
.Connect
End With
If ChkTime Then
ConnFtp = "连接超时,是否重试?"
Exit Function
End If
Debug.Print Tmp
Select Case Left(Tmp, 3)
Case "220"
Tmp = ""
wscControl.SendData "USER " & User & vbCrLf
Debug.Print "USER " & User & vbCrLf
If ChkTime Then
ConnFtp = "连接错误USER,是否重试?" & vbCrLf & Tmp
Exit Function
End If
Debug.Print Tmp
Select Case Left(Tmp, 3)
Case "331"
Tmp = ""
wscControl.SendData "PASS " & Pass & vbCrLf
Debug.Print "PASS " & Pass & vbCrLf
PassCS:
If ChkTime Then
ConnFtp = "连接错误PASS,是否重试?" & vbCrLf & Tmp
Exit Function
End If
Debug.Print Tmp
Select Case Left(Tmp, 3)
Case "230"
If InStr(Tmp, "230 ") > 0 Then
ConnFtp = "OK"
Tmp = ""
Exit Function
End If
Tmp = ""
GoTo PassCS
Case "530"
ConnFtp = "登陆失败,用户名或密码错误,是否重试?" & vbCrLf & Tmp
wscControl.Close
Tmp = ""
Exit Function
End Select
End Select
End Select
ConnFtp = "错误"
End FunctionFunction DownFile(File As String, TransferMode As String)
Dim FileHaveLen As String
If wscControl.State <> 7 Then
MsgBox "请确认当前连接状态!1"
Exit Function
End If
wscControl.SendData "NOOP " & vbCrLf
Debug.Print "NOOP " & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 200 Then
Debug.Print Tmp
DownFile = "请确认当前连接状态!2" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
Tmp = ""
End If
If TransferMode = "I" Or TransferMode = "A" Then
wscControl.SendData "TYPE " & TransferMode & vbCrLf
Debug.Print "TYPE " & TransferMode & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 200 Then
Debug.Print Tmp
DownFile = "改变状态失败!" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
Tmp = ""
End If
End If
File = Replace(File, "\", "/")
Dim PathT As String
PathT = Left(File, InStrRev(File, "/"))
If PathT <> "" Then
wscControl.SendData "CWD " & PathT & vbCrLf
Debug.Print "CWD " & PathT & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 250 Then
Debug.Print Tmp
DownFile = "改变目录失败!" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
Tmp = ""
End If
End If
Dim FileT As String
FileT = Right(File, Len(File) - InStrRev(File, "/"))
wscControl.SendData "SIZE " & FileT & vbCrLf
Debug.Print "SIZE " & FileT & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 213 Then
Debug.Print Tmp
DownFile = "取得文件大小失败!" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
FileSize = Right(Tmp, Len(Tmp) - 4)
ProgressBar.Max = FileSize
Print "文件大小:" + CStr(FormatNumber(FileSize / 1024, 2)) + "KB..."
Tmp = ""
End If
wscControl.SendData "PASV" & vbCrLf
Debug.Print "PASV" & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 227 Then
Debug.Print Tmp
DownFile = "获取Pasv端口失败!" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
Dim Tmp1, Tmp2, Tmp3, Tmp4, TmpIp, TmpPort
Tmp1 = InStr(Tmp, Chr(40)) + 1
Tmp2 = InStrRev(Tmp, Chr(41))
Tmp3 = Mid(Tmp, Tmp1, Tmp2 - Tmp1)
Tmp4 = Split(Tmp3, ",")
TmpIp = Tmp4(0) & "." & Tmp4(1) & "." & Tmp4(2) & "." & Tmp4(3)
TmpPort = Tmp4(4) * 256 + Tmp4(5)
Tmp = ""
End If
Open DFile For Binary Lock Write As #1
If LOF(1) > 0 Then
FileHaveLen = FileLen(DFile)
Close #1
If MsgBox("文件已存在,是否续传?", vbYesNo, "提示:") <> vbYes Then
Kill DFile
Else
wscControl.SendData "REST " & FileHaveLen & vbCrLf
Debug.Print "REST " & FileHaveLen & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 350 Then
MsgBox "服务器不支持续传,将重新下载文件!" & vbCrLf & Tmp
Kill DFile
End If
Debug.Print Tmp
Tmp = ""
End If
Else
Close #1
End If
'数据下载部分
If wscData Is Nothing Then
Set wscData = Controls.Add("MSWinsock.Winsock", "wscData", Me)
TimerData.Interval = 100
TimerData.Enabled = True
End If
With wscData
.RemoteHost = TmpIp
.RemotePort = TmpPort
.Connect
End With
wscControl.SendData "RETR " & FileT & vbCrLf
Debug.Print "RETR " & FileT & vbCrLf
If ChkTime Then
DownFile = "连接数据超时!"
Exit Function
End If
Debug.Print Tmp
If InStr(Tmp, "226 ") > 0 Then GoTo End1
Tmp = ""
Do While wscData.State = 7
DoEvents
Loop
If ChkTime Then
DownFile = "下载失败!"
Exit Function
End If
Debug.Print Tmp
End1:
Tmp = ""
DownFile = "OK"
End Function提示 DownFile = "改变目录失败!" & vbCrLf & Tmp
目录 本店介绍/time.swf
main.swf
本店介绍和main.swf是同一级的。
循环下载的时候
下载完本店介绍/time.swf
再下载main.swf的时候 tmp=本店介绍/main.swf
发送的wscControl.SendData "CWD " & PathT & vbCrLf pathT=main.swf
但接收 tmp=本店介绍/main.swf 郁闷
我是菜鸟,还望高手大哥帮我改改,跪谢,另外想找个VB师傅,
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Info() As String, TimerCountA As LongPrivate WithEvents wscControl As MSWinsockLib.Winsock
Private WithEvents wscData As MSWinsockLib.Winsock
Private Tmp As String, FileSize As String, DFile As StringPrivate Sub Form_Load()End SubPrivate Sub TimerControl_Timer()
LabelControl.Caption = "控制连接状态:" & WinSState(wscControl.State)
End SubPrivate Sub TimerData_Timer()
LabelData.Caption = "数据连接状态:" & WinSState(wscData.State)
End SubPrivate Sub wscControl_DataArrival(ByVal bytesTotal As Long)
Dim i As String
wscControl.GetData Tmp
End SubPrivate Sub wscData_DataArrival(ByVal bytesTotal As Long)
Dim ByteData() As Byte
wscData.GetData ByteData(), vbByte
Open DFile For Binary Lock Write As #1
ProgressBar.Value = FileLen(DFile)
If LOF(1) > 0 Then
Seek #1, LOF(1) + 1
End If
Put #1, , ByteData()
Close #1
End SubPrivate Sub wscData_Close()
wscData.Close
End SubFunction ChkTime()
Dim i As Integer
i = 50
Do While i > 0
If Tmp <> "" Then Exit Function
Sleep (100)
DoEvents
i = i - 1
Loop
wscControl.Close
ChkTime = True
End FunctionFunction ConnFtp(HostIp, HostPort, User, Pass)
If wscControl Is Nothing Then
Set wscControl = Controls.Add("MSWinsock.Winsock", "wscControl", Me)
TimerControl.Interval = 100
TimerControl.Enabled = True
End If
With wscControl
.RemoteHost = HostIp
.RemotePort = HostPort
.Connect
End With
If ChkTime Then
ConnFtp = "连接超时,是否重试?"
Exit Function
End If
Debug.Print Tmp
Select Case Left(Tmp, 3)
Case "220"
Tmp = ""
wscControl.SendData "USER " & User & vbCrLf
Debug.Print "USER " & User & vbCrLf
If ChkTime Then
ConnFtp = "连接错误USER,是否重试?" & vbCrLf & Tmp
Exit Function
End If
Debug.Print Tmp
Select Case Left(Tmp, 3)
Case "331"
Tmp = ""
wscControl.SendData "PASS " & Pass & vbCrLf
Debug.Print "PASS " & Pass & vbCrLf
PassCS:
If ChkTime Then
ConnFtp = "连接错误PASS,是否重试?" & vbCrLf & Tmp
Exit Function
End If
Debug.Print Tmp
Select Case Left(Tmp, 3)
Case "230"
If InStr(Tmp, "230 ") > 0 Then
ConnFtp = "OK"
Tmp = ""
Exit Function
End If
Tmp = ""
GoTo PassCS
Case "530"
ConnFtp = "登陆失败,用户名或密码错误,是否重试?" & vbCrLf & Tmp
wscControl.Close
Tmp = ""
Exit Function
End Select
End Select
End Select
ConnFtp = "错误"
End FunctionFunction DownFile(File As String, TransferMode As String)
Dim FileHaveLen As String
If wscControl.State <> 7 Then
MsgBox "请确认当前连接状态!1"
Exit Function
End If
wscControl.SendData "NOOP " & vbCrLf
Debug.Print "NOOP " & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 200 Then
Debug.Print Tmp
DownFile = "请确认当前连接状态!2" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
Tmp = ""
End If
If TransferMode = "I" Or TransferMode = "A" Then
wscControl.SendData "TYPE " & TransferMode & vbCrLf
Debug.Print "TYPE " & TransferMode & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 200 Then
Debug.Print Tmp
DownFile = "改变状态失败!" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
Tmp = ""
End If
End If
File = Replace(File, "\", "/")
Dim PathT As String
PathT = Left(File, InStrRev(File, "/"))
If PathT <> "" Then
wscControl.SendData "CWD " & PathT & vbCrLf
Debug.Print "CWD " & PathT & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 250 Then
Debug.Print Tmp
DownFile = "改变目录失败!" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
Tmp = ""
End If
End If
Dim FileT As String
FileT = Right(File, Len(File) - InStrRev(File, "/"))
wscControl.SendData "SIZE " & FileT & vbCrLf
Debug.Print "SIZE " & FileT & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 213 Then
Debug.Print Tmp
DownFile = "取得文件大小失败!" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
FileSize = Right(Tmp, Len(Tmp) - 4)
ProgressBar.Max = FileSize
Print "文件大小:" + CStr(FormatNumber(FileSize / 1024, 2)) + "KB..."
Tmp = ""
End If
wscControl.SendData "PASV" & vbCrLf
Debug.Print "PASV" & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 227 Then
Debug.Print Tmp
DownFile = "获取Pasv端口失败!" & vbCrLf & Tmp
Tmp = ""
Exit Function
Else
Debug.Print Tmp
Dim Tmp1, Tmp2, Tmp3, Tmp4, TmpIp, TmpPort
Tmp1 = InStr(Tmp, Chr(40)) + 1
Tmp2 = InStrRev(Tmp, Chr(41))
Tmp3 = Mid(Tmp, Tmp1, Tmp2 - Tmp1)
Tmp4 = Split(Tmp3, ",")
TmpIp = Tmp4(0) & "." & Tmp4(1) & "." & Tmp4(2) & "." & Tmp4(3)
TmpPort = Tmp4(4) * 256 + Tmp4(5)
Tmp = ""
End If
Open DFile For Binary Lock Write As #1
If LOF(1) > 0 Then
FileHaveLen = FileLen(DFile)
Close #1
If MsgBox("文件已存在,是否续传?", vbYesNo, "提示:") <> vbYes Then
Kill DFile
Else
wscControl.SendData "REST " & FileHaveLen & vbCrLf
Debug.Print "REST " & FileHaveLen & vbCrLf
If ChkTime Or Left(Tmp, 3) <> 350 Then
MsgBox "服务器不支持续传,将重新下载文件!" & vbCrLf & Tmp
Kill DFile
End If
Debug.Print Tmp
Tmp = ""
End If
Else
Close #1
End If
'数据下载部分
If wscData Is Nothing Then
Set wscData = Controls.Add("MSWinsock.Winsock", "wscData", Me)
TimerData.Interval = 100
TimerData.Enabled = True
End If
With wscData
.RemoteHost = TmpIp
.RemotePort = TmpPort
.Connect
End With
wscControl.SendData "RETR " & FileT & vbCrLf
Debug.Print "RETR " & FileT & vbCrLf
If ChkTime Then
DownFile = "连接数据超时!"
Exit Function
End If
Debug.Print Tmp
If InStr(Tmp, "226 ") > 0 Then GoTo End1
Tmp = ""
Do While wscData.State = 7
DoEvents
Loop
If ChkTime Then
DownFile = "下载失败!"
Exit Function
End If
Debug.Print Tmp
End1:
Tmp = ""
DownFile = "OK"
End Function提示 DownFile = "改变目录失败!" & vbCrLf & Tmp
目录 本店介绍/time.swf
main.swf
本店介绍和main.swf是同一级的。
循环下载的时候
下载完本店介绍/time.swf
再下载main.swf的时候 tmp=本店介绍/main.swf
发送的wscControl.SendData "CWD " & PathT & vbCrLf pathT=main.swf
但接收 tmp=本店介绍/main.swf 郁闷
我是菜鸟,还望高手大哥帮我改改,跪谢,另外想找个VB师傅,
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货