[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] [2] [3]  下一页

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18