frmmain.frm

风色幻想5修改器源码 用VB6 SP6打可打开哦

    .AddItem "抢救贫穷"
    .AddItem "百万富翁"
    .AddItem "百战的勇者"
    .AddItem "永远的新手"
    .AddItem "热爱风色幻想"
    .AddItem "杀人机器"
    .AddItem "破坏狂"
    .AddItem "常胜将军"
    .AddItem "武之皇者"
    .AddItem "战神"
    .AddItem "坚持毅力"
    .AddItem "善于逆转"
    .AddItem "刻纹专家"
    .AddItem "伟大的对手"
    .AddItem "黑雾猎人"
    .AddItem "守护者"
    .AddItem "荣誉骑士"
    .AddItem "魔法天才"
    .AddItem "雪地的妖精"
    .AddItem "传说的英雄"
    .AddItem "FY战斗员"
    .AddItem "世界第一武人"
    .AddItem "杀手"
    .AddItem "未知的称号"
    End With
   
    With ComboEmblem(0)
    .AddItem "无"
    .AddItem "火焰刻纹"
    .AddItem "流水刻纹"
    .AddItem "奔雷刻纹"
    .AddItem "大地刻纹"
    .AddItem "深暗刻纹"
    .AddItem "星耀刻纹"
    .AddItem "圣灵刻纹"
    .AddItem "禁咒刻纹"
    .AddItem "吞噬刻纹"
    .AddItem "召唤刻纹"
    .AddItem "游侠刻纹"
    .AddItem "战技刻纹"
    .AddItem "诅咒刻纹"
    .AddItem "咒怨刻纹"
    .AddItem "威吓刻纹"
    .AddItem "尸灵刻纹"
    .AddItem "降神刻纹"
    .AddItem "变化刻纹"
    .AddItem "逆法刻纹"
    .AddItem "富豪刻纹"
    .AddItem "魔阵刻纹"
    End With
    
    With ComboEmblem(1)
    .AddItem "无"
    .AddItem "治愈刻纹"
    .AddItem "圣言刻纹"
    .AddItem "诗歌刻纹"
    .AddItem "精神科纹"
    .AddItem "气力刻纹"
    .AddItem "蓄力刻纹"
    .AddItem "护甲刻纹"
    .AddItem "鹰眼刻纹"
    .AddItem "牺牲刻纹"
    .AddItem "威力刻纹"
    .AddItem "空间刻纹"
    .AddItem "祝福刻纹"
    .AddItem "天使刻纹"
    .AddItem "反弹刻纹"
    .AddItem "奉献刻纹"
    .AddItem "复仇刻纹"
    End With
    
    With ComboEmblem(2)
    .AddItem "无"
    .AddItem "地守刻纹"
    .AddItem "水守刻纹"
    .AddItem "火守刻纹"
    .AddItem "风守刻纹"
    .AddItem "光守刻纹"
    .AddItem "暗守刻纹"
    .AddItem "地元刻纹"
    .AddItem "水元刻纹"
    .AddItem "火元刻纹"
    .AddItem "风元刻纹"
    .AddItem "光元刻纹"
    .AddItem "暗元刻纹"
    .AddItem "守护刻纹"
    .AddItem "神农刻纹"
    .AddItem "飞行刻纹"
    .AddItem "神行足刻纹"
    .AddItem "白虎刻纹"
    .AddItem "玄武刻纹"
    .AddItem "青龙刻纹"
    .AddItem "朱雀刻纹"
    .AddItem "麒麟刻纹"
    .AddItem "灵龟刻纹"
    .AddItem "饕餮刻纹"
    .AddItem "白猿刻纹"
    .AddItem "映月刻纹"
    .AddItem "历练刻纹"
    .AddItem "生命刻纹"
    .AddItem "魔力刻纹"
    .AddItem "斗志刻纹"
    .AddItem "圣盾刻纹"
    .AddItem "行动刻纹"
    .AddItem "拋投刻纹"
    End With
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call CloseHandle(lHandle)
End Sub

Private Sub Form_Initialize()
    InitCommonControls
End Sub

