VB实现CE的AobScan功能,仿CE字节组内存搜索.

'这里的东西写模块里面，具体怎么写，我不告诉你<br /> Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long<br /> Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long<br /> Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long<br /> Private Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long<br /> Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long<br /> Public Declare Function VirtualQueryEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, lpBuffer As MEMORY_BASIC_INFORMATION, ByVal dwLength As Long) As Long<br /> Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long<br /> Public Type MEMORY_BASIC_INFORMATION<br /> BaseAddress As Long<br /> AllocationBase As Long<br /> AllocationProtect As Long<br /> RegionSize As Long<br /> State As Long<br /> Protect As Long<br /> lType As Long<br /> End Type<br /> Type PROCESS_MEMORY_COUNTERS<br /> cb As Long<br /> PageFaultCount As Long<br /> PeakWorkingSetSize As Long<br /> WorkingSetSize As Long<br /> QuotaPeakPagedPoolUsage As Long<br /> QuotaPagedPoolUsage As Long<br /> QuotaPeakNonPagedPoolUsage As Long<br /> QuotaNonPagedPoolUsage As Long<br /> PagefileUsage As Long<br /> PeakPagefileUsage As Long<br /> End Type<br /> Public Function GetPid(lpClassName As String, lpWindowName As String) As Long<br /> GetWindowThreadProcessId FindWindow(lpClassName, lpWindowName), GetPid<br /> End Function<br /> Public Function GetMemoryByPID(ByVal Pid As Integer) As String<br /> Dim tPMC As PROCESS_MEMORY_COUNTERS<br /> Dim lProcessID<br /> Dim hProcess<br /> lProcessID = Pid<br /> hProcess = OpenProcess(&H1F0FFF, False, lProcessID)<br /> If (GetProcessMemoryInfo(hProcess, tPMC, Len(tPMC)) <> 0) Then<br /> GetMemoryByPID = Hex(tPMC.WorkingSetSize)<br /> End If<br /> CloseHandle hProcess<br /> End Function

'程序窗体定义一个局部变量<br /> Dim GamePid As String<br /> Dim Rst(2000000) As Long<br /> Private Sub Form_Load()<br /> GamePid = GetPid(vbNullString, "程序名写到这里，你知道的！")<br /> End Sub<br /> '把字节数组转换的函数<br /> Function Fz(Str As String) As String<br /> Dim a As String<br /> a = Replace(Str, " ", "")<br /> Dim i As Integer<br /> Dim b As String<br /> For i = Len(a) To 2 Step -2<br /> b = b & Mid(a, i - 1, 2)<br /> Next<br /> Fz = b<br /> End Function

Function AobScan(Pid As String, ZJSZ As String) As String<br /> ReDim da(1023) As Byte<br /> Dim z As Long<br /> Dim zr As Long<br /> Dim Srge As Long<br /> Dim hpid As Long<br /> Dim Minf As MEMORY_BASIC_INFORMATION<br /> Dim Mbsize As Long<br /> Dim Dda(100) As Byte<br /> Dim Zfr As Long<br /> Dim Zed As Long<br /> Dim Siz As Integer<br /> Dim Csiz As Integer<br /> Dim Shsiz As Integer<br /> Dim Mlng As Long<br /> Mbsize = Len(Minf)<br /> Zfr = 0<br /> Zed = CLng("&H" & GetMemoryByPID(GamePid))<br /> LRsc = Rsc<br /> Rsc = -1<br /> Siz = 2<br /> Shsiz = 2<br /> mstr = Fz(ZJSZ)<br /> '循环看数组的长度，并转换成字节数组<br /> Dim i As Integer<br /> For i = Len(mstr) To 2 Step -2<br /> Dda((i / 2) - 1) = CInt("&h" & Mid$(mstr, Len(mstr) - i + 1, 2))<br /> Next<br /> hpid = OpenProcess(&H1F0FFF, False, CLng(Pid))<br /> z = Zfr '设置开始内存<br /> Do While z < Zed - 1 '判断是否小于结束内存<br /> ret = VirtualQueryEx(hpid, z, Minf, Mbsize) '查询地址空间中内存地址的信息<br /> If ret = 0 Then<br /> Srge = 1023<br /> zr = z<br /> Else<br /> Srge = Minf.RegionSize - 1<br /> zr = Minf.BaseAddress<br /> If (Minf.Protect And 4) And Minf.State = 4096 Then<br /> ReDim da(Srge) As Byte<br /> a = ReadProcessMemory(hpid, zr, da(0), Srge + 1, ByVal 0&)<br /> If a <> 0 Then<br /> For zz = 0 To Srge Step Shsiz<br /> If Srge - zz < Siz - 1 Then Exit For<br /> For bj = 0 To Siz - 1<br /> If da(zz + bj) <> Dda(bj) Then Exit For<br /> Next bj<br /> If bj = Siz Then Rsc = Rsc + 1: Rst(Rsc) = zr + zz<br /> Next zz<br /> End If<br /> End If<br /> End If<br /> z = zr + Srge + 1<br /> DoEvents<br /> Loop<br /> CloseHandle (hpid)<br /> AobScan = Hex$(Rst(0))<br /> End Function

<br /> Private Sub Command3_Click()<br />       MsgBox AobScan(GamePid, "1d 8e 25 00 19")<br /> End Sub