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

📄 form2.frm

📁 石器客端图形补丁编译环境RH9,GCC
💻 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 + -