⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 mod05readinfo.bas

📁 这是诛仙外挂的源代码
💻 BAS
📖 第 1 页 / 共 5 页
字号:
                SelObjKind = 0
                SelObjHp = PartHp
                SelObjMaxHp = PartMaxHp
                SelObjSel = SelObjId
                SelObjName = PartName
            Else
                ReadProcessMemory ProcessID, ByVal PartAdr + &H28, TempAdr, 4, 0
                ReadProcessMemory ProcessID, ByVal TempAdr + &H138, PlayAdrB, 4, 0
                ReadProcessMemory ProcessID, ByVal PlayAdrB + &H18, PlayAdrF, 4, 0              '读出玩家列表的首地址
                ReadProcessMemory ProcessID, ByVal PlayAdrB + &H24, PlayMax, 4, 0               '读出玩家数组的最大值
                BaseAdr = PlayAdrF + (SelObjId Mod PlayMax) * 4
                ReadProcessMemory ProcessID, ByVal BaseAdr, TempAdr, 4, 0
                ReadProcessMemory ProcessID, ByVal TempAdr + &H4, BaseAdr, 4, 0
                ReadProcessMemory ProcessID, ByVal BaseAdr + EcxMonKind, SelObjKind, 2, 0       '目标类型
                ReadProcessMemory ProcessID, ByVal BaseAdr + EcxPartLevel, SelObjLevel, 2, 0    '目标等级
                ReadProcessMemory ProcessID, ByVal BaseAdr + EcxPartHp, SelObjHp, 4, 0          '目标当前气血
                ReadProcessMemory ProcessID, ByVal BaseAdr + EcxPartMaxHp, SelObjMaxHp, 4, 0    '目标气血上限
                ReadProcessMemory ProcessID, ByVal BaseAdr + EcxPartX, SelObjX, 4, 0            '目标位置X
                ReadProcessMemory ProcessID, ByVal BaseAdr + EcxPartY, SelObjY, 4, 0            '目标位置Y
                ReadProcessMemory ProcessID, ByVal BaseAdr + EcxMonSel, SelObjSel, 4, 0         '目标的目标的ID
                ReadProcessMemory ProcessID, ByVal BaseAdr + EcxPartName, TempAdr, 4, 0         '目标名称
                ReadProcessMemory ProcessID, ByVal TempAdr, ByVal VarPtr(BuffEnum(0)), 36, BuffL
                SelObjName = Left$(BuffEnum, 36)
                SelObjName = Trim(KillChr0(Trim(SelObjName)))
            End If
            Erase BuffEnum
        Else
            SelObjX = 0
            SelObjY = 0
            SelObjLevel = 0
            SelObjKind = -1
            SelObjHp = 0
            SelObjMaxHp = 0
            SelObjSel = 0
            SelObjName = ""
        End If
    End If
    CloseHandle ProcessID
End Sub
''遍历背包物品
Sub ReadPartBag()
On Error Resume Next
    Dim BaseAdr As Long, TempAdr As Long
    
    Dim i As Long, ii As Integer, IsRed As Boolean
    Dim BagAdrB As Long, BagAdrF As Long, BagTotal As Long
    Dim NamePy1 As Long, NamePy2 As Long
    Dim BGBaseAdr As Long, BGCount As Long, BGMaxCount As Long
    Dim BGoodsID As Long, BGClass As Long
    Dim BGNameAdr As Long, BGNameb(65) As Byte, BuffL As Long, BGName 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 + EcxBagAdrB, BagAdrB, 4, 0                  '背包基址
        ReadProcessMemory ProcessID, ByVal BagAdrB + EcxBagTotal, BagTotal, 4, 0                '背包总格数
        ReadProcessMemory ProcessID, ByVal BagAdrB + EcxBagAdrF, BagAdrF, 4, 0                  '背包首地址
        PartBagLeave = BagTotal
        If Main.LVPick(1).ListItems.Count > BagTotal Then
            Main.LVPick(1).ListItems.Clear
        End If
        PartBagTotalRed = 0
        PartBagTotalBlue = 0
        For i = 0 To BagTotal - 1
            ReadProcessMemory ProcessID, ByVal BagAdrF + 4 * i, BGBaseAdr, 4, 0
            If BGBaseAdr > 0 Then
                ReadProcessMemory ProcessID, ByVal BGBaseAdr + &H4, BGClass, 4, 0               '物品类型
                Select Case BGClass
                    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 BGBaseAdr + &H8, BGoodsID, 4, 0              '得到物品ID
                ReadProcessMemory ProcessID, ByVal BGBaseAdr + &H14, BGCount, 4, 0              '格子内物品数量
                ReadProcessMemory ProcessID, ByVal BGBaseAdr + &H18, BGMaxCount, 4, 0           '格子内物品数量上限
                ReadProcessMemory ProcessID, ByVal BGBaseAdr + NamePy1, BGNameAdr, 4, 0         '物品名称
                ReadProcessMemory ProcessID, ByVal BGNameAdr + NamePy2, BGNameb(0), 64, 0       '物品名称
                BGName = Left$(BGNameb, 64)
                BGName = Trim(KillChr0(Trim(BGName)))
                Erase BGNameb
                If BGoodsID <> 0 Then
                    PartBagLeave = PartBagLeave - 1
                    IsRed = False
                    For ii = 0 To Main.CboRed.ListCount - 1
                        If BGoodsID = Trim(Left(Main.CboRed.List(ii), InStr(Main.CboRed.List(ii), ",") - 1)) Then
                            PartBagTotalRed = PartBagTotalRed + BGCount
                            ii = Main.CboRed.ListCount + 1
                            IsRed = True
                        End If
                    Next ii
                    If IsRed = False Then
                        For ii = 0 To Main.CboBlue.ListCount - 1
                            If BGoodsID = Trim(Left(Main.CboBlue.List(ii), InStr(Main.CboBlue.List(ii), ",") - 1)) Then
                                PartBagTotalBlue = PartBagTotalBlue + BGCount
                                ii = Main.CboBlue.ListCount + 1
                            End If
                        Next ii
                    End If
                End If
            End If
            If Main.LVPick(1).ListItems.Count = i Then
                Set itmX = Main.LVPick(1).ListItems.Add(, , CStr(i + 1))
            Else
                Set itmX = Main.LVPick(1).ListItems(i + 1)
            End If
            If BGBaseAdr > 0 Then
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("Kind").SubItemIndex) = BGClass
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("Name").SubItemIndex) = BGName
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("Num").SubItemIndex) = CStr(BGCount)
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("MNum").SubItemIndex) = CStr(BGMaxCount)
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("ID").SubItemIndex) = CStr(BGoodsID)
            Else
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("Kind").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("Name").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("Num").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("MNum").SubItemIndex) = ""
                itmX.SubItems(Main.LVPick(1).ColumnHeaders("ID").SubItemIndex) = ""
            End If
        Next i
        CloseHandle ProcessID
    End If
    Main.SSTab2.TabCaption(1) = "包[" & PartBagLeave & "/" & BagTotal & "]"
    Main.LabMedi(0).Caption = PartBagTotalRed
    Main.LabMedi(1).Caption = PartBagTotalBlue
    If PartBagLeave = 0 And BagTotal > 0 And Main.CheSafe(13).Value = 1 Then
        ClearBag
    End If
    If PartBagLeave = 0 And BagTotal > 0 Then
        If FirstFull And Online = 1 And Main.CheOther(0).Value = 1 Then
            Main.TimeBegFull.Enabled = True
        End If
    Else
        FirstFull = True
    End If