'得到角色能力
Private Function ReadRoleAbility(ByVal lRoleNum As Long, ByRef lpAbility() As Long) As Boolean
    Dim Offset As Long
    Offset = -&H1BC
    Dim lAddr As Long
    lAddr = RolesAddr(lRoleNum) + Offset
    Dim lBuffer(30) As Long
    Call ReadProcessMemory(lHandle, lAddr, lBuffer(0), 30 * 4, 0)
    Dim i As Integer
    i = 0
    Do While i < 28
        If lBuffer(i) = &H5D091C Then
            lpAbility(i \ 3) = lCodeTable(lBuffer(i + 1)) Xor lBuffer(i + 2)
        Else
            ReadRoleAbility = False
            Exit Function
        End If
        i = i + 3
    Loop
    lpAbility(0) = lpAbility(0) \ 1000
    
    '读取剩余点数
    Offset = -&H360
    lAddr = RolesAddr(lRoleNum) + Offset
    Call ReadProcessMemory(lHandle, lAddr, lBuffer(0), 3 * 4, 0)
    If lBuffer(0) = &H5D091C Then
        lpAbility(i \ 3) = lCodeTable(lBuffer(1)) Xor lBuffer(2)
    Else
        ReadRoleAbility = False
        Exit Function
    End If
    
    ReadRoleAbility = True
End Function

'得到角色称号
Private Function ReadRoleName(ByVal lRoleNum As Long, ByRef lpName As Long) As Boolean
    Const Offset As Long = -&H30C
    Dim lAddr As Long
    lAddr = RolesAddr(lRoleNum) + Offset
    Dim lBuffer(3) As Long
    Call ReadProcessMemory(lHandle, lAddr, lBuffer(0), 3 * 4, 0)
    If lBuffer(0) = &H5D091C Then
        lpName = lCodeTable(lBuffer(1)) Xor lBuffer(2)
    Else
        ReadRoleName = False
        Exit Function
    End If
    
    ReadRoleName = True
End Function

'得到角色抗性
Private Function ReadRoleResist(ByVal lRoleNum As Long, ByRef lpResist() As Long) As Boolean
    Const Offset As Long = -&H58
    Dim lAddr As Long
    lAddr = RolesAddr(lRoleNum) + Offset
    ReadRoleResist = ReadProcessMemory(lHandle, lAddr, lpResist(0), 6 * 4, 0)
End Function

'得到角色刻纹
Private Function ReadRoleEmblem(ByVal lRoleNum As Long, ByRef lpEmblem() As Long) As Boolean
    Const Offset As Long = -&H2E8
    Dim lAddr As Long
    lAddr = RolesAddr(lRoleNum) + Offset
    Dim lBuffer(27) As Long
    Call ReadProcessMemory(lHandle, lAddr, lBuffer(0), 27 * 4, 0)
    Dim i As Integer
    i = 0
    Do While i < 25
        If lBuffer(i) = &H5D091C Then
            lpEmblem(i \ 3) = lCodeTable(lBuffer(i + 1)) Xor lBuffer(i + 2)
        Else
            ReadRoleEmblem = False
            Exit Function
        End If
        i = i + 3
    Loop

    ReadRoleEmblem = True
End Function


'写入能力
Private Function WriteRoleAbility(ByVal lRoleNum As Long, ByRef lpAbility() As Long) As Boolean
    Dim Offset As Long
    Offset = -&H1BC
    Dim lAddr As Long
    lAddr = RolesAddr(lRoleNum) + Offset
    Dim lBuffer(30) As Long
    Call ReadProcessMemory(lHandle, lAddr, lBuffer(0), 30 * 4, 0)
    Dim i As Integer
    i = 0
    lpAbility(0) = lpAbility(0) * 1000 + 100
    Do While i < 28
        lBuffer(i + 2) = lCodeTable(lBuffer(i + 1)) Xor lpAbility(i \ 3)
        i = i + 3
    Loop

    If WriteProcessMemory(lHandle, lAddr, lBuffer(0), 30 * 4, 0) = 0 Then
        WriteRoleAbility = False
        Exit Function
    End If
    
    Offset = -&H360
    lAddr = RolesAddr(lRoleNum) + Offset
    Call ReadProcessMemory(lHandle, lAddr, lBuffer(0), 3 * 4, 0)
    lBuffer(2) = lCodeTable(lBuffer(1)) Xor lpAbility(i \ 3)
    
    If WriteProcessMemory(lHandle, lAddr, lBuffer(0), 3 * 4, 0) = 0 Then
        WriteRoleAbility = False
        Exit Function
    End If
    
    WriteRoleAbility = True
    
End Function

'写入称号
Private Function WriteRoleName(ByVal lRoleNum As Long, ByRef lpName As Long) As Boolean
    Const Offset As Long = -&H30C
    Dim lAddr As Long
    lAddr = RolesAddr(lRoleNum) + Offset
    Dim lBuffer(3) As Long
    Call ReadProcessMemory(lHandle, lAddr, lBuffer(0), 3 * 4, 0)
    lBuffer(2) = lCodeTable(lBuffer(1)) Xor lpName
    
    If WriteProcessMemory(lHandle, lAddr, lBuffer(0), 3 * 4, 0) = 0 Then
        WriteRoleName = False
        Exit Function
    End If
    
    WriteRoleName = True
