?? form1.frm
字號:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
Caption = "文件下載"
ClientHeight = 5430
ClientLeft = 60
ClientTop = 345
ClientWidth = 4125
LinkTopic = "Form1"
ScaleHeight = 5430
ScaleWidth = 4125
StartUpPosition = 3 '窗口缺省
Begin VB.Timer Timer2
Interval = 1000
Left = 840
Top = 2880
End
Begin VB.Timer Timer1
Interval = 1
Left = 120
Top = 2880
End
Begin MSWinsockLib.Winsock Winsock
Left = 960
Top = 2400
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.TextBox TxtHead
Height = 2055
Left = 0
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 18
Text = "Form1.frx":0000
Top = 3240
Width = 4095
End
Begin VB.PictureBox Picture1
Height = 1455
Left = 1440
ScaleHeight = 1395
ScaleWidth = 2355
TabIndex = 11
Top = 1560
Width = 2415
Begin VB.Label LabelEtm
AutoSize = -1 'True
Caption = "LabelEtm"
Height = 180
Left = 120
TabIndex = 17
Top = 1200
Width = 720
End
Begin VB.Label LabelGtm
AutoSize = -1 'True
Caption = "LabelGtm"
Height = 180
Left = 120
TabIndex = 16
Top = 960
Width = 720
End
Begin VB.Label LabelSpe
AutoSize = -1 'True
Caption = "LabelSpe"
Height = 180
Left = 120
TabIndex = 15
Top = 720
Width = 720
End
Begin VB.Label LabelPer
AutoSize = -1 'True
Caption = "LabelPer"
Height = 180
Left = 120
TabIndex = 14
Top = 480
Width = 720
End
Begin VB.Label LabelGot
AutoSize = -1 'True
Caption = "LabelGot"
Height = 180
Left = 120
TabIndex = 13
Top = 240
Width = 720
End
Begin VB.Label LabelSize
AutoSize = -1 'True
Caption = "LabelSize"
Height = 180
Left = 120
TabIndex = 12
Top = 0
Width = 810
End
End
Begin VB.CommandButton Command3
Caption = "停止下載"
Height = 495
Left = 2760
TabIndex = 4
Top = 960
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "暫停下載"
Height = 495
Left = 1320
TabIndex = 3
Top = 960
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "開始下載"
Height = 495
Left = 0
TabIndex = 1
Top = 960
Width = 1215
End
Begin VB.TextBox TxtUrl
Height = 375
Left = 0
TabIndex = 0
Text = "Text1"
Top = 480
Width = 4095
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "剩余時間："
Height = 180
Left = 0
TabIndex = 10
Top = 2760
Width = 900
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "已用時間："
Height = 180
Left = 0
TabIndex = 9
Top = 2520
Width = 900
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "下載速率："
Height = 180
Left = 0
TabIndex = 8
Top = 2280
Width = 900
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "得到的百分比："
Height = 180
Left = 0
TabIndex = 7
Top = 2040
Width = 1260
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "已經得到的大小："
Height = 180
Left = 0
TabIndex = 6
Top = 1800
Width = 1440
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "文件大小："
Height = 180
Left = 0
TabIndex = 5
Top = 1560
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "下載路徑和文件名："
Height = 180
Left = 0
TabIndex = 2
Top = 120
Width = 1620
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DATA As String
Dim Percent%
Dim BeginTransfer As Single
Dim BytesAlreadySent As Single
Dim BytesRemaining As Single
Dim Header As Variant
Dim Status As String
Dim TransferRate As Single
Function ConvertTime(TheTime As Single)
'處理時間的顯示
Dim NewTime As String
Dim Sec As Single
Dim Min As Single
Dim H As Single
If TheTime > 60 Then
Sec = TheTime
Min = Sec / 60
Min = Int(Min)
Sec = Sec - Min * 60
H = Int(Min / 60)
Min = Min - H * 60
NewTime = H & ":" & Min & ":" & Sec
If H < 0 Then H = 0
If Min < 0 Then Min = 0
If Sec < 0 Then Sec = 0
NewTime = Format(NewTime, "HH:MM:SS")
ConvertTime = NewTime
End If
If TheTime < 60 Then
NewTime = "00:00:" & TheTime
NewTime = Format(NewTime, "HH:MM:SS")
ConvertTime = NewTime
End If
End Function
Public Function StartUpdate(strURL As String)
'獲得主機地址和文件名
BytesAlreadySent = 1
If strURL = "" Then Exit Function
URL = strURL
Dim Pos%, LENGTH%, NextPos%, LENGTH2%, POS2%, POS3%
Pos = InStr(strURL, "://")
LENGTH2 = Len("://")
LENGTH = Len(strURL)
If InStr(strURL, "://") Then
strURL = Right(strURL, LENGTH - LENGTH2 - Pos + 1)
End If
If InStr(strURL, "/") Then
POS2 = InStr(strURL, "/")
'獲得文件名
Dim StrFile$: StrFile = strURL
Do Until InStr(StrFile, "/") = 0
LENGTH2 = Len(StrFile)
POS3 = InStr(StrFile, "/")
StrFile = Right(strURL, LENGTH2 - POS3)
Loop
FileName = StrFile
strSvrURL = Left(strURL, POS2 - 1) 'removes everything after the / mark leaving just the server name as the end result
End If
Winsock.Connect strSvrURL, 80
FilePathName = "C:\" & FileName
End Function
Public Sub CloseSocket()
'關閉Socket
Do Until Winsock.State = 0
Winsock.Close
Winsock.LocalPort = 0
Close #1
Loop
End Sub
Public Sub Reset()
'重置
CloseSocket
DATA = ""
Percent = 0
BeginTransfer = 0
BytesAlreadySent = 1
BytesRemaining = 0
Status = ""
Header = ""
RESUMEFILE = False
Command1.Enabled = True
End Sub
Private Sub Command1_Click()
FilePath = InputBox("請輸入要保存到的路徑：", "SaveTo", "c:\")
StartUpdate TxtUrl
FilePathName = FilePath & FileName
End Sub
Private Sub Command2_Click()
If BytesRemaining > BytesAlreadySent Then
If Winsock.State > 0 Then
DATA = ""
BeginTransfer = 0
Status = ""
Header = ""
CloseSocket
Else
FileLength = FileLen(FilePathName)
RESUMEFILE = True
Main.Winsock.Connect strSvrURL, 80
End If
End If
End Sub
Private Sub Command3_Click()
If Winsock.State > 0 Then
CloseSocket
Reset
End If
End Sub
Private Sub Form_Load()
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
If BytesRemaining > 0 And BytesAlreadySent > 0 Then
If BytesRemaining <= BytesAlreadySent Then
LabelSpe = 0
CloseSocket
LabelEtm = Format(Hr & ":" & Min & ":" & Sec, "HH:MM:SS")
Command1.Enabled = False
Reset
Else
Sec = Sec + 1
If Sec >= 60 Then
Sec = 0
Min = Min + 1
ElseIf Min >= 60 Then
Min = 0
Hr = Hr + 1
End If
Command1.Enabled = True
LabelGtm = Format(Hr & ":" & Min & ":" & Sec, "HH:MM:SS")
LabelEtm = ConvertTime(Int(((BytesRemaining - BytesAlreadySent) / 1024) / TransferRate))
LabelSpe = TransferRate
End If
End If
End Sub
Private Sub Timer2_Timer()
On Error Resume Next
If BytesRemaining > 0 And BytesAlreadySent > 0 Then
If BytesRemaining <= BytesAlreadySent Then
LabelSpe = 0
CloseSocket
LabelGtm = Format(Hr & ":" & Min & ":" & Sec, "HH:MM:SS")
Command1.Enabled = False
Reset
Else
Sec = Sec + 1
If Sec >= 60 Then
Sec = 0
Min = Min + 1
ElseIf Min >= 60 Then
Min = 0
Hr = Hr + 1
End If
Command1.Enabled = True
LabelGtm = Format(Hr & ":" & Min & ":" & Sec, "HH:MM:SS")
LabelEtm = ConvertTime(Int(((BytesRemaining - BytesAlreadySent) / 1024) / TransferRate))
LabelSpe = TransferRate
End If
End If
End Sub
Private Sub Winsock1_Connect()
Dim strCommand As String
On Error Resume Next
If Not Unix Then
strCommand = "GET " + URL + " HTTP/1.0" + vbCrLf
Else
strCommand = "GET " + "/" + FileName + " HTTP/1.0" + vbCrLf
End If
strCommand = strCommand + "Accept: *.*, */*" + vbCrLf
If RESUMEFILE = True Then strCommand = strCommand + "Range: bytes=" & FileLength & "-" & vbCrLf
strCommand = strCommand + "User-Agent: Conquest" & vbCrLf
If Not Unix Then
strCommand = strCommand + "Referer: " & strSvrURL & vbCrLf
Else
strCommand = strCommand + "Host: " & strSvrURL & vbCrLf
End If
strCommand = strCommand + vbCrLf
Winsock.SendData strCommand
BeginTransfer = Timer
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock.GetData DATA, vbString
If InStr(DATA, "Content-Type:") Then
If RESUMEFILE = True Then
If InStr(DATA, "HTTP/1.1 206 Partial Content") = 0 Then
MsgBox "服務器不支持暫停！", vbCritical, "No Resuming Support"
Exit Sub
Reset
CloseSocket
End If
End If
If InStr(DATA, "404 Not Found") > 0 Then
If Not Unix Then
Unix = True
Reset
CloseSocket
Main.Winsock.Connect strSvrURL, 80
Exit Sub
End If
Unix = False
MsgBox "服務器上沒有這個文件！", vbCritical, "File Not Found"
Reset
CloseSocket
Exit Sub
End If
Dim Pos%, LENGTH%, HEAD$
Pos = InStr(DATA, vbCrLf & vbCrLf)
LENGTH = Len(DATA)
HEAD = Left(DATA, Pos - 1)
DATA = Right(DATA, LENGTH - Pos - 3)
Header = Header & HEAD
If RESUMEFILE = True Then
BytesAlreadySent = FileLength + 1
BytesRemaining = GETDATAHEAD(Header, "Content-Length:")
BytesRemaining = BytesRemaining + FileLength
Else
BytesRemaining = GETDATAHEAD(Header, "Content-Length:")
End If
TxtHead = Header
End If
'將文件寫入本地磁盤
Open FilePathName For Binary Access Write As #1
Put #1, BytesAlreadySent, DATA
BytesAlreadySent = Seek(1)
Close #1
If RESUMEFILE = False Then
TransferRate = Format(Int(BytesAlreadySent / (Timer - BeginTransfer)) / 1000, "####.00")
Else
TransferRate = Format(Int((BytesAlreadySent - FileLength) / (Timer - BeginTransfer)) / 1000, "####.00")
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -