mod05readinfo.bas

这是诛仙外挂的源代码

                itmX.SubItems(Main.LVPick(3).ColumnHeaders("Name").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(3).ColumnHeaders("Num").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(3).ColumnHeaders("MNum").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(3).ColumnHeaders("ID").SubItemIndex) = ""
            End If
        Next i
        CloseHandle ProcessID
    End If
End Sub
''遍历仓库物品
Sub ReadPartHouse()
On Error Resume Next
    Dim BaseAdr As Long, TempAdr As Long
    
    Dim i As Long
    Dim HouseAdrB As Long, HouseAdrF As Long
    Dim NamePy1 As Long, NamePy2 As Long
    Dim HGBaseAdr As Long, HGCount As Long, HGMaxCount As Long
    Dim HGoodsID As Long, HGClass As Long
    Dim HGNameAdr As Long, HGNameb(65) As Byte, BuffL As Long, HGName As String
    Dim itmX As ListItem
    
    ProcessID = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, hProcId)
    If ProcessID Then
        ReadProcessMemory ProcessID, ByVal PartAdr + &H28, BaseAdr, 4, 0                        '二级基址
        ReadProcessMemory ProcessID, ByVal BaseAdr + EcxHouseAdrB, HouseAdrB, 4, 0              '仓库基址
        ReadProcessMemory ProcessID, ByVal HouseAdrB + EcxHouseTotal, HouseTotal, 4, 0          '仓库总格数
        ReadProcessMemory ProcessID, ByVal HouseAdrB + EcxHouseAdrF, HouseAdrF, 4, 0            '仓库首地址
        PartHouseLeave = HouseTotal
        If Main.LVPick(2).ListItems.Count > HouseTotal Then
            Main.LVPick(2).ListItems.Clear
        End If
        For i = 0 To HouseTotal - 1
            ReadProcessMemory ProcessID, ByVal HouseAdrF + 4 * i, HGBaseAdr, 4, 0
            If HGBaseAdr > 0 Then
                ReadProcessMemory ProcessID, ByVal HGBaseAdr + &H4, HGClass, 4, 0               '物品类型
                Select Case HGClass
                    Case 7, 8, 9, 10, 11, 12, 13, 14, 20, 22, 23, 24, 25, 26, 30, 35
                        NamePy1 = &H60
                        NamePy2 = &H4
                    Case 15, 16, 17, 18, 19
                        NamePy1 = &H60
                        NamePy2 = &HC
                    Case 21, 31
                        NamePy1 = &H64
                        NamePy2 = &H4
                    Case 0, 1, 2, 3, 4, 5, 6
                        NamePy1 = &H68
                        NamePy2 = &HC
                    Case 27, 28, 29
                        NamePy1 = &H8C
                        NamePy2 = &H4
                    Case Else
                        NamePy1 = &H60
                        NamePy2 = &H4
                End Select
                ReadProcessMemory ProcessID, ByVal HGBaseAdr + &H8, HGoodsID, 4, 0              '得到物品ID
                ReadProcessMemory ProcessID, ByVal HGBaseAdr + &H14, HGCount, 4, 0              '格子内物品数量
                ReadProcessMemory ProcessID, ByVal HGBaseAdr + &H18, HGMaxCount, 4, 0           '格子内物品数量上限
                ReadProcessMemory ProcessID, ByVal HGBaseAdr + NamePy1, HGNameAdr, 4, 0         '物品名称
                ReadProcessMemory ProcessID, ByVal HGNameAdr + NamePy2, HGNameb(0), 64, 0       '物品名称
                HGName = Left$(HGNameb, 64)
                HGName = Trim(KillChr0(Trim(HGName)))
                Erase HGNameb
                If HGoodsID <> 0 Then
                    PartHouseLeave = PartHouseLeave - 1
                End If
            End If
            If Main.LVPick(2).ListItems.Count = i Then
                Set itmX = Main.LVPick(2).ListItems.Add(, , CStr(i + 1))
            Else
                Set itmX = Main.LVPick(2).ListItems(i + 1)
            End If
            If HGBaseAdr > 0 Then
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("Kind").SubItemIndex) = HGClass
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("Name").SubItemIndex) = HGName
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("Num").SubItemIndex) = CStr(HGCount)
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("MNum").SubItemIndex) = CStr(HGMaxCount)
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("ID").SubItemIndex) = CStr(HGoodsID)
            Else
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("Kind").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("Name").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("Num").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("MNum").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(2).ColumnHeaders("ID").SubItemIndex) = ""
            End If
        Next i
        CloseHandle ProcessID
        Main.SSTab2.TabCaption(2) = "仓[" & PartHouseLeave & "/" & HouseTotal & "]"
    End If
End Sub
''遍历地面物品
Sub ReadFloorGoods()
On Error Resume Next
    Dim BaseAdr As Long, TempAdr As Long
    
    Dim i As Integer
    Dim GoodAdrB As Long, GoodNum As Long, GoodAdrF As Long, GoodMax As Long
    Dim pn As Integer, pni As Integer                                                           '循环变量
    Dim FGBaseAdr As Long                                                                       '地面物品基址
    Dim FGNameAdr As Long, FGNameb(65) As Byte, BuffL As Long, FGName As String                 '物品名称
    Dim FGoodsX As Single, FGoodsY As Single                                                    '物品坐标
    Dim FGoodsSysID As Long, FGoodsID As Long                                                   '物品ID
    Dim nDistance As Integer                                                                    '距离
    Dim cWay As String, cWayX As Integer, cWayY As Integer                                      '方向
    Dim itmX As ListItem
    Dim IsPick As Boolean                                                                       '是否拾取
    
    ProcessID = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, hProcId)
    If ProcessID Then
        Main.LVPick(0).ListItems.Clear
        ReadProcessMemory ProcessID, ByVal PartAdr + &H8, TempAdr, 4, 0
        ReadProcessMemory ProcessID, ByVal TempAdr + &H24, GoodAdrB, 4, 0
        ReadProcessMemory ProcessID, ByVal GoodAdrB + &H18, GoodAdrF, 4, 0                      '读出物品列表的首地址
        ReadProcessMemory ProcessID, ByVal GoodAdrB + &H24, GoodMax, 4, 0                       '读出物品数组的最大值
        ReadProcessMemory ProcessID, ByVal GoodAdrB + &H14, GoodNum, 4, 0                       '地面物品数量
        If GoodNum > 0 Then
            For pn = 0 To (GoodMax - 1)                                                         '循环用来判断那个值内存在物品
                ReadProcessMemory ProcessID, ByVal GoodAdrF + pn * 4, FGBaseAdr, 4, 0           '从列表中选出地面上物品的地址
                If FGBaseAdr > 0 Then
                    ReadProcessMemory ProcessID, ByVal FGBaseAdr + &H4, FGBaseAdr, 4, 0
                    ReadProcessMemory ProcessID, ByVal FGBaseAdr + &H3C, FGoodsX, 4, 0          '物品X坐标
                    ReadProcessMemory ProcessID, ByVal FGBaseAdr + &H44, FGoodsY, 4, 0          '物品Y坐标
                    ReadProcessMemory ProcessID, ByVal FGBaseAdr + &H10C, FGoodsSysID, 4, 0     '物品系统ID
                    ReadProcessMemory ProcessID, ByVal FGBaseAdr + &H110, FGoodsID, 4, 0        '物品ID
                    ReadProcessMemory ProcessID, ByVal FGBaseAdr + &H168, FGNameAdr, 4, 0       '读取物品名称首地址
                    ReadProcessMemory ProcessID, ByVal FGNameAdr, FGNameb(0), 64, BuffL         '得到物品名称
                    FGName = Left$(FGNameb, 64)                                                 '名称
                    FGName = Trim(KillChr0(Trim(FGName)))
                    Erase FGNameb
                    '判断过滤
                    IsPick = True
                    If Main.ChePick1(0).Value = 1 Then
                        If Main.ChePick1(1).Value = 1 Then
                            For pni = 0 To Main.ListPick1.ListCount - 1
                                If FGName = Main.ListPick1.List(pni) Then
                                    IsPick = False
                                End If
                            Next pni
                        End If
                    End If
                    '添加到列表中
                    If IsPick Then
                        '判断是不是短时间已经捡过一次
                        For i = 1 To Main.LVPick(4).ListItems.Count
                            Set itmX = Main.LVPick(4).ListItems(i)
                            If Trim(CStr(FGoodsSysID)) = Trim(itmX.SubItems(Main.LVPick(4).ColumnHeaders("FGSID").SubItemIndex)) And _
                                Trim(CStr(FGoodsID)) = Trim(itmX.SubItems(Main.LVPick(4).ColumnHeaders("FGID").SubItemIndex)) Then
                                IsPick = False
                                Exit For
                            End If
                        Next i
                        If IsPick Then
                            cWayX = PartX - FGoodsX
                            cWayY = PartY - FGoodsY
                            nDistance = Int((cWayX ^ 2 + cWayY ^ 2) ^ (1 / 2))                      '距离
                            cWay = cDirection(cWayX, cWayY)
                            '添加到地面物品列表
                            Set itmX = Main.LVPick(0).ListItems.Add(, , cWay)
                            itmX.SubItems(Main.LVPick(0).ColumnHeaders("Name").SubItemIndex) = FGName
                            itmX.SubItems(Main.LVPick(0).ColumnHeaders("Ran").SubItemIndex) = CStr(nDistance)
                            itmX.SubItems(Main.LVPick(0).ColumnHeaders("X").SubItemIndex) = CStr(Fix(FGoodsX))
                            itmX.SubItems(Main.LVPick(0).ColumnHeaders("Y").SubItemIndex) = CStr(Fix(FGoodsY))
                            itmX.SubItems(Main.LVPick(0).ColumnHeaders("FGID").SubItemIndex) = CStr(FGoodsID)
                            itmX.SubItems(Main.LVPick(0).ColumnHeaders("FGSID").SubItemIndex) = CStr(FGoodsSysID)
                        End If
                    Else
                        'WriteProcessMemory ProcessID, ByVal FGBaseAdr + &H10C, 0, 4, 0          '变系统ID为0，不捡此物品
                        'WriteProcessMemory ProcessID, ByVal FGBaseAdr + &H110, 0, 4, 0          '变物品ID为0，不捡此物品
                    End If
                End If
            Next pn
        End If
    End If
    CloseHandle ProcessID
