📄 frmupdate.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 + -