如何用Winsock下载任意文件?

winsock1,remotehost="下载的网址晌模"败谨薯

winsock1.remoteport=25

winsock1.connect

private sub winsock1_dataarrival

winsock1.getdata webdata,vbstring

winsock1 seddata

我 知道的就察者是这多了

Option Explicit

Private Declare Sub Sleep Lib "袭脊kernel32" (ByVal dwMilliseconds As Long)

Private Info() As String, TimerCountA As Long

Private WithEvents wscControl As MSWinsockLib.Winsock

Private WithEvents wscData As MSWinsockLib.Winsock

Private Tmp As String, FileSize As String, DFile As String

Private Sub TimerControl_Timer()

LabelControl.Caption = "控制连接状态：" &WinSState(wscControl.State)

End Sub

Private Sub TimerData_Timer()

LabelData.Caption = "数据连接状态：" &WinSState(wscData.State)

End Sub

Private Sub wscControl_DataArrival(ByVal bytesTotal As Long)

Dim i As String

wscControl.GetData Tmp

End Sub

Private 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 Sub

Private Sub wscData_Close()

wscData.Close

End Sub

Function 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 Function

Function 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 Function

Function 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

Private Sub Command2_Click()

Dim n

DFile = "C:\Documents and Settings\Administrator\桌面\a.rar"

a1:

n = ConnFtp("127.0.0.1", "21", "temp", "tmp")

If n <>"OK" Then

If MsgBox(n, vbYesNo, "提示：") = vbYes Then GoTo a1

Exit Sub

End If

n = DownFile("system\a.rar", "I")

If n <>"OK" Then

MsgBox n, , "提示："

Exit Sub

End If

MsgBox "下载成功！"

End Sub

'时间有限只能给你写这些了！以后有机会的话再给你贴吧！我QQ155209220

---