End Sub
''遍历NPC怪物信息
Sub ReadNpcInfo(MonOrNpc As Integer)
On Error Resume Next
    Dim BaseAdr As Long, TempAdr As Long
    
    Dim NextTempAdr As Long
    Dim i As Integer, ii As Integer
    Dim MonAdrB As Long, MonNum As Long, MonAdrF As Long, MonMax As Long
    Dim nDistance As Integer, cDistance As String
    Dim cWay As String, cWayX As Integer, cWayY As Integer                                      '方向
    Dim MonName As String, MonLevel As Integer, MonKind As Integer, MonSel As Long
    Dim MonX As Single, MonY As Single, MonID As Long
    Dim BuffEnum(36) As Byte, BuffL As Long
    Dim itmX As ListItem
    Dim IsAdd As Boolean
    
    ProcessID = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, hProcId)
    If ProcessID Then
        '怪物及NPC相关
        ReadProcessMemory ProcessID, ByVal PartAdr + &H8, TempAdr, 4, 0
        ReadProcessMemory ProcessID, ByVal TempAdr + &H20, MonAdrB, 4, 0
        ReadProcessMemory ProcessID, ByVal MonAdrB + &H18, MonAdrF, 4, 0                        '读出怪物列表的首地址
        ReadProcessMemory ProcessID, ByVal MonAdrB + &H24, MonMax, 4, 0                         '读出怪物数组的最大值
        ReadProcessMemory ProcessID, ByVal MonAdrB + &H14, MonNum, 4, 0                         '周围怪物数量
        If MonOrNpc = 0 Then
            Main.LVNpc(0).ListItems.Clear
        ElseIf MonOrNpc = 1 Then
            Main.LVNpc(1).ListItems.Clear
        End If
        If MonNum > 0 Then
            For i = 0 To MonMax - 1
                BaseAdr = MonAdrF + i * 4
                ReadProcessMemory ProcessID, ByVal BaseAdr, TempAdr, 4, 0
                '新加的下面两行
                Do While TempAdr > 0
                    ReadProcessMemory ProcessID, ByVal TempAdr + 0, NextTempAdr, 4, 0
                    If TempAdr > 0 Then
                        ReadProcessMemory ProcessID, ByVal TempAdr + &H4, BaseAdr, 4, 0
                        ReadProcessMemory ProcessID, ByVal BaseAdr + EcxMonKind, MonKind, 2, 0      '怪物类型
                        ReadProcessMemory ProcessID, ByVal BaseAdr + EcxMonID, MonID, 4, 0          '怪物ID
                        ReadProcessMemory ProcessID, ByVal BaseAdr + EcxMonX, MonX, 4, 0            '怪物位置X
                        ReadProcessMemory ProcessID, ByVal BaseAdr + EcxMonY, MonY, 4, 0            '怪物位置Y
                        ReadProcessMemory ProcessID, ByVal BaseAdr + EcxMonLevel, MonLevel, 2, 0    '怪物等级