[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)

'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)

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 = ""

Select Case Renwu

Case 0

For i = 0 To 4

CheckWg(i).Enabled = False

CheckWg(29).Enabled = False

Case 1

For i = 0 To 4

CheckWg(i + 20).Enabled = False

Case 2

For i = 0 To 4

CheckWg(i + 10).Enabled = False

Case 3

For i = 0 To 4

CheckWg(i + 15).Enabled = False

Case 4

For i = 0 To 4

CheckWg(i + 5).Enabled = False

End Select

Wug = PRwStart(Renwu) + 668

Open LoadFN For Binary As #1

'水

Seek #1, Wug

For i = 0 To 4

Get #1, , Wug1