[原创][vb6]仙剑3外传的存档修改器

[原创文章，转载请说明出处]
Module1:

Option Explicit

Public LoadFN As String     '要修改的存档文件
Public LoadFP As String     '存档文件的路径

Public Const PPlace = 86
Public Const PMoney = 153

Sub main()
LoadFP = "F:/PAL3A/save/"
FormLoad.Show
End Sub

FormLoad:
Option Explicit
Dim i As Integer

Private Sub GetInfo(Lfile As String)
Dim BMoney(3) As Byte   '记录钱
Dim BPlace(20) As Byte    '记录地点

Dim Money As Long
Dim HexMoney As String

Dim Place As String
Open Lfile For Binary As #1
    Seek #1, PPlace
    Get #1, , BPlace
    Seek #1, PMoney
    Get #1, , BMoney
Close #1

HexMoney = "00"
For i = 3 To 0 Step -1
    HexMoney = HexMoney & Right("00" & Hex(BMoney(i)), 2)
Next

'For i = 0 To 19 Step 2
'    If "&h" & Right("00" & Hex(BPlace(i)), 2) & Right("00" & Hex(BPlace(i + 1)), 2) <> "&h0000" Then
'        Place = Place & Chr("&h" & Right("00" & Hex(BPlace(i)), 2) & Right("00" & Hex(BPlace(i + 1)), 2))
'    Else
'        Place = Place
'    End If
'Next
'将mem数组转换为Big5码所对应的Unicode码,＆H404即Big5码
Place = StrConv(BPlace, vbUnicode, &H404)
'将Unicode码转换为GBK编码,＆H804即GBK码
'Place = StrConv(BPlace, vbFromUnicode, &H804)

LabelMoney.Caption = CLng("&h" & HexMoney)
LabelPlace.Caption = Place
End Sub

Private Sub CmdExit_Click()
End
End Sub

Private Sub CmdOk_Click()
If File1.ListIndex < 0 Then
    MsgBox "没有选择要修改的文件"
    Exit Sub
End If
LoadFN = LoadFP & File1
Load FormMain
FormMain.Show 1
'Me.Hide
End Sub

Private Sub File1_Click()
Dim MidName As String
MidName = Mid(File1.FileName, 6, 2)
On Error GoTo LoadImgErr
Image1.Picture = LoadPicture(LoadFP & "PAL3_00" & MidName & ".jpg")
GetInfo (LoadFP & File1)

Exit Sub

LoadImgErr:
    If Err.Number = 53 Then
        Image1.Picture = Nothing
        Resume Next
    End If
End Sub

Private Sub Form_Load()
File1.Path = LoadFP
If File1.ListCount = 0 Then CmdOk.Enabled = False
End Sub

FormMain

Option Explicit
Dim i As Integer, j As Integer
Dim PRwStart(4) As Long
Dim ReadPlace As Long   '读取文件的位置

Function HexToLng(HexStr() As Byte) As Long
Dim Hexs As String
Dim UbHexStr

UbHexStr = UBound(HexStr)
Hexs = "00"
For i = UbHexStr To 0 Step -1
    Hexs = Hexs & Right("00" & Hex(HexStr(i)), 2)
Next
HexToLng = CLng("&h" & Hexs)
End Function

Private Sub drawFrameInfo0()    '
Dim BStr(3) As Byte
Dim HexStr As String

Open LoadFN For Binary As #1
For j = 0 To 4      '循环读取人物属性
'等级
    Seek #1, PRwStart(j)
    Get #1, , BStr

'    HexStr = "00"
'    For i = 3 To 0 Step -1
'        HexStr = HexStr & Right("00" & Hex(BStr(i)), 2)
'    Next
'    LabelDengji(j).Caption = CLng("&h" & HexStr)
    LabelDengji(j).Caption = HexToLng(BStr)
'精max
    Get #1, , BStr
    TextJingMax(j) = HexToLng(BStr)
