ydownload.ctl

可以看到ftp与http下载的源理

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl yDownload 
   ClientHeight    =   960
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5760
   ScaleHeight     =   960
   ScaleWidth      =   5760
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   2175
      TabIndex        =   1
      Top             =   405
      Width           =   1305
   End
   Begin MSComctlLib.ProgressBar ProgressBar 
      Height          =   315
      Left            =   30
      TabIndex        =   0
      Top             =   30
      Width           =   5720
      _ExtentX        =   10081
      _ExtentY        =   556
      _Version        =   393216
      Appearance      =   1
      Min             =   50
      Scrolling       =   1
   End
   Begin VB.Timer BeginTime 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   1395
      Top             =   465
   End
   Begin VB.Timer DownAgain 
      Enabled         =   0   'False
      Interval        =   2000
      Left            =   1410
      Top             =   30
   End
   Begin MSWinsockLib.Winsock HttpSock 
      Index           =   0
      Left            =   960
      Top             =   30
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockData 
      Index           =   0
      Left            =   540
      Top             =   30
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockConnect 
      Index           =   0
      Left            =   120
      Top             =   30
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockConnect 
      Index           =   1
      Left            =   120
      Top             =   450
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockConnect 
      Index           =   2
      Left            =   120
      Top             =   870
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockConnect 
      Index           =   3
      Left            =   120
      Top             =   1290
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockConnect 
      Index           =   4
      Left            =   120
      Top             =   1710
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockData 
      Index           =   1
      Left            =   510
      Top             =   450
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockData 
      Index           =   2
      Left            =   540
      Top             =   870
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockData 
      Index           =   3
      Left            =   540
      Top             =   1290
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock SockData 
      Index           =   4
      Left            =   540
      Top             =   1710
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock HttpSock 
      Index           =   1
      Left            =   960
      Top             =   450
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock HttpSock 
      Index           =   2
      Left            =   960
      Top             =   870
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock HttpSock 
      Index           =   3
      Left            =   960
      Top             =   1290
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock HttpSock 
      Index           =   4
      Left            =   960
      Top             =   1710
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "yDownload"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'定义系统使用函数
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private CanDown As Boolean
Private ServerName As String
Private ServerPath As String
Private DataPort As Long
Private NoErr As Boolean
Private SendOk As Boolean
Private Closeed As Boolean
Private EndPosition(4) As Long
Private TmpPosition(4) As Long
Private DownNoBeg(4) As Boolean
Private Position(4) As Long
Private AlreadyDown(4) As Long
Private TmpConnect(4) As String
'Private DownSize(4) As Long
Private FR(4) As Integer
Private ExitCode As Boolean
Public URL As String
Public LocalPath As String
Private DownloadisOk  As Boolean
Public CanDownLoad As Boolean
Public Already1 As Long
Public Already2 As Long
Public Already3 As Long
Public Already4 As Long
Public Already5 As Long
Public FirstProcess As Boolean
Public State As String
Public Last_Modified As String
Private HttpCloseLast(4) As Boolean
Private CheckInfo As Boolean
'定义属性 变量

Private varTimeOut  As Long
Private varUserName As String
Private varPassWord As String
Private varProcess As Integer
Private varPathName As String
Public FileLengths As Long
Public DownLen As Long
'定义事件
Public Event OnCompleted()
Public Event OnError(ErrorMessage As String)
Public Event OnBegin(Message As String)
Public Event OnEnd(Check_End As Boolean)
Public Event OnGetData(HsDown As Long)
Public Event OnMessageReceive(Message As String)
Public Event OnMessageSend(Message As String)

'定义属性

'取超时长度
Public Property Get TimeOut() As Long
    TimeOut = varTimeOut
End Property
Public Property Let TimeOut(ByVal vTimeOut As Long)
    varTimeOut = vTimeOut
End Property

'取用户名
Public Property Get PathName() As String
    PathName = varPathName
End Property

Public Property Let PathName(ByVal vPathName As String)
    varPathName = vPathName
End Property

Public Property Get UserName() As String
    UserName = varUserName
End Property
Public Property Let UserName(ByVal vUserName As String)
    varUserName = vUserName
End Property
'取密码
Public Property Get PassWord() As String
    PassWord = varPassWord
End Property
Public Property Let PassWord(ByVal vPassWord As String)
    varPassWord = vPassWord
End Property
'取进程数
Public Property Get Process() As String
    Process = varProcess
End Property
Public Property Let Process(ByVal vProcess As String)
    varProcess = vProcess
