📄 form2.frm
字号:
VERSION 5.00
Begin VB.Form Form2
BorderStyle = 1 'Fixed Single
Caption = "石器客户端图像补丁工具"
ClientHeight = 3390
ClientLeft = 45
ClientTop = 450
ClientWidth = 6675
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3390
ScaleWidth = 6675
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 255
Left = 4440
TabIndex = 4
Top = 3000
Width = 855
End
Begin VB.TextBox Text1
Height = 270
Left = 120
TabIndex = 3
Text = "e:\Stoneage80\data"
Top = 3000
Width = 2415
End
Begin VB.CommandButton Command1
Caption = "路径"
Height = 255
Left = 2640
TabIndex = 2
Top = 3000
Width = 735
End
Begin VB.CommandButton Command2
Caption = "更新"
Height = 255
Left = 3480
TabIndex = 1
Top = 3000
Width = 735
End
Begin VB.ListBox List1
Height = 2760
Left = 120
TabIndex = 0
Top = 120
Width = 4215
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim AdrnFilePath As String
Dim RealFilePath As String
Dim SrpAdrnFilePath As String
Dim SrpFilePath As String
Dim SpradrnIndexNum As Long
Dim AdrnLine As Long
Dim MapLine As Long
Dim MapNum As Long
Dim CAdrnNumMax As Long
Dim CMapIndexMax As Long
Dim CSpradrnNumMax As Long
Private Sub Command1_Click()
Dim lpIDList As Long
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Text1.Text = sBuffer
End If
'检查adrn文件路径
AdrnFilePath = Text1.Text & "\adrn_136.bin"
'检查real文件路径
RealFilePath = Text1.Text & "\real_136.bin"
'检查spradrn文件路径
SrpAdrnFilePath = Text1.Text & "\spradrn_115.bin"
'检查spr文件路径
SrpFilePath = Text1.Text & "\spr_115.bin"
End Sub
Private Sub Command2_Click()
Command2.Enabled = False
List1.Clear
ShowInfo "准备更新客户端文件..."
ShowInfo "检查补丁完整性中..."
CheckUpDataCli
ShowInfo "检查客户端版本中..."
CheckCli
Command2.Enabled = True
End Sub
Public Sub ShowInfo(Info As String)
List1.AddItem Info, List1.ListCount
List1.ListIndex = List1.ListCount - 1
DoEvents
End Sub
Public Sub CheckCli()
Dim AdrnFileSize As Long
Dim RealFileSize As Long
Dim SrpAdrnFileSize As Long
Dim SrpFileSize As Long
'检查adrn文件大小
AdrnFileSize = FileLen(AdrnFilePath)
ShowInfo "adrn_136.bin大小为:" & AdrnFileSize
ShowInfo "正确..."
'检查real文件大小
RealFileSize = FileLen(RealFilePath)
ShowInfo "read_136.bin大小为:" & RealFileSize
ShowInfo "正确..."
'检查spradrn文件大小
SrpAdrnFileSize = FileLen(SrpAdrnFilePath)
ShowInfo "spradrn_115.bin大小为:" & SrpAdrnFileSize
ShowInfo "正确..."
'检查spr文件大小
SrpFileSize = FileLen(SrpFilePath)
ShowInfo "spradrn_115.bin大小为:" & SrpFileSize
ShowInfo "正确..."
ShowInfo "客户端版本正确..."
ShowInfo "正在进制客户端图像更新..."
Dim FileNum As Long
Dim CAdrnIndex As adrn
FileNum = FreeFile
Open AdrnFilePath For Binary Access Read As FileNum
ReDim Buffer(1 To 80) As Byte
'读文件
Do While Not EOF(FileNum)
Get FileNum, , Buffer
'获取Adrn数据
CopyMemory CAdrnIndex, Buffer(1), 80
If CAdrnIndex.Num >= AdrnIndex(0).Num And CAdrnIndex.Num <= AdrnIndex(AdrnLine - 1).Num Then
ShowInfo "客户端的图片ID与补丁相冲突..."
Close FileNum
Exit Sub
End If
If CMapIndexMax < CAdrnIndex.MapNum Then CMapIndexMax = CAdrnIndex.MapNum
If CAdrnNumMax < CAdrnIndex.Num Then CAdrnNumMax = CAdrnIndex.Num
Loop
Close FileNum
ShowInfo "图片最大编号:" & CAdrnNumMax
ShowInfo "正确..."
ShowInfo "地图最大编号:" & CMapIndexMax
ShowInfo "正确..."
Dim CSpradrnIndex As Spradrn
FileNum = FreeFile
Open SrpAdrnFilePath For Binary Access Read As FileNum
ReDim Buffer(1 To 12) As Byte
'读文件
Do While Not EOF(FileNum)
Get FileNum, , Buffer
If Not EOF(FileNum) Then
CopyMemory CSpradrnIndex, Buffer(1), 12
If CSpradrnIndex.AnimationNum >= SpradrnIndex(0).AnimationNum And CSpradrnIndex.AnimationNum <= SpradrnIndex(SpradrnIndexNum - 1).AnimationNum Then
ShowInfo "客户端的动画ID与补丁相冲突..."
Close FileNum
Exit Sub
End If
If CSpradrnNumMax < CSpradrnIndex.AnimationNum Then CSpradrnNumMax = CSpradrnIndex.AnimationNum
End If
Loop
Close FileNum
ShowInfo "动画最大编号:" & CSpradrnNumMax
ShowInfo "正确..."
ShowInfo "客户端正在更新..."
UpDataCli
ShowInfo "客户端更新完毕..."
End Sub
Private Sub CheckUpDataCli()
Dim FileName As String
Dim TempStr As String
Dim Buffer() As Byte
Dim NewAddr As Long
Dim TempAdrn As Long
Dim AdrnIndexNum As Long
Dim AdrnNumMax As Long
Dim SpradrnNumMax As Long
Dim MapIndexMax As Long
ReDim AdrnIndex(0) As adrn
ReDim SpradrnIndex(0) As Spradrn
ReDim MapIndex(0) As Long
Dim MapLine As Long
Dim AdrnFileSize As Long
Dim RealFileSize As Long
Dim SrpAdrnFileSize As Long
Dim SrpFileSize As Long
'=======================读Adrn数据头文件=========================================
Dim Load_JzAdrnVer As JzAdrnVer
Dim Addr_JzAdrnVer As Long
AdrnFileSize = FileLen(App.Path & "\data\adrn_1.bin")
ReDim AdrnIndex(AdrnFileSize \ LenB(AdrnIndex(0)) - 1) As adrn
'打开文件
Open App.Path & "\data\adrn_1.bin" For Binary Access Read As #1
Addr_JzAdrnVer = LOF(1) - 159
Get #1, Addr_JzAdrnVer, Load_JzAdrnVer
If Load_JzAdrnVer.ConjectureID1 - Load_JzAdrnVer.AdrnMax = 1 Then
Addr_JzAdrnVer = Addr_JzAdrnVer - 1
AdrnNumMax = Load_JzAdrnVer.AdrnMax
MapIndexMax = Load_JzAdrnVer.MapMax
SpradrnNumMax = Load_JzAdrnVer.SpradrnMax
Else
Addr_JzAdrnVer = 0
End If
Seek 1, 1
AdrnIndexNum = 0
AdrnLine = 0
ReDim Buffer(1 To 80) As Byte
'读文件
Do While Not EOF(1)
If Loc(1) = Addr_JzAdrnVer And Addr_JzAdrnVer > 0 Then Exit Do
Get #1, , Buffer
If Not EOF(1) Then
'取得图片编号
CopyMemory AdrnIndexNum, Buffer(1), 4
'保存Adrn数据结构
CopyMemory AdrnIndex(AdrnLine), Buffer(1), 80
If MapIndexMax < AdrnIndex(AdrnLine).MapNum Then
MapIndexMax = AdrnIndex(AdrnLine).MapNum
MapLine = MapLine + 1
End If
If AdrnIndex(AdrnLine).MapNum > UBound(MapIndex) Then ReDim Preserve MapIndex(AdrnIndex(AdrnLine).MapNum) As Long
MapIndex(AdrnIndex(AdrnLine).MapNum) = AdrnIndexNum
If AdrnNumMax < AdrnIndexNum Then AdrnNumMax = AdrnIndexNum
AdrnLine = AdrnLine + 1
End If
Loop
Close #1
ShowInfo "补丁图片共" & AdrnLine & "张"
ShowInfo "补丁地图共" & MapLine & "个"
'===============================================================================
'读Spradrn数据头文件
Open App.Path & "\data\spradrn_1.bin" For Binary Access Read As #2
SpradrnIndexNum = 0
ReDim Buffer(1 To 12) As Byte
'读文件
DoEvents
Do While Not EOF(2)
Get #2, , Buffer
If Not EOF(2) Then
'申请内存
ReDim Preserve SpradrnIndex(SpradrnIndexNum) As Spradrn
CopyMemory SpradrnIndex(SpradrnIndexNum), Buffer(1), 12
If SpradrnNumMax < SpradrnIndex(SpradrnIndexNum).AnimationNum Then SpradrnNumMax = SpradrnIndex(SpradrnIndexNum).AnimationNum
SpradrnIndexNum = SpradrnIndexNum + 1
DoEvents
End If
Loop
Close #2
ShowInfo "补丁动画共" & SpradrnIndexNum & "个"
End Sub
Private Sub SaveData(Index As Long)
Dim AdrnFileNum, RealFileNum As Integer '定义文件号
Dim AdrnData As adrn '定义一个Adrn数据块
'抽取出Adrn数据
AdrnFileNum = FreeFile '申请Adrn文件号
Open Text1.Text & "\adrn_136.bin" For Binary As AdrnFileNum
RealFileNum = FreeFile '申请Real文件号
Open Text1.Text & "\real_136.bin" For Binary As RealFileNum
AdrnData = AdrnIndex(Index)
AdrnData.Addr = LOF(RealFileNum)
If LOF(AdrnFileNum) = 0 Then
Put AdrnFileNum, , AdrnData
Else
Put AdrnFileNum, LOF(AdrnFileNum) + 1, AdrnData
End If
Close AdrnFileNum
'抽取出Real数据
Dim FileName As String
Dim TempStr As String
Dim MyReal As Real
Dim buff() As Byte
FileName = FreeFile
Open App.Path & "\data\real_1.bin" For Binary Access Read As FileName
ReDim buff(1 To AdrnIndex(Index).datalen) As Byte
Get FileName, AdrnIndex(Index).Addr + 1, buff
CopyMemory MyReal, buff(1), 16
Close FileName
If LOF(RealFileNum) = 0 Then
Put RealFileNum, , buff
ElseIf LOF(RealFileNum) > 1525851188 Then
Put RealFileNum, LOF(RealFileNum) + 1, buff
Else
Put RealFileNum, LOF(RealFileNum) + 1, buff
End If
Close RealFileNum
End Sub
Private Sub SaveSprData(Index As Long)
Dim SprFileNum, SprAdrnFileNum As Integer '定义文件号
Dim SprAdrnData As Spradrn '定义一个Spr数据块
SprAdrnData = SpradrnIndex(Index)
'抽取出Spr数据
SprFileNum = FreeFile '申请Spr文件号
Open Text1.Text & "\spr_115.bin" For Binary As SprFileNum
'抽取出SprAdrn数据
SprAdrnFileNum = FreeFile '申请SprAdrn文件号
Open Text1.Text & "\spradrn_115.bin" For Binary As SprAdrnFileNum
SprAdrnData.Addr = LOF(SprFileNum)
If LOF(SprAdrnFileNum) = 0 Then
Put SprAdrnFileNum, , SprAdrnData
Else
Put SprAdrnFileNum, LOF(SprAdrnFileNum) + 1, SprAdrnData
End If
Close SprAdrnFileNum
'抽取出Spr数据
Dim FileName As String
Dim TempStr As String
Dim Current_ActionNum As Long
Current_ActionNum = 0
Dim MySpr As Spr
Dim Addr As Long
Addr = SpradrnIndex(Index).Addr + 1
FileName = FreeFile
'打开文件
Open App.Path & "\data\spr_1.bin" For Binary Access Read As FileName
Dim i As Long
Dim j As Long
Dim ActionNum As Long
Dim PictureNo() As Long
Dim PictureNum As Long
ReDim Preserve PictureNo(0 To PictureNum)
For ActionNum = 0 To SprAdrnData.ActionNum - 1
'读指定动作
For i = 0 To SpradrnIndex(Index).ActionNum - 1
Get FileName, Addr, MySpr
Addr = Addr + Len(MySpr) + (MySpr.Number * 10)
If Current_ActionNum = i Then Exit For
Next
If LOF(SprFileNum) = 0 Then
Put SprFileNum, , MySpr
Else
Put SprFileNum, LOF(SprFileNum) + 1, MySpr
End If
If MySpr.Number > 0 Then
ReDim buff(1 To 10) As Byte
ReDim MySequence(1 To MySpr.Number) As Sequence
For i = 1 To MySpr.Number
Get FileName, , buff
CopyMemory MySequence(i), buff(1), 10
If LOF(SprFileNum) = 0 Then
Put SprFileNum, , MySequence(i)
Else
Put SprFileNum, LOF(SprFileNum) + 1, MySequence(i)
End If
Next i
End If
Next
Close FileName
Close SprFileNum
End Sub
Private Sub UpDataCli()
Dim AdrnNum As Long
Dim SprAdrnNum As Long
ShowInfo "更新动画文件..."
For SprAdrnNum = 0 To SpradrnIndexNum - 1
SaveSprData SprAdrnNum
Next SprAdrnNum
ShowInfo "完成..."
ShowInfo "更新图像文件..."
For AdrnNum = 0 To AdrnLine - 1
SaveData AdrnNum
Next AdrnNum
ShowInfo "完成..."
End Sub
Private Sub Form_Load()
'检查adrn文件路径
AdrnFilePath = Text1.Text & "\adrn_136.bin"
'检查real文件路径
RealFilePath = Text1.Text & "\real_136.bin"
'检查spradrn文件路径
SrpAdrnFilePath = Text1.Text & "\spradrn_115.bin"
'检查spr文件路径
SrpFilePath = Text1.Text & "\spr_115.bin"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -