form3.frm

石器时代的客户端用 补丁更新程序 源码VB下开发

VERSION 5.00
Begin VB.Form Form3 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "石器图像补丁工具 v1.2"
   ClientHeight    =   3390
   ClientLeft      =   45
   ClientTop       =   450
   ClientWidth     =   5580
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3390
   ScaleWidth      =   5580
   StartUpPosition =   2  '屏幕中心
   Begin VB.OptionButton Option2 
      Caption         =   "新服补丁"
      Height          =   255
      Left            =   4320
      TabIndex        =   5
      Top             =   3120
      Value           =   -1  'True
      Width           =   1095
   End
   Begin VB.OptionButton Option1 
      Caption         =   "升级补丁"
      Height          =   255
      Left            =   4320
      TabIndex        =   4
      Top             =   2880
      Width           =   1095
   End
   Begin VB.ListBox List1 
      Height          =   2580
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   5295
   End
   Begin VB.CommandButton Command2 
      Caption         =   "更新"
      Height          =   255
      Left            =   3480
      TabIndex        =   2
      Top             =   3000
      Width           =   735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "路径"
      Height          =   255
      Left            =   2640
      TabIndex        =   1
      Top             =   3000
      Width           =   735
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   120
      TabIndex        =   0
      Text            =   "F:\Waei\stoneage8.0\data"
      Top             =   3000
      Width           =   2415
   End
End
Attribute VB_Name = "Form3"
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 CAdrnLine As Long
Dim CMapLine As Long

Dim MapNum As Long

Dim CAdrnNumMax As Long
Dim CMapIndexMax As Long
Dim CSpradrnNumMax As Long

Dim ERR As Boolean
Dim RENEWREAL As Boolean
Dim RENEWSPR As Boolean


Dim CadrnNum As Long
Dim CrealNum As Long

Const AdrnSize As Long = 31755040
Const RealSize As Long = 1525851188
Const SprAdrnSize As Long = 20316
Const SprSize As Long = 8427600

'Const AdrnSize As Long = 33297600
'Const RealSize As Long = 1607321502
'Const SprAdrnSize As Long = 20868
'Const SprSize As Long = 8721504

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
    
    SetPath
End Sub

Private Sub Command2_Click()
    ERR = False
    If Option2.Value = True Then
        RENEWREAL = True
        RENEWSPR = True
    Else
        RENEWREAL = False
        RENEWSPR = False
    End If
    
    Command2.Enabled = False
    List1.Clear
    ShowInfo "准备更新客户端文件..."
    ShowInfo "检查补丁完整性中..."
    CheckUpDataCli
    If ERR = True Then GoTo uderr
    ShowInfo "检查客户端版本中..."
    If ERR = True Then GoTo uderr
    CheckCli
    If ERR = True Then GoTo uderr
    ShowInfo "客户端正在更新..."
    UpDataCli
    If ERR = True Then GoTo uderr
    ShowInfo "客户端更新完毕..."
    Command2.Enabled = True
    Exit Sub
uderr:
    ShowInfo "更新失败..."
    Command2.Enabled = True
End Sub