End Property
Public Sub GetUrlInfo(UrlString As String, Optional Uname As String, Optional Pass As String)
    CanDownLoad = True
    Closeed = False
    CloseAll
    CloseAllHttp
    NoErr = False
    SendOk = False
    DownloadisOk = False
    ExitCode = False
    Last_Modified = ""
    CanDown = False
    CheckInfo = True
    Already1 = 0
    Already2 = 0
    Already3 = 0
    Already4 = 0
    Already5 = 0
    URL = LCase(UrlString)
    TimeOut = 60
    If Pass = "" Then PassWord = "[e-mail]"
    
    If Uname = "" Then
        UserName = "anonymous"
        PassWord = "[e-mail]"
    End If
    If URL = "" Then
        RaiseEvent OnError("URL为空，请设置完整URL")
        Me.LinkClose
        Exit Sub
    Else
        If GetServerName(URL) = False Then
            RaiseEvent OnError("分析URL时出错")
            Me.LinkClose
            Exit Sub
        End If
        If GetServerPath(URL) = False Then
            RaiseEvent OnError("分析URL中路径时出错")
            Me.LinkClose
            Exit Sub
        End If
    End If
    If Left(LCase(URL), 4) = "http" Then
       HttpInfo
    Else
        RaiseEvent OnError("无http开头")
        Me.LinkClose
        Exit Sub
    End If
    Me.LinkClose
    Exit Sub
123:
    RaiseEvent OnError(Err.Description)
    Err.Clear
    Me.LinkClose
End Sub

Private Sub HttpInfo()
Dim WebString As String
    HttpSock(0).Close
    HttpSock(0).RemoteHost = ServerName
    HttpSock(0).RemotePort = 80
    HttpSock(0).Connect
    TimeOut_Check
    If Not SendOk Then
        Me.LinkClose
        Exit Sub
    End If
    WebString = "GET " & URL & " HTTP/1.0" & vbCrLf
    WebString = WebString & "Host: " & ServerName & vbCrLf
    WebString = WebString & "Accept: */*" & vbCrLf
    WebString = WebString & "Referer: http://" & ServerName & vbCrLf
    WebString = WebString & "User-Agent: Mozilla/4.0 (compatible; MSIE 5.00; Windows 98)" & vbCrLf
    If AlreadyDown(0) <> 0 Then
        WebString = WebString & "Range: bytes=" & CStr(AlreadyDown(0)) & "-" & vbCrLf
    End If
    WebString = WebString & "cache -Control: no -cache" & vbCrLf
    WebString = WebString & "Connection: Close" & vbCrLf & vbCrLf
    RaiseEvent OnMessageSend(WebString)
    SendOk = False
    NoErr = False
    DownNoBeg(0) = False
    If HttpSock(0).State = 7 Then
        HttpSock(0).SendData WebString
        TimeOut_Check
        If SendOk = False Then
            Me.LinkClose
            Exit Sub
        End If
    Else
        Me.LinkClose
        Exit Sub
    End If
    Exit Sub
123:
    RaiseEvent OnError(Err.Description)
    NoErr = True
    SendOk = False
    Err.Clear
End Sub

Public Sub DownTo(UrlString As String, LPath As String, Optional Continue As Boolean = True)
Dim AA As String
Dim i As Integer
Dim F As Integer
Dim TB As Boolean
Dim strget As String * 100
On Error GoTo 123
    CanDownLoad = True
    FirstProcess = False
    Closeed = False
    CloseAll
    CloseAllHttp
    Last_Modified = ""
    NoErr = False
    SendOk = False
    DownloadisOk = False
    CheckInfo = False
    ExitCode = False
    CanDown = False
    Already1 = 0
    Already2 = 0
    Already3 = 0
    Already4 = 0
    Already5 = 0
    State = "等待"
    RaiseEvent OnBegin("检测中")
    If Process < 1 Then Process = 1
    If Process > 5 Then Process = 5
    If TimeOut < 30 Then TimeOut = 120
    URL = LCase(UrlString)
    LocalPath = LCase(LPath)
    If LocalPath = "" Then LocalPath = App.Path
    If Right(LocalPath, 1) <> "\" Then LocalPath = LocalPath & "\"
    If Not CreatePath(LocalPath) Then
        RaiseEvent OnError("创建本地路径出错")
        Me.LinkClose
        Exit Sub
    End If
    LocalPath = LocalPath & GetFileName(URL)
    
    If UserName = "" Then
        UserName = "anonymous"
        PassWord = "[e-mail]"
    End If
    
    If PathName <> "" Then
        F = FreeFile
        If Dir(PathName) = "" Then
            Open PathName For Output As #F
            Close #F
        End If
    End If
    If Dir(LocalPath) = "" Then
        WritePrivateProfileString LCase(URL & LocalPath), 0&, 0&, PathName
        For i = 0 To Process - 1
            AlreadyDown(i) = 0
        Next i
    End If
    
    
    For i = 0 To Process - 1
        If Continue = True Then
            strget = ""
            GetPrivateProfileString LCase(URL & LocalPath), "P" & CStr(i), "0", strget, 100, PathName
            If IsNumeric(NoVbNull(strget)) Then
                AlreadyDown(i) = CLng(NoVbNull(strget))
            Else
                AlreadyDown(i) = 0
            End If