'气max
    Get #1, , BStr
    TextQiMax(j) = HexToLng(BStr)
'神max
    Get #1, , BStr
    TextShenMax(j) = HexToLng(BStr)
'武
    Get #1, , BStr
    TextWu(j) = HexToLng(BStr)
'防
    Get #1, , BStr
    TextFang(j) = HexToLng(BStr)
'速
    Get #1, , BStr
    TextSu(j) = HexToLng(BStr)
'运
    Get #1, , BStr
    TextYun(j) = HexToLng(BStr)
'水
    Get #1, , BStr
    TextShui(j) = HexToLng(BStr)
'火
    Get #1, , BStr
    TextHuo(j) = HexToLng(BStr)
'雷
    Get #1, , BStr
    TextLei(j) = HexToLng(BStr)
'风
    Get #1, , BStr
    TextFeng(j) = HexToLng(BStr)
'土
    Get #1, , BStr
    TextTu(j) = HexToLng(BStr)
'经验
    ReadPlace = Seek(1) + 56
    Seek #1, ReadPlace
    Get #1, , BStr
    TextJingY(j) = HexToLng(BStr)
'精
    ReadPlace = Seek(1) + 228
    Seek #1, ReadPlace
    Get #1, , BStr
    TextJing(j) = HexToLng(BStr)
'气
    Get #1, , BStr
    TextQi(j) = HexToLng(BStr)
'神
    Get #1, , BStr
    HexStr = "00"
    TextShen(j) = HexToLng(BStr)
Next j
Close #1
End Sub

Private Sub saveFrameInfo0()
Dim BStr(3) As Byte
Dim PutL As Long
Dim HexStr
Open LoadFN For Binary As #1
For j = 0 To 4      '循环读取人物属性
'等级

'精max
    PutL = CLng(TextJingMax(j))
    Seek #1, PRwStart(j) + 4
    Put #1, , PutL
'气max
    PutL = CLng(TextQiMax(j))
    Put #1, , PutL
'神max
    PutL = CLng(TextShenMax(j))
    Put #1, , PutL
'武
    PutL = CLng(TextWu(j))
    Put #1, , PutL
'防
    PutL = CLng(TextFang(j))
    Put #1, , PutL
'速
    PutL = CLng(TextSu(j))
    Put #1, , PutL
'运
    PutL = CLng(TextYun(j))
    Put #1, , PutL
'水
    PutL = CLng(TextShui(j))
    Put #1, , PutL
'火
    PutL = CLng(TextHuo(j))
    Put #1, , PutL
'雷
    PutL = CLng(TextLei(j))
    Put #1, , PutL
'风
    PutL = CLng(TextFeng(j))
    Put #1, , PutL
'土
    PutL = CLng(TextTu(j))
    Put #1, , PutL
'经验
    PutL = CLng(TextJingY(j))
    ReadPlace = Seek(1)
    Seek #1, ReadPlace + 56
    Put #1, , PutL
'精
    PutL = CLng(TextJing(j))
    ReadPlace = Seek(1)
    Seek #1, ReadPlace + 228
    Put #1, , PutL
'气
    PutL = CLng(TextQi(j))
    Put #1, , PutL
'神
    PutL = CLng(TextShen(j))
    Put #1, , PutL
Next j
Close #1
End Sub

Private Sub ShowFrame1(Renwu As Integer)    '显示武功
Dim i As Integer
Dim Wug As Long
Dim Wug1 As Byte
Dim Wug2(1) As Byte

For i = 0 To 29
    CheckWg(i).Enabled = True
    TextWg(i).Text = ""
Next

Select Case Renwu
    Case 0
        For i = 0 To 4
            CheckWg(i).Enabled = False
        Next
        CheckWg(29).Enabled = False
    Case 1
        For i = 0 To 4
            CheckWg(i + 20).Enabled = False
        Next
    Case 2
        For i = 0 To 4
            CheckWg(i + 10).Enabled = False
        Next
    Case 3
        For i = 0 To 4
            CheckWg(i + 15).Enabled = False
        Next
    Case 4
        For i = 0 To 4
            CheckWg(i + 5).Enabled = False
        Next
End Select
Wug = PRwStart(Renwu) + 668
Open LoadFN For Binary As #1
'水
    Seek #1, Wug
    For i = 0 To 4
        Get #1, , Wug1
        If Hex(Wug1) = 0 Then CheckWg(i).Value = Unchecked Else CheckWg(i).Value = Checked
    Next
'火
Wug = Wug + 9
    Seek #1, Wug
    For i = 5 To 9
        Get #1, , Wug1
        If Hex(Wug1) = 0 Then CheckWg(i).Value = Unchecked Else CheckWg(i).Value = Checked
    Next
'雷
Wug = Wug + 9
    Seek #1, Wug
    For i = 10 To 14
        Get #1, , Wug1
        If Hex(Wug1) = 0 Then CheckWg(i).Value = Unchecked Else CheckWg(i).Value = Checked
    Next
'风
Wug = Wug + 9
    Seek #1, Wug
    For i = 15 To 19
        Get #1, , Wug1
        If Hex(Wug1) = 0 Then CheckWg(i).Value = Unchecked Else CheckWg(i).Value = Checked
    Next
'土
Wug = Wug + 9
    Seek #1, Wug
    For i = 20 To 24
        Get #1, , Wug1
        If Hex(Wug1) = 0 Then CheckWg(i).Value = Unchecked Else CheckWg(i).Value = Checked
    Next
'高级武功
Wug = Wug + 9
    Seek #1, Wug
    For i = 25 To 29
        Get #1, , Wug1
        If Hex(Wug1) = 0 Then CheckWg(i).Value = Unchecked Else CheckWg(i).Value = Checked
    Next

'=====使用次数=====
Wug = PRwStart(Renwu) + 722
'水
    Seek #1, Wug
    For i = 0 To 4
        Get #1, , Wug2
        TextWg(i).Text = HexToLng(Wug2)
    Next
'火
Wug = Wug + 18
    Seek #1, Wug
    For i = 5 To 9
        Get #1, , Wug2
        TextWg(i).Text = HexToLng(Wug2)
    Next
'雷
Wug = Wug + 18
    Seek #1, Wug
    For i = 10 To 14
        Get #1, , Wug2
        TextWg(i).Text = HexToLng(Wug2)
    Next
'风
Wug = Wug + 18
    Seek #1, Wug
    For i = 15 To 19
        Get #1, , Wug2
        TextWg(i).Text = HexToLng(Wug2)
    Next
'土
Wug = Wug + 18
    Seek #1, Wug
    For i = 20 To 24
        Get #1, , Wug2
        TextWg(i).Text = HexToLng(Wug2)
    Next
'高级武功
Wug = Wug + 18
    Seek #1, Wug
    For i = 25 To 29
        Get #1, , Wug2
        TextWg(i).Text = HexToLng(Wug2)
    Next
Close #1
End Sub

Private Sub CheckWg_Click(Index As Integer)
If CheckWg(Index).Value = vbChecked Then
    TextWg(Index).Enabled = True
Else
    TextWg(Index).Enabled = False
End If

End Sub

Private Sub Cmd1_Click(Index As Integer)
Dim Wug As Long
Dim Wug1 As Long

Dim WugT As Byte
Dim WugF As Byte
Dim WugCount As Integer

WugT = 1: WugF = 0

Select Case Index
    Case 0
        Select Case LabelName.Caption
            Case "南宫煌"
                Wug = PRwStart(0) + 668
                Wug1 = PRwStart(0) + 722
            Case "温慧"
                Wug = PRwStart(1) + 668
                Wug1 = PRwStart(1) + 722
            Case "王蓬絮"
                Wug = PRwStart(2) + 668
                Wug1 = PRwStart(2) + 722
            Case "星璇"
                Wug = PRwStart(3) + 668
                Wug1 = PRwStart(3) + 722
            Case "雷元戈"
                Wug = PRwStart(4) + 668
                Wug1 = PRwStart(4) + 722
        End Select
        Open LoadFN For Binary As #1
