?? clsdown.cls
字號(hào):
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsDown"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'表示正在下載一個(gè)任務(wù)
Public bBusy As Boolean
'要下載的url地址
Public DownUrl As String
'使用的Winsock的索引
Public WhichSocket As Integer
'下載任務(wù)的索引
Public WhichDown As Integer
'接收到的下載數(shù)據(jù)(字符串類型)
Public ReceiveData As String
'下載的開始連接時(shí)間
Public StartTime As Date
'已下載的文件數(shù)據(jù)字節(jié)數(shù)
Public ReceiveBytes As Long
'下載文件長(zhǎng)度
Public mFlen As Long
'用戶是否取消下載
Public bCancel As Boolean
'代理服務(wù)器地址和端口
Public mProxy As String
Public mProxyPort As Integer
'代理服務(wù)器的認(rèn)證帳號(hào)及密碼
Public mProxyId As String
Public mProxyPass As String
'保存的文件路徑
Public mFile As String
'連接的主機(jī)名和端口
Private mHost As String
Private mPort As Integer
'下載的相對(duì)URL
Private mRelativeUrl As String
'分析下載的URL
Public Function AnalyzeUrl() As Boolean
Dim pos1, pos2 As Integer
Dim mUrl As String
mUrl = DownUrl
If InStr(1, mUrl, "http://") > 0 Then
'得到端口號(hào)
mPort = 80
Else
AnalyzeUrl = False
Exit Function
End If
pos1 = InStr(1, mUrl, "http://")
pos2 = InStr(8, mUrl, "/")
If pos2 = 0 Then
AnalyzeUrl = False
Exit Function
Else
'得到主機(jī)地址
mHost = Mid(mUrl, 8, pos2 - 8)
'得到相對(duì)路徑
mRelativeUrl = Mid(mUrl, pos2)
End If
pos2 = InStrRev(mUrl, "/")
If pos2 > 8 Then
'得到文件名
mFile = Mid(mUrl, pos2 + 1)
Else
AnalyzeUrl = False
Exit Function
End If
AnalyzeUrl = True
End Function
'根據(jù)代理的設(shè)置使用不同的函數(shù)連接服務(wù)器
'連接成功返回true,否則返回false
Public Function StartDown() As Boolean
bBusy = True
If mProxy <> "" And mProxyPort > 0 Then
'使用代理服務(wù)器下載
StartDown = StartDownProxy()
Else
'直接下載
StartDown = StartDownNoProxy()
End If
End Function
'直接連接Url指定的服務(wù)器下載
Public Function StartDownNoProxy() As Boolean
StartTime = Time()
'設(shè)置Winsock屬性并連接服務(wù)器
frmDown.Wsock(WhichSocket).RemoteHost = mHost
frmDown.Wsock(WhichSocket).RemotePort = mPort
frmDown.Wsock(WhichSocket).Connect
'使用循環(huán)等待連接服務(wù)器成功
Do While frmDown.Wsock(WhichSocket).State <> sckConnected
DoEvents: DoEvents: DoEvents: DoEvents
'連接時(shí)間超過20秒或取消下載,退出該過程并返回false
If DateDiff("s", StartTime, Time()) > 20 Or bCancel = True Or bBusy = False Then
frmDown.CloseSocket WhichSocket, "連接服務(wù)器時(shí)間過長(zhǎng)"
StartDownNoProxy = False
Exit Function
End If
Loop
'向服務(wù)器發(fā)送下載文件請(qǐng)求
Dim Getstr As String
Getstr = Getstr & "GET " & mRelativeUrl & " HTTP/1.1" & vbCrLf
Getstr = Getstr & "Accept: */*" & vbCrLf
Getstr = Getstr & "Accept -Language: zh -cn" & vbCrLf
Getstr = Getstr & "Accept -Encoding: gzip , deflate" & vbCrLf
Getstr = Getstr & "User-Agent: DownJet1.0" & vbCrLf
Getstr = Getstr & "Host: " & mHost & vbCrLf
If mFlen > 0 Then
'如果以前已經(jīng)下載了一部分?jǐn)?shù)據(jù),發(fā)送斷點(diǎn)續(xù)傳請(qǐng)求
Getstr = Getstr & "Range: bytes=" & ReceiveBytes & "-" & vbCrLf
End If
Getstr = Getstr & "Connection: close" & vbCrLf
Getstr = Getstr & vbCrLf
frmDown.Wsock(WhichSocket).SendData Getstr
StartDownNoProxy = True
End Function
'通過代理服務(wù)器連接下載
Public Function StartDownProxy() As Boolean
StartTime = Time()
'設(shè)置winsock屬性并連接代理服務(wù)器
frmDown.Wsock(WhichSocket).RemoteHost = mProxy
frmDown.Wsock(WhichSocket).RemotePort = mProxyPort
frmDown.Wsock(WhichSocket).Connect
Do While frmDown.Wsock(WhichSocket).State <> sckConnected
DoEvents: DoEvents: DoEvents: DoEvents
If DateDiff("s", StartTime, Time()) > 10 Or bCancel = True Or bBusy = False Then
frmDown.CloseSocket WhichSocket, "連接代理服務(wù)器時(shí)間過長(zhǎng)"
StartDownProxy = False
Exit Function
End If
Loop
'Mozilla/4.0 (compatible; MSIE 4.01; Windows 98)
'向代理服務(wù)器發(fā)送下載文件請(qǐng)求
Dim Getstr As String
Getstr = Getstr & "GET " & DownUrl & " HTTP/1.1" & vbCrLf
Getstr = Getstr & "Accept: */*" & vbCrLf
Getstr = Getstr & "Accept -Language: zh -cn" & vbCrLf
Getstr = Getstr & "Accept -Encoding: gzip , deflate" & vbCrLf
Getstr = Getstr & "User-Agent: DownJet1.0" & vbCrLf
Getstr = Getstr & "Host: " & mHost & vbCrLf
If mProxyId <> "" Then
'如果使用身份驗(yàn)證,編碼后加入到請(qǐng)求字符串中
Getstr = Getstr & "Proxy-Authorization: Basic " & EncodeStr(mProxyId & ":" & mProxyPass) & vbCrLf
End If
If mFlen > 0 Then
'如果以前已經(jīng)下載了一部分?jǐn)?shù)據(jù),發(fā)送斷點(diǎn)續(xù)傳請(qǐng)求
Getstr = Getstr & "Range: bytes=" & ReceiveBytes & "-" & vbCrLf
End If
Getstr = Getstr & "Connection: close" & vbCrLf
Getstr = Getstr & vbCrLf
frmDown.Wsock(WhichSocket).SendData Getstr
StartDownProxy = True
End Function
'分析并保存Winsock得到服務(wù)器響應(yīng)的數(shù)據(jù)
'入口變量
'ByteNum: 接收到數(shù)據(jù)的字節(jié)數(shù)
'ByteData: 接收數(shù)據(jù)的Byte類型的數(shù)組
'出口變量:
'Flen: 文件長(zhǎng)度
'函數(shù)返回值:表示一定意思的字符串
Public Function SaveData(ByteNum As Long, ByteData() As Byte, Flen As Long) As String
Dim Tfile As String
Dim Fnum As Integer
Static m3Byte(3) As Byte
Static bAppend As Boolean
Dim StartPos As Long
Dim i As Long
If bAppend = False Then
ReceiveData = ReceiveData & StrConv(ByteData(), vbUnicode)
Clipboard.SetText ReceiveData
If (InStr(1, ReceiveData, "HTTP/1.0 200 OK") Or InStr(1, ReceiveData, "HTTP/1.1 200 OK")) Then
'表示請(qǐng)求下載文件成功
SaveData = "200"
ElseIf (InStr(1, ReceiveData, "HTTP/1.0 206 ") Or InStr(1, ReceiveData, "HTTP/1.1 206")) Then
'表示請(qǐng)求斷點(diǎn)續(xù)傳成功
SaveData = "206"
ElseIf (InStr(1, ReceiveData, "HTTP/1.0 404 ") Or InStr(1, ReceiveData, "HTTP/1.1 404")) Then
'表示服務(wù)器未找到請(qǐng)求的資源
SaveData = "404"
Else
'請(qǐng)求錯(cuò)誤
SaveData = "error"
Exit Function
End If
'如果服務(wù)器響應(yīng)的字符串有指定文件大小的標(biāo)題字段,取得文件大小
If InStr(1, ReceiveData, "Content-Length:") > 0 And mFlen = 0 Then
Dim pos1 As Long, pos2 As Long
pos1 = InStr(1, ReceiveData, "Content-Length:")
pos2 = InStr(pos1 + 16, ReceiveData, vbCrLf)
If pos2 > pos1 Then
mFlen = Mid(ReceiveData, pos1 + 16, pos2 - pos1 - 16)
Flen = mFlen
End If
End If
'從服務(wù)器響應(yīng)返回的數(shù)據(jù)中查找下載文件的起始位置
For i = 0 To UBound(ByteData()) - 3
If ByteData(i) = 13 And ByteData(i + 1) = 10 And ByteData(i + 2) = 13 And ByteData(i + 3) = 10 Then
StartPos = i + 4
bAppend = True
Exit For
End If
Next i
End If
'如果取消,則退出該過程,并返回字符串“cancel”
If bAppend = False Then
If bCancel = True Then
SaveData = "cancel"
End If
Exit Function
End If
'在調(diào)用frmDown的Public函數(shù)DraoDownPic反映下載情況
frmDown.DrawDownPic WhichSocket, ByteNum - StartPos, mFlen, ReceiveBytes
ReceiveBytes = ReceiveBytes + ByteNum - StartPos
Tfile = mFile
Fnum = FreeFile()
'向二進(jìn)制文件中加入下載文件的數(shù)據(jù)
Open Tfile For Binary Lock Write As #Fnum
If LOF(Fnum) > 0 Then
Seek #Fnum, LOF(Fnum) + 1
End If
If StartPos > 0 Then
For i = StartPos To UBound(ByteData())
Put #Fnum, , ByteData(i)
Next i
Else
Put #Fnum, , ByteData()
End If
Close #Fnum
'If bCancel = True Then
' SaveData = "cancel"
'End If
End Function
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -