📄 mod05readinfo.bas
字号:
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 + -