End Sub
''遍历任务背包物品
Sub ReadPartTaskBag()
On Error Resume Next
    Dim BaseAdr As Long, TempAdr As Long
    
    Dim i As Long, ii As Integer
    Dim BagAdrB As Long, BagAdrF As Long, BagTotal As Long
    Dim NamePy1 As Long, NamePy2 As Long
    Dim BGBaseAdr As Long, BGCount As Long, BGMaxCount As Long
    Dim BGoodsID As Long, BGClass As Long
    Dim BGNameAdr As Long, BGNameb(65) As Byte, BuffL As Long, BGName 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 + EcxBagAdrB + &H8, BagAdrB, 4, 0           '背包基址
        ReadProcessMemory ProcessID, ByVal BagAdrB + EcxBagTotal, BagTotal, 4, 0                '背包总格数
        ReadProcessMemory ProcessID, ByVal BagAdrB + EcxBagAdrF, BagAdrF, 4, 0                  '背包首地址
        If Main.LVPick(3).ListItems.Count > BagTotal Then
            Main.LVPick(3).ListItems.Clear
        End If
        For i = 0 To BagTotal - 1
            ReadProcessMemory ProcessID, ByVal BagAdrF + 4 * i, BGBaseAdr, 4, 0
            If BGBaseAdr > 0 Then
                ReadProcessMemory ProcessID, ByVal BGBaseAdr + &H4, BGClass, 4, 0               '物品类型
                Select Case BGClass
                    Case 6, 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
                        NamePy1 = &H68
                        NamePy2 = &HC
                    Case 27, 28, 29
                        NamePy1 = &H8C
                        NamePy2 = &H4
                    Case Else
                        NamePy1 = &H60
                        NamePy2 = &H4
                End Select
                ReadProcessMemory ProcessID, ByVal BGBaseAdr + &H8, BGoodsID, 4, 0              '得到物品ID
                ReadProcessMemory ProcessID, ByVal BGBaseAdr + &H14, BGCount, 4, 0              '格子内物品数量
                ReadProcessMemory ProcessID, ByVal BGBaseAdr + &H18, BGMaxCount, 4, 0           '格子内物品数量上限
                ReadProcessMemory ProcessID, ByVal BGBaseAdr + NamePy1, BGNameAdr, 4, 0         '物品名称
                ReadProcessMemory ProcessID, ByVal BGNameAdr + NamePy2, BGNameb(0), 64, 0       '物品名称
                BGName = Left$(BGNameb, 64)
                BGName = Trim(KillChr0(Trim(BGName)))
                Erase BGNameb
            End If
            If Main.LVPick(3).ListItems.Count = i Then
                Set itmX = Main.LVPick(3).ListItems.Add(, , CStr(i + 1))
            Else
                Set itmX = Main.LVPick(3).ListItems(i + 1)
            End If
            If BGBaseAdr > 0 Then
                itmX.SubItems(Main.LVPick(3).ColumnHeaders("Kind").SubItemIndex) = BGClass
                itmX.SubItems(Main.LVPick(3).ColumnHeaders("Name").SubItemIndex) = BGName
                itmX.SubItems(Main.LVPick(3).ColumnHeaders("Num").SubItemIndex) = CStr(BGCount)
                itmX.SubItems(Main.LVPick(3).ColumnHeaders("MNum").SubItemIndex) = CStr(BGMaxCount)
                itmX.SubItems(Main.LVPick(3).ColumnHeaders("ID").SubItemIndex) = CStr(BGoodsID)
            Else
                itmX.SubItems(Main.LVPick(3).ColumnHeaders("Kind").SubItemIndex) = ""

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -