⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmupdate.frm

📁 其中:ClientInfor.inf 文件: 第一行的数据表示: 客户端游戏版本号 第一行的数据表示: 更新文件存放的网络路径 UpdateInfor.inf文件: 第一行的数据表示:
💻 FRM
字号:
VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmUpdate 
   Caption         =   "第二天堂在线更新"
   ClientHeight    =   2415
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6195
   LinkTopic       =   "Form1"
   ScaleHeight     =   2415
   ScaleWidth      =   6195
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdExit 
      Caption         =   "退 出(&E)"
      Height          =   375
      Left            =   4920
      TabIndex        =   3
      Top             =   1440
      Width           =   975
   End
   Begin VB.CommandButton cmdUpdate 
      Caption         =   "更 新(&U)"
      Height          =   375
      Left            =   3720
      TabIndex        =   2
      Top             =   1440
      Width           =   975
   End
   Begin MSComctlLib.ProgressBar proUpdate 
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   840
      Width           =   5535
      _ExtentX        =   9763
      _ExtentY        =   661
      _Version        =   393216
      Appearance      =   1
   End
   Begin InetCtlsObjects.Inet inetOLUpdate 
      Left            =   360
      Top             =   1440
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
   Begin VB.Label lblScale 
      Caption         =   "更新比例"
      Height          =   255
      Left            =   2400
      TabIndex        =   4
      Top             =   1320
      Width           =   735
   End
   Begin VB.Label lblNumber 
      Caption         =   "更新文件(1/10)"
      Height          =   255
      Left            =   360
      TabIndex        =   1
      Top             =   480
      Width           =   1695
   End
End
Attribute VB_Name = "frmUpdate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmdExit_Click()
    Unload Me
    
End Sub


Private Sub cmdUpdate_Click()
    Dim strClientInfor() As String
    Dim strUpdateInfor() As String
    Dim nNum As Integer  ' 存储更新到第几个文件

' 出错则跳出更新,并提示给用户
On Error GoTo ErrMsg

    strClientInfor() = getClientInfor
    strUpdateInfor() = getUpdateInfor(strClientInfor(1))
    
    inetOLUpdate.RequestTimeout = 0     ' 以验证客户可以连接到服务器,后面更新将不在设置请求超时
    nNum = 0
    
    Dim verClient As Double
    Dim verUpdate As Double
    Dim strName   As Variant
    Dim bArray()  As Byte
    Dim nI        As Integer
    Dim strFlag   As String     ' 保存后缀名

    verClient = strClientInfor(0)   ' 获得客户端游戏版本号
    verUpdate = strUpdateInfor(0)   ' 获得最新游戏版本号
    
    If verClient < verUpdate Then   ' 判断客户端游戏版本是否是最新版
    
        If MsgBox("已出最新版,是否更新游戏", vbInformation + vbYesNo, "在线更新") = vbYes Then
            
            ' 设置进度条
            proUpdate.Max = CInt(strUpdateInfor(1))
            proUpdate.Min = 0
            
            ' 更新游戏
            For nI = 2 To CInt(strUpdateInfor(1)) + 1
            
                ' 显示正在更新第几个文件,以及更新文件总数
                lblNumber.Caption = "文件更新(" & (nI - 1) & "/" & CInt(strUpdateInfor(1)) & ")"
                
                ' 读取服务器更新文件,并保存到客户端
                bArray() = inetOLUpdate.OpenURL(strClientInfor(1) + "/" + strUpdateInfor(nI), icByteArray)
                Open App.Path + "\" + strUpdateInfor(nI) For Binary Access Write As #1
                Put #1, , bArray()
                Close #1
                
                nNum = nI - 1   ' 存储更新到第几个文件
                
                proUpdate.Value = nNum  ' 更新进度条
    
                lblScale.Caption = (proUpdate.Value / proUpdate.Max) * 100 & "%"        ' 显示更新比例
                
            Next nI
            
            ' 减压.zip文件
            For nI = 2 To CInt(strUpdateInfor(1)) + 1
                strFlag = Mid(strUpdateInfor(nI), InStr(strUpdateInfor(nI), ".") + 1) ' 获得后缀名
                
                If strFlag = "zip" Then     ' 判断该文件是否为.zip压缩文件
                    UnZipTo App.Path, App.Path + "\" + strUpdateInfor(nI)   ' 解压缩
                    Kill App.Path + "\" + strUpdateInfor(nI)    ' 删除压缩文件
                End If
            
            Next nI
            
            ' 更新客户端信息文件 UpdateInfor.inf
            updateClientInfor strUpdateInfor(0), strClientInfor(1)
            
            MsgBox "游戏更新完毕,谢谢你的支持!", vbInformation + vbOKOnly, "在线更新"
            
            Unload Me   ' 结束在线更新
            
        End If
        
    Else
        MsgBox "已是最新版,不需要更新!", vbInformation + vbOKOnly
        Unload Me   ' 结束在线更新
        
    End If
    
    Exit Sub
    
ErrMsg:
    MsgBox "游戏更新出错,请重新启动游戏更新", vbCritical + vbOKOnly, "在线更新"
    
End Sub


Private Sub Form_Load()

    inetOLUpdate.RequestTimeout = 15     ' 请求连接超过15秒,则退出连接

End Sub



' 获得客户端游戏版本号和服务器路径信息
Public Function getClientInfor() As Variant
    Dim strInfor(10)  As String
    Dim strTest       As String
    Dim nI            As Integer
    
    nI = 0
    Open App.Path + "/ClientInfor.inf" For Input As #1   ' 打开ClientInfor.inf
    
    Do While Not EOF(1)  ' 获得客户端的 游戏版本 和 服务器路径  信息
        Line Input #1, strInfor(nI)
        nI = nI + 1
    Loop
    
    Close #1
    
    getClientInfor = strInfor()
    
End Function


' 获得更新文件信息
' strPath 为更新文件在网上的地址
Public Function getUpdateInfor(strPath As String) As Variant
    Dim strInfor(20)  As String
    Dim nI            As Integer
    Dim bArray()      As Byte
    
    ' 读取服务器更新文件的信息,并保存到客户端
    bArray() = inetOLUpdate.OpenURL(strPath + "/UpdateInfor.inf", icByteArray)
    'Kill "UpdateInfor.inf"      ' 删除原有更新文件
    Open App.Path + "/UpdateInfor.inf" For Binary Access Write As #1
    Put #1, , bArray()
    Close #1
    
    nI = 0
    Open App.Path + "/UpdateInfor.inf" For Input As #1   ' 打开ServerInfor.inf
    
    Do While Not EOF(1)   ' 获得最新的 游戏版本 和 更新文件的路径
        Line Input #1, strInfor(nI)
        nI = nI + 1
    Loop
    
    Close #1
    
    getUpdateInfor = strInfor()
    
End Function


' 更新客户端信息文件 UpdateInfor.inf
Public Function updateClientInfor(strVersion As String, strWebPath As String) As Boolean
    Open App.Path + "/ClientInfor.inf" For Output As #1
    
    Print #1, strVersion
    Print #1, strWebPath
    
    Close #1
    
End Function


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -