[原创][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