高手帮忙看看这段代码为什么不能过滤物品

aja93

学习VB做挂1个星期了，现在可以自动打怪，但是宝宝老是拣满，想做个过滤系统，单独做着试验可以过滤，可是和打怪的放一起就不起作用了，各位老师帮忙看看需要怎么修改一下，代码我全贴上来
Option Explicit
Dim hwd As Long
Dim pid As Long
Dim hProcess As Long
Dim mpmax As Long
Dim hpmax As Long
Dim base As Long
Dim gwid As Long
Dim hp As Long
Dim fz As Long
Dim mp As Long


Private Sub Command1_Click()
If Command1.Caption = "开始" Then  '按下标签为“开始”的按钮，激活TimerAdd并改变标签为“停止”
  TimerAdd.Enabled = True
  Command1.Caption = "停止"
ElseIf Command1.Caption = "停止" Then  '刚好和上面相反
  TimerAdd.Enabled = False
  Command1.Caption = "开始"
End If
End Sub

Private Sub Command2_Click()
If Combo1.Text <> "" Then List2.AddItem Combo1.Text
End Sub

Private Sub Command3_Click()
If List2.ListIndex <> -1 Then List2.RemoveItem (List2.ListIndex)  '当选中某项则删除某项
End Sub

Private Sub Form_Load()
hwd = FindWindow("QElementClient Window", "Element Client")
If hwd = 0 Then
  MsgBox "未启动游戏", vbOKOnly, "提示"
  Unload Form1
End If
GetWindowThreadProcessId hwd, pid  '获取进程标识符
'将进程标识符做为参数，返回目标进程PID的句柄，得到此句柄后
'即可对目标进行读写操,PROCESS_ALL_ACCESS表示完全控制,权限最大
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, pid)
If hProcess = 0 Then
  MsgBox "不能打开进程", vbOKOnly, "提示"
  Unload Form1
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
CloseHandle hProcess
End Sub

Private Sub Timer1_Timer()
Dim base As Long  '存储地址
Dim mecxi As Long  '存储地址
Dim pn As Integer  '循环变量
Dim WpName(65) As Byte '存储物品名称
List1.Clear '用于刷新物品列表
If hProcess Then
  ReadProcessMemory hProcess, ByVal &H12F824, mecxi, 4, 0
  ReadProcessMemory hProcess, ByVal mecxi + &H8, mecxi, 4, 0
  ReadProcessMemory hProcess, ByVal mecxi + &H24, mecxi, 4, 0
  ReadProcessMemory hProcess, ByVal mecxi + &H14, mecxi, 4, 0
  If mecxi <> 0 Then
    For n = 0 To 768  '循环用来判断那个值内存在物品
      ReadProcessMemory hProcess, ByVal &H12F824, base, 4, 0
      ReadProcessMemory hProcess, ByVal base + &H8, base, 4, 0
      ReadProcessMemory hProcess, ByVal base + &H24, base, 4, 0
      ReadProcessMemory hProcess, ByVal base + &H18, base, 4, 0
      ReadProcessMemory hProcess, ByVal base + 4 * n, base, 4, 0 '从列表中选出地面上物品的地址
      If base > 0 Then '判断是否存在物品
      ReadProcessMemory hProcess, ByVal base + 4, base, 4, 0
      ReadProcessMemory hProcess, ByVal base + &H164, base, 4, 0
      ReadProcessMemory hProcess, ByVal base, WpName(0), 64, 0  '得到物品名称
      List1.AddItem WpName  '添加到List控件
      End If
    Next n
  End If
End If
End Sub

Private Sub Timer2_Timer()
Dim base As Long  '存储地址
Dim mecxi As Long  '存储地址
Dim WpNameT As Long
Dim n As Integer
Dim WpName(65) As Byte '存储物品名称
Dim x As Integer

If hProcess Then
  ReadProcessMemory hProcess, ByVal &H12F824, mecxi, 4, 0
  ReadProcessMemory hProcess, ByVal mecxi + &H8, mecxi, 4, 0
  ReadProcessMemory hProcess, ByVal mecxi + &H24, mecxi, 4, 0
  ReadProcessMemory hProcess, ByVal mecxi + &H14, mecxi, 4, 0 '得到物品数量
  If mecxi <> 0 Then
    For n = 0 To 768  '循环用来判断那个值内存在物品
      ReadProcessMemory hProcess, ByVal &H12F824, base, 4, 0
      ReadProcessMemory hProcess, ByVal base + &H8, base, 4, 0
      ReadProcessMemory hProcess, ByVal base + &H24, base, 4, 0
      ReadProcessMemory hProcess, ByVal base + &H18, base, 4, 0
      ReadProcessMemory hProcess, ByVal base + 4 * n, base, 4, 0  '从列表中选出地面上物品的地址
      If base > 0 Then '判断是否存在物品
          ReadProcessMemory hProcess, ByVal base + 4, base, 4, 0
          ReadProcessMemory hProcess, ByVal base + &H164, WpNameT, 4, 0
          ReadProcessMemory hProcess, ByVal WpNameT, WpName(0), 64, 0  '得到物品名称
          For x = 0 To List2.ListCount - 1  '用循环查找是否是过滤表内要过滤的物品
          If InStr(WpName, List2.List(x)) >= 1 Then  '用InSet()进行对比，存在过滤表内容则过滤
            WriteProcessMemory hProcess, ByVal base + &H110, 0, 4, 0 '变ID为0，有捡物品动作但背包内无此物品
            Label1.Caption = "已过滤：" & CStr(WpName)  '过滤提示，观察用
            End If
          Next x
        End If
    Next n
  End If
