Đọc điểm số trò chơi sol

[Vcoder180990]

Các bạn tham khảo qua sửa lại 1 chút api là dùng được trên vba ạ


'Cần 1 Timer, 1 CommandButton, 2 TextBox(Text1.Text = "", Text2.Text = 5000)
Chạy game Solitaire để thấy kết quả.
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As Long
Private 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
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, ByVal lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_VM_WRITE As Long = (&H20)
Private Const PROCESS_VM_READ As Long = (&H10)
Private Const PROCESS_VM_OPERATION As Long = (&H8)
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)
Private Const PROCESS_READ_WRITE_QUERY = PROCESS_VM_OPERATION + PROCESS_QUERY_INFORMATION + PROCESS_VM_READ + PROCESS_VM_WRITE
Private Const BASE_ADDRESS As Long = &H1007170
Private Const SCORE_OFFSET As Long = &H30

Dim hProcess As Long, WinHwnd As Long, dwProcessID As Long

Public Function ReadProcessLong(ByVal hProcess As Long, ByVal lpBaseAddress As Long) As Long
Dim TempVal As Long
ReadProcessMemory hProcess, lpBaseAddress, TempVal, Len(TempVal), 0
ReadProcessLong = TempVal
End Function

Public Function WriteProcessLong(ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal sValue As Long) As Long
WriteProcessLong = WriteProcessMemory(hProcess, lpBaseAddress, ByVal VarPtr(sValue), Len(sValue), 0)
End Function

Private Sub Command1_Click()
On Error Resume Next
WinHwnd = FindWindow("Solitaire", "Solitaire")
If WinHwnd = 0 Then Exit Sub
GetWindowThreadProcessId WinHwnd, dwProcessID
hProcess = OpenProcess(PROCESS_READ_WRITE_QUERY, False, dwProcessID)

WriteProcessLong hProcess, (ReadProcessLong(hProcess, BASE_ADDRESS) + SCORE_OFFSET), Text2.Text
CloseHandle hProcess
End Sub

Private Sub Form_Load()
Timer1.Interval = 1
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
WinHwnd = FindWindow("Solitaire", "Solitaire")
If WinHwnd = 0 Then Exit Sub
GetWindowThreadProcessId WinHwnd, dwProcessID
hProcess = OpenProcess(PROCESS_READ_WRITE_QUERY, False, dwProcessID)

Text1.Text = ReadProcessLong(hProcess, ReadProcessLong(hProcess, BASE_ADDRESS) + SCORE_OFFSET)
CloseHandle hProcess
End Sub

 

[VetMini]

Thấy code dài thòn mà mở đầu bàng mấy cái Đi-cờ-le mình hãi lắm.
Nhỡ bị vi rút, quay trở lại thì thớt đã xóa mất bài, lấy gì than khóc.