Public Sub ShowInfo(Info As String)
    List1.AddItem Info, List1.ListCount
    List1.ListIndex = List1.ListCount - 1
    DoEvents
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 FileNum As Long
    
    AdrnFileSize = FileLen(App.Path & "\data\adrn.bin")
    
    ReDim AdrnIndex(AdrnFileSize \ LenB(AdrnIndex(0))) As adrn
    
    FileNum = FreeFile
    '打开文件
    Open App.Path & "\data\adrn.bin" For Binary Access Read As FileNum

    AdrnIndexNum = 0
    AdrnLine = 0
    ReDim Buffer(1 To 80) As Byte
    '读文件
    Do While Not EOF(1)
        Get FileNum, , Buffer
        If Not EOF(1) Then
            '取得图片编号
            CopyMemory AdrnIndexNum, Buffer(1), 4

            '保存Adrn数据结构
            CopyMemory AdrnIndex(AdrnLine), Buffer(1), 80
            
            If AdrnIndex(AdrnLine).Num < 0 Then
                AdrnIndex(AdrnLine).Num = AdrnIndex(AdrnLine).Num Xor &HFFFFFFFF
                AdrnIndex(AdrnLine).Addr = AdrnIndex(AdrnLine).Addr Xor &HFFFFFFFF
                AdrnIndex(AdrnLine).datalen = AdrnIndex(AdrnLine).datalen Xor &HFFFFFFFF
                AdrnIndex(AdrnLine).X = AdrnIndex(AdrnLine).X Xor &HFFFFFFFF
                AdrnIndex(AdrnLine).Y = AdrnIndex(AdrnLine).Y Xor &HFFFFFFFF
                AdrnIndex(AdrnLine).width = AdrnIndex(AdrnLine).width Xor &HFFFFFFFF
                AdrnIndex(AdrnLine).height = AdrnIndex(AdrnLine).height Xor &HFFFFFFFF
                AdrnIndex(AdrnLine).EastCover = AdrnIndex(AdrnLine).EastCover Xor &HFF
                AdrnIndex(AdrnLine).SouthCover = AdrnIndex(AdrnLine).SouthCover Xor &HFF
                If AdrnLine > 7 Then
                    AdrnIndex(AdrnLine).Addr = AdrnIndex(AdrnLine).Addr + 9
                    AdrnIndex(AdrnLine).datalen = AdrnIndex(AdrnLine).datalen - 9
                End If
                If AdrnLine < 6 And AdrnIndex(AdrnLine).width > 800 Or AdrnIndex(AdrnLine).height > 640 Then
                    ERR = True
                    ShowInfo "缺少登陆界面..."
                    Close FileNum
                    Exit Sub
                End If
            Else
                ERR = True
                ShowInfo "补丁数据有问题..."
                Close FileNum
                Exit Sub
            End If
            
            If AdrnIndex(AdrnLine).Num <> AdrnLine + 1 Then
                Close FileNum
                ERR = True
                ShowInfo "补丁数据有问题..."
                Exit Sub
            End If
                
            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
'                AdrnIndex(AdrnLine).MapNum = AdrnIndex(AdrnLine).MapNum + CMapIndexMax
'                ShowInfo "补丁地图号" & AdrnIndex(AdrnLine).MapNum
'            End If
            
            AdrnIndex(AdrnLine).MapNum = 0
            
            MapIndex(AdrnIndex(AdrnLine).MapNum) = AdrnIndexNum
        
            If AdrnNumMax < AdrnIndexNum Then AdrnNumMax = AdrnIndexNum

            AdrnLine = AdrnLine + 1
        End If
    Loop
    Close FileNum
    
    ShowInfo "补丁图片共" & AdrnLine & "张"
    ShowInfo "补丁地图共" & MapLine & "个"
    '===============================================================================
    
    '读Spradrn数据头文件
    
    Open App.Path & "\data\spradrn.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
            
            If SpradrnIndex(SpradrnIndexNum).AnimationNum <= 102002 Then
                ShowInfo "补丁图号小于102002，该补丁无效！"
                ERR = True
                Exit Sub
            End If
            
            ShowInfo "补丁图号:" & SpradrnIndex(SpradrnIndexNum).AnimationNum
            SpradrnIndexNum = SpradrnIndexNum + 1
        End If
    Loop
    Close #2

    ShowInfo "补丁动画共" & SpradrnIndexNum & "个"

End Sub

Private Sub SaveData(Index As Long, AdrnMax As Long, MapMax As Long)
    Dim AdrnFileNum, RealFileNum As Integer                   '定义文件号


    RealFileNum = FreeFile                                    '申请Real文件号
    Open Text1.Text & "\real_136.bin" For Binary As RealFileNum
    
'    If AdrnIndex(Index).MapNum > 0 Then
'        MapNum = MapNum + 1
'        AdrnIndex(Index).MapNum = MapNum + MapMax + 1
'    End If

    '抽取出Real数据
    Dim FileName As String
    Dim TempStr As String
    Dim MyReal As Real
    Dim buff() As Byte

    FileName = FreeFile
    Open App.Path & "\data\real.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
    
'    If MyReal.Compress >= 254 Then
        MyReal.Compress = MyReal.Compress Xor &HFF
        MyReal.RealNotKnow = MyReal.RealNotKnow Xor &HFF
        MyReal.width = MyReal.width Xor &HFFFFFFFF
        MyReal.height = MyReal.height Xor &HFFFFFFFF
        MyReal.datalen = MyReal.datalen Xor &HFFFFFFFF
        
        CopyMemory buff(1), MyReal, 16
'    End If
    
    Close FileName
    
    If RENEWREAL = True And LOF(RealFileNum) > RealSize Then

'        CAdrnIndex(376282).Addr = RealSize
        CAdrnIndex(347526).datalen = MyReal.datalen
        Put RealFileNum, CAdrnIndex(347526).Addr + 1, buff
        RENEWREAL = False