Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
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 WriteString Lib "kernel32" Alias "WriteProcessMemory" ( _
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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
  lpClassName As String, ByVal lpWindowName As String) As Long
Public handle As Long
 
 
Private Function ReadMemory(hWnd As Long, Address As Long, Bytes As Long, _
  Optional strReplaceWith As String) As String
    'Runs For Not Unicode Strings (VB-Strings)
    On Error Resume Next
    Dim pId As Long        ' Used to hold the Process Id
    Dim pHandle As Long    ' Holds the Process Handle
    Dim bytValue As Long   'Stores the value of a byte in the memory
    Dim i As Long
    Dim Text As String
 
    ' Get the ProcId of the Window
    GetWindowThreadProcessId hWnd, pId
 
    ' use the pId to get a handle
    pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pId)
 
    If (pHandle = 0) Then
         'MsgBox "Unable to open process!"
         Exit Function
    End If
    If Address = 0 Then Exit Function
 
    For i = 1 To Bytes Step 2
       ' Read Byte to Byte
       ReadProcessMemory pHandle, Address + i - 1, bytValue, 1, 0&
       'value now contains the long value of the byte located in [Address + i - 
       ' 1] pos.
       'ReadMemory is a string...
 
       ReadMemory = ReadMemory & Chr$(bytValue)
    Next
    'to write numeric values you can ..(Must) use WriteValue API
    If LenB(strReplaceWith) <> 0 Then
        'No Unicode!!
        WriteString pHandle, Address, StrPtr(strReplaceWith), LenB( _
          strReplaceWith), 0&
    End If
    'Close the Handle
    CloseHandle pHandle
End Function
 
Private Sub Command1_Click()
 
handle = FindWindow(vbNullString, "Solitär")
 
Dim str As String
 
str = ReadMemory(handle, &HA9D28&, 500)
 
Label1.Caption = handle
Label2.Caption = str
 
End Sub