frmupdate.frm

一个比较简单美观的魔域登陆器源码

VERSION 5.00
Begin VB.Form frmUpdate 
   BorderStyle     =   0  'None
   ClientHeight    =   1965
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6750
   LinkTopic       =   "Form1"
   Picture         =   "frmUpdate.frx":0000
   ScaleHeight     =   1965
   ScaleWidth      =   6750
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin 雷鸣魔域.bkDLControl dlc_Progress 
      Height          =   255
      Left            =   480
      Top             =   1200
      Width           =   5895
      _ExtentX        =   10398
      _ExtentY        =   450
      BackColor       =   65535
      ForeColor       =   255
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "◆退出"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   5520
      MouseIcon       =   "frmUpdate.frx":6653
      MousePointer    =   99  'Custom
      TabIndex        =   2
      Top             =   360
      Width           =   735
   End
   Begin VB.Label clblProgress 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   4800
      TabIndex        =   1
      Top             =   960
      Width           =   1575
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "正在下载更新包,请稍后..."
      ForeColor       =   &H0000FFFF&
      Height          =   255
      Left            =   360
      TabIndex        =   0
      Top             =   840
      Width           =   2415
   End
End
Attribute VB_Name = "frmUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFFFFFF

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public RunPatchName As String
Dim i, x1 As Double, y1 As Double, x2 As Double, y2 As Double

Public Sub subUpdate(ByVal paraInfo As String)

RunPatchName = Mid(paraInfo, InStrRev(paraInfo, "/") + 1)
    
    With dlc_Progress
        .FileURL = paraInfo
        .SaveFilePath = App.Path
        .BeginDownload 'Function returns True if successful
        'note that if we send True as the parameter of BeginDownload,
        'the program would have stopped until the download ended.
        'It would then return True if the d/l was successful, False if it failed
    End With
    
End Sub


'The following are all events recieved from the DL control.
'I chose to make them seperate events rather than a single event
'with a status code to make the end code more readable and
'more easily give new programmers access to functions they
'might not realize were there.
Private Sub dlc_Progress_DLBeginDownload()
'    With lblFile()
'        .ToolTipText = dlc_Progress.SaveFileName
'        .Caption = FitPathToSize(.ToolTipText, .Width)
'    End With
End Sub

Private Sub dlc_Progress_DLCacheFile(FileName As String)
'    'returns local cache file location
'    LogItem Index, "Cache File: " & FileName
End Sub

Private Sub dlc_Progress_DLCanceled()
'    'canceled by user
'    ClearLabels Index
'    LogItem Index, "Download Canceled"
End Sub

Private Sub dlc_Progress_DLComplete(Bytes As Long)
'    'download terminated - bytes is > 0 if successful (file size)
'    If Bytes > 0& Then
'        LogItem Index, "Complete. " & SizeString(Bytes) & " downloaded and saved as " & DL(Index).SaveFileName
'    Else
'        LogItem Index, "Download failed."
'    End If
'    SetCancel Index, False

        Dim lngPId As Long
        Dim lngPHandle As Long

        lngPId = Shell(RunPatchName, 1)
        lngPHandle = OpenProcess(SYNCHRONIZE, 0, lngPId)
        If lngPHandle <> 0 Then
              Call WaitForSingleObject(lngPHandle, INFINITE) '无限等待，直到程式结束
              Call CloseHandle(lngPHandle)
        End If


End Sub

'Returns IP address of successful connection
Private Sub dlc_Progress_DLConnected(ConnAddr As String)
'    LogItem Index, "Connected to " & ConnAddr
End Sub
'Error!  See UC code for different possible errors
'This event is always followed by DLComplete returning 0 bytes
Private Sub dlc_Progress_DLError(E As bkDLError, Error As String)
Dim strErrType As String
    Select Case E
        Case bkDLEUnavailable
            strErrType = "下载失败..."
        Case bkDLERedirect
            strErrType = "重新定向..."
        Case bkDLEZeroLength
            strErrType = "文件错误..."
        Case bkDLESaveError
            strErrType = "资源释放完成就可以开始游戏了..."
        Case bkDLEUnknown
            strErrType = "未知错误..."
    End Select
'    ClearLabels Index
    MsgBox "提示 - " & strErrType & "", vbOKOnly, "信息"
    frmMain.Visible = True
    Unload frmUpdate

End Sub

Private Sub dlc_Progress_DLMIMEType(MIMEType As String)
    'handy info!
'    LogItem Index, "MIME type is " & MIMEType
End Sub

Private Sub dlc_Progress_DLRedirect(ConnAddr As String)
    'Returns path to file if redirected
    'This event wont fire at all if FailOnRedirect is True! (DLError instead)
'    LogItem Index, "Redirected to " & ConnAddr
End Sub


Private Sub dlc_Progress_DLProgress(Percent As Single, BytesRead As Long, TotalBytes As Long)
    'Progress two ways: Percentage, or BytesRead vs. Total Bytes (yeah, I know, with that
    'you can figure it out yourself, but since I was already calculating it for the
    'control figured I'd save you the duplication of work and pass it on!
    'Hey, this is source code-- change it if you don't like it!
    clblProgress = Format(Percent, "0%") & " of " & SizeString(TotalBytes)
End Sub

Private Sub dlc_Progress_DLFileSize(Bytes As Long)
    'Size in bytes.  returned when connection to file is complete
    'and download actually begins
'    LogItem Index, "File size is " & SizeString(Bytes) & " (" & CStr(Bytes) & " bytes)"
End Sub

'Misc Functions you may find useful...
'Convert size in bytes to string representation in
Private Function SizeString(lBytes As Long) As String
    If lBytes < &H400& Then '1024 = 1K
        SizeString = CStr(lBytes) & "b"
    ElseIf lBytes < &H100000 Then '1024 ^ 2 = 1M
        SizeString = CStr(lBytes \ 1024) & "k"
    ElseIf lBytes < &H20000000 Then  '1024 ^ 2 * 512 = up to 0.5G
        SizeString = Replace$(Format$((lBytes \ 1024) / 1024, "0.0"), ".0", vbNullString) & "M"
    Else 'Not bothering to code for Terrabytes...
        'If you're doing that you should probably be using a more robust control!
        SizeString = Replace$(Format$((lBytes \ (1024 ^ 2)) / 1024, "#,##0.0"), ".0", vbNullString) & "G"
    End If
End Function


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
i = 1
x1 = x
y1 = Y
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
If i = 1 Then
x2 = x - x1 + Me.Left
y2 = Y - y1 + Me.Top
Me.Move x2, y2

End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
i = 0

End Sub


Private Sub Label2_Click()
Unload frmMain
End Sub