End If
End Sub

Private Sub TimerAdd_Timer()
If Val(Text1.Text) > hp Then  '比较当前血量是否比预定值低
  SendMessage hwd, &H100, &H32, 0&
  SendMessage hwd, &H101, &H32, 0&
End If
If Val(Text2.Text) > mp Then  '比较当前蓝量是否比预定值低
  SendMessage hwd, &H100, &H70, 0&
  SendMessage hwd, &H101, &H70, 0&
End If
If Val(Text3.Text) > fz Then  '比较当前辅助技能个数是否比预定值低
  SendMessage hwd, &H100, &H76, 0&
  SendMessage hwd, &H101, &H76, 0&
End If
If gwid <> 0 Then
  SendMessage hwd, &H100, &H31, 0& '按1键
  SendMessage hwd, &H101, &H31, 0&
End If
If gwid = 0 Then
  SendMessage hwd, &H100, &H9, 0& '寻怪Tab键
  SendMessage hwd, &H101, &H9, 0&
End If
If gwid <> 0 Then
  SendMessage hwd, &H100, &H71, 0& '按F2键
  SendMessage hwd, &H101, &H71, 0&
End If
  SendMessage hwd, &H100, &H33, 0& '拾取
  SendMessage hwd, &H101, &H33, 0&
End Sub

Private Sub TimerList_Timer()
Dim name(31) As Byte  '存储人物名称
Dim name_temp As Long

hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
If hProcess Then
  ReadProcessMemory hProcess, ByVal &H12F824, base, 4, 0&
  ReadProcessMemory hProcess, ByVal base + &H24, base, 4, 0&    '得到为人物基地址，方便以后使用
  ReadProcessMemory hProcess, ByVal base + &H258, hp, 4, 0&    '得到生命值
  ReadProcessMemory hProcess, ByVal base + &H270, hpmax, 4, 0&  '得到生命最大值
  ReadProcessMemory hProcess, ByVal base + &H25C, mp, 4, 0&    '得到真气值
  ReadProcessMemory hProcess, ByVal base + &H274, mpmax, 4, 0&  '得到真气最大值
  ReadProcessMemory hProcess, ByVal base + &H79C, gwid, 4, 0&  '得到怪物ID
  ReadProcessMemory hProcess, ByVal base + &H394, name_temp, 4, 0&
  ReadProcessMemory hProcess, ByVal name_temp, name(0), 32, 0&  '得到人物名称
  ReadProcessMemory hProcess, ByVal base + &H118, fz, 4, 0&  '得到人物辅助技能个数
  CloseHandle hProcess
End If
Frame1.Caption = name  '显示人物名称
Label1.Caption = "生命值：" & hp & "/" & hpmax '显示生命值
Label2.Caption = "真气值：" & mp & "/" & mpmax '显示真气值
End Sub
还有就是这句怎么可以每次选好怪以后只按一次
If gwid <> 0 Then
  SendMessage hwd, &H100, &H71, 0& '按F2键
  SendMessage hwd, &H101, &H71, 0&
End If
    各位高手帮帮忙吧

舒天倦云

当然是别人的代码，一个初学者只能去借鉴各位老师的代码，如果自己会写会编也就不会发贴找老师帮忙解决这些白痴问题了，不过这些代码我全部从新改过，一些地址都变了，而且老师发上来的代码都是不完全的，只是供新手学习用的，我把他们组合起来能自动完成打怪喝药自己感觉已经是成功了第一步了，最开始做的自动补血会不停的喝药，看了ccb老师的回复去学习后问题解决了，现在想学习下物品过滤，所以发个帖子，希望各位老师帮我找到问题出在哪，这个论坛的宗旨不就是让大家在一起沟通和学习么？还是要感谢你看完我发的东西，虽然没让我学到东西，但是你认真的看完了，要不然也不知道我是用别人的代码

蓝雨

好帖，顶一下，支持楼主