End Function

'写入抗性
Private Function WriteRoleResist(ByVal lRoleNum As Long, ByRef lpResist() As Long) As Boolean
    Const Offset As Long = -&H58
    Dim lAddr As Long
    lAddr = RolesAddr(lRoleNum) + Offset
    WriteRoleResist = WriteProcessMemory(lHandle, lAddr, lpResist(0), 6 * 4, 0)
End Function

'写入刻纹
Private Function WriteRoleEmblem(ByVal lRoleNum As Long, ByRef lpEmblem() As Long) As Boolean
    Const Offset As Long = -&H2E8
    Dim lAddr As Long
    lAddr = RolesAddr(lRoleNum) + Offset
    Dim lBuffer(27) As Long
    Call ReadProcessMemory(lHandle, lAddr, lBuffer(0), 27 * 4, 0)
    Dim i As Integer
    i = 0
    Do While i < 25
        lBuffer(i + 2) = lCodeTable(lBuffer(i + 1)) Xor lpEmblem(i \ 3)
        i = i + 3
    Loop
    
    If WriteProcessMemory(lHandle, lAddr, lBuffer(0), 27 * 4, 0) = 0 Then
        WriteRoleEmblem = False
        Exit Function
    End If
    
    WriteRoleEmblem = True
End Function

Private Function DispRole(nnum As Integer) As Boolean
'On Error GoTo Err

    Dim lAbility(11) As Long
    Dim lName As Long
    Dim lResist(6) As Long
    Dim lEmblem(9) As Long

    If Not ReadRoleAbility(nnum, lAbility) Then GoTo Err
    If Not ReadRoleName(nnum, lName) Then GoTo Err
    If Not ReadRoleResist(nnum, lResist) Then GoTo Err
    If Not ReadRoleEmblem(nnum, lEmblem) Then GoTo Err
    
    Dim i As Integer
    For i = 0 To 10
        TxtRole(i).Text = CStr(lAbility(i))
    Next i

    If lName < Combo1.ListCount - 1 Then
        Combo1.ListIndex = lName
    Else
        Combo1.ListIndex = Combo1.ListCount - 1
        Combo1.ItemData(Combo1.ListCount - 1) = lName
    End If
    
    For i = 0 To 5
        TxtResist(i).Text = CStr(lResist(i))
    Next i

    i = 0
    Do While i < 9
    If lEmblem(i) > 0 Then
        ComboEmblem(i \ 3).ListIndex = lEmblem(i)
    Else
        ComboEmblem(i \ 3).ListIndex = 0
    End If
    i = i + 1
    TxtEmblem(i).Text = CStr(lEmblem(i))
    i = i + 1
    TxtEmblem(i).Text = CStr(lEmblem(i))
    i = i + 1
    Loop

    DispRole = True
    Exit Function
Err:
    DispRole = False
End Function

Private Function SaveRole(nnum As Integer) As Boolean
On Error GoTo Err
    Dim lAbility(11) As Long
    Dim lName As Long
    Dim lResist(6) As Long
    Dim lEmblem(9) As Long
    
    Dim i As Integer
    For i = 0 To 10
        lAbility(i) = CLng(TxtRole(i).Text)
    Next i

    If Combo1.ListIndex < Combo1.ListCount - 1 Then
        lName = CLng(Combo1.ListIndex)
    Else
        lName = Combo1.ItemData(Combo1.ListCount - 1)
    End If
    
    For i = 0 To 5
        lResist(i) = CLng(TxtResist(i).Text)
    Next i
    
    i = 0
    Do While i < 9
        If ComboEmblem(i \ 3).ListIndex > 0 Then
            lEmblem(i) = ComboEmblem(i \ 3).ListIndex
        Else
            lEmblem(i) = -1
        End If
        i = i + 1
        lEmblem(i) = CLng(TxtEmblem(i).Text)
        i = i + 1
        lEmblem(i) = CLng(TxtEmblem(i).Text)
        i = i + 1
    Loop

    If Not WriteRoleAbility(nnum, lAbility) Then GoTo Err
    If Not WriteRoleName(nnum, lName) Then GoTo Err
    If Not WriteRoleResist(nnum, lResist) Then GoTo Err
    If Not WriteRoleEmblem(nnum, lEmblem) Then GoTo Err
    
    SaveRole = True
    TxtStatus.Text = "当前角色数据保存成功"
    Exit Function
Err:
    SaveRole = False
    TxtStatus.Text = "角色数据保存错误"
End Function