'是否能用
'循环读取每个技能
            Seek #1, Wug
            For i = 0 To 29
                If (i Mod 5 = 0) And (i <> 0) Then  '如果是5的倍数那么就将位置偏移
                    Wug = Wug + 9
                    Seek #1, Wug
                End If
                If CheckWg(i).Value = Checked Then
                    Put #1, , WugT
                Else
                    Put #1, , WugF
                End If
            Next

'使用次数
'循环读取每个技能
            Seek #1, Wug1
            For i = 0 To 29
                If (i Mod 5 = 0) And (i <> 0) Then  '如果是5的倍数那么就将位置偏移
                    Wug1 = Wug1 + 18
                    Seek #1, Wug1
                End If
                If CheckWg(i).Value = Checked Then
                    WugCount = CLng(TextWg(i).Text)
                    Put #1, , WugCount
                Else
                    WugCount = 0
                    Put #1, , WugCount
                End If
            Next
        Close #1

    Case 1
        For i = 0 To 29
            CheckWg(i).Value = Checked
            TextWg(i).Text = 50
        Next
        Select Case LabelName.Caption
            Case "南宫煌"
                For i = 0 To 4
                    CheckWg(i).Value = Unchecked
                    TextWg(i).Text = 0
                Next
                    CheckWg(29).Value = Unchecked
                    TextWg(29).Text = 0
            Case "温慧"
                For i = 0 To 4
                    CheckWg(i + 20).Value = Unchecked
                    TextWg(i + 20).Text = 0
                Next
            Case "王蓬絮"
                For i = 0 To 4
                    CheckWg(i + 10).Value = Unchecked
                    TextWg(i + 10).Text = 0
                Next
            Case "星璇"
                For i = 0 To 4
                    CheckWg(i + 15).Value = Unchecked
                    TextWg(i + 15).Text = 0
                Next
            Case "雷元戈"
                For i = 0 To 4
                    CheckWg(i + 5).Value = Unchecked
                    TextWg(i + 5).Text = 0
                Next
        End Select
End Select
End Sub

Private Sub Form_Load()
FrameInfo(0).Visible = True
'=====以下是各个人物的属性坐标=====
PRwStart(0) = 1397: PRwStart(1) = 2921: PRwStart(2) = 4445: PRwStart(3) = 5969: PRwStart(4) = 7493
Call drawFrameInfo0
End Sub

Private Sub Image1_Click(Index As Integer)

Select Case Index
    Case 0
        LabelName.Caption = "南宫煌"
        LabelShux.Caption = "火"
    Case 1
        LabelName.Caption = "温慧"
        LabelShux.Caption = "水"
    Case 2
        LabelName.Caption = "王蓬絮"
        LabelShux.Caption = "风"
    Case 3
        LabelName.Caption = "星璇"
        LabelShux.Caption = "土"
    Case 4
        LabelName.Caption = "雷元戈"
        LabelShux.Caption = "雷"
End Select
ShowFrame1 (Index)
End Sub

Private Sub LabelControl_Click(Index As Integer)
Dim HideFrame As Integer
HideFrame = CInt(LabelFrame.Caption)
LabelFrame.Caption = Index
FrameInfo(Index).Visible = True
FrameInfo(HideFrame).Visible = False
End Sub

Private Sub LabelOk_Click()
Select Case LabelFrame.Caption
    Case "0"    '人物
        Call saveFrameInfo0
        MsgBox "ok"
    Case "1"    '武功
   
    Case "2"    '装备
   
    Case "3"    '物品
   
    Case "4"    '剧情
       
    Case "5"    '关于

End Select
End Sub