外挂编程

开发平台：
Visual Basic

Downloader.ctl：源码内容
							VERSION 5.00
Begin VB.UserControl Downloader 
   ClientHeight    =   2385
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3480
   InvisibleAtRuntime=   -1  'True
   Picture         =   "Downloader.ctx":0000
   ScaleHeight     =   2385
   ScaleWidth      =   3480
End
Attribute VB_Name = "Downloader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Event DownloadProgress(CurBytes As Long, MaxBytes As Long, SaveFile As String)
Event DownloadError(SaveFile As String)
Event DownloadComplete(MaxBytes As Long, SaveFile As String)
Event DownloadAllComplete(FileNotDownload() As String)
Public Testdown As Boolean
Private AsyncPropertyName() As String
Private AsyncStatusCode() As Byte
Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
    On Error Resume Next
        If AsyncProp.BytesMax <> 0 Then
            RaiseEvent DownloadProgress(CLng(AsyncProp.BytesRead), CLng(AsyncProp.BytesMax), AsyncProp.PropertyName)
        End If
        Select Case AsyncProp.StatusCode
          Case vbAsyncStatusCodeSendingRequest
            'Debug.Print "下载连接：", AsyncProp.Target
          Case vbAsyncStatusCodeConnecting
            'Debug.Print "服务器IP：", AsyncProp.Status '显示模板IP
          Case vbAsyncStatusCodeBeginDownloadData
            'Debug.Print "临时文件位置：", AsyncProp.Status '显示临时保存文件路径
            'Case vbAsyncStatusCodeDownloadingData
            '  Debug.Print "Downloading", AsyncProp.Status '显示目标 URL
          Case vbAsyncStatusCodeRedirecting
            Debug.Print "Redirecting", AsyncProp.Status
          Case vbAsyncStatusCodeEndDownloadData
            'Debug.Print "下载地址：", AsyncProp.Status
          Case vbAsyncStatusCodeError
            Debug.Print "Error...aborting transfer", AsyncProp.Status
            CancelAsyncRead AsyncProp.PropertyName
        End Select
End Sub
Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
On Error Resume Next
  Dim f() As Byte, fn As Long
  Dim i As Integer
    On Error Resume Next
        Select Case AsyncProp.StatusCode
          Case vbAsyncStatusCodeEndDownloadData
            fn = FreeFile
            f = AsyncProp.value
            'Debug.Print "保存位置： " & AsyncProp.PropertyName
            Open AsyncProp.PropertyName For Binary Access Write As #fn
            Put #fn, , f
            Close #fn
            RaiseEvent DownloadComplete(CLng(AsyncProp.BytesMax), AsyncProp.PropertyName)
          Case vbAsyncStatusCodeError
            CancelAsyncRead AsyncProp.PropertyName
            RaiseEvent DownloadError(AsyncProp.PropertyName)
        End Select
        For i = 1 To UBound(AsyncPropertyName)
            If AsyncPropertyName(i) = AsyncProp.PropertyName Then
                AsyncStatusCode(i) = AsyncProp.StatusCode
                Exit For
            End If
        Next i
        CheckAllDownloadComplete
End Sub
Private Sub UserControl_Initialize()
On Error Resume Next
    SizeIt
    ReDim AsyncPropertyName(0)
    ReDim AsyncStatusCode(0)
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
    SizeIt
End Sub
Private Sub UserControl_Terminate()
On Error Resume Next
    If UBound(AsyncPropertyName) > 0 Then CancelAllDownload
End Sub
Private Sub SizeIt()
On Error Resume Next
    On Error GoTo ErrorSizeIt
    With UserControl
        .Width = ScaleX(32, vbPixels, vbTwips)
        .Height = ScaleY(32, vbPixels, vbTwips)
    End With
Exit Sub
ErrorSizeIt:
    Testdown = True
Exit Sub
End Sub
Public Sub BeginDownload(URL As String, SaveFile As String, Optional AsyncReadOptions = vbAsyncReadForceUpdate)
On Error Resume Next
    Testdown = False
    On Error GoTo ErrorBeginDownload
    UserControl.AsyncRead URL, vbAsyncTypeByteArray, SaveFile, AsyncReadOptions
    ReDim Preserve AsyncPropertyName(UBound(AsyncPropertyName) + 1)
    AsyncPropertyName(UBound(AsyncPropertyName)) = SaveFile
    ReDim Preserve AsyncStatusCode(UBound(AsyncStatusCode) + 1)
    AsyncStatusCode(UBound(AsyncStatusCode)) = 255
Exit Sub
ErrorBeginDownload:
    Testdown = True
Exit Sub
End Sub
Public Function CancelAllDownload() As Boolean
On Error Resume Next
  Dim i As Integer
    On Error Resume Next
        For i = 1 To UBound(AsyncPropertyName)
            CancelAsyncRead AsyncPropertyName(i)
            'Debug.Print "保存位置：" & AsyncPropertyName(i)
        Next i
        ReDim AsyncPropertyName(0)
        ReDim AsyncStatusCode(0)
        CancelAllDownload = True
End Function
Private Function CheckAllDownloadComplete()
On Error Resume Next
  Dim i As Integer
  Dim FileNotDownload() As String
  Dim AllDownloadComplete As Boolean
    ReDim FileNotDownload(0)
    AllDownloadComplete = True
    For i = 1 To UBound(AsyncStatusCode)
        If AsyncStatusCode(i) = vbAsyncStatusCodeError Then
            ReDim Preserve FileNotDownload(UBound(FileNotDownload) + 1)
            FileNotDownload(UBound(FileNotDownload)) = AsyncPropertyName(i)
          ElseIf AsyncStatusCode(i) <> vbAsyncStatusCodeEndDownloadData Then
            AllDownloadComplete = False
            Exit For
        End If
    Next i
    If AllDownloadComplete Then
        CancelAllDownload
        RaiseEvent DownloadAllComplete(FileNotDownload)
    End If
End Function

						