Option Explicit
 
'KERNEL32
Private Declare Function OpenProcess Lib "KERNEL32" (ByVal dwDA As Long, ByVal bIH As Integer, ByVal dwPID As Long) As Long
Private Declare Sub CloseHandle Lib "KERNEL32" (ByVal hObject 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
'NTDLL
Private Declare Function NtQueryInformationProcess Lib "NTDLL" (ByVal ProcessHandle As Long, ByVal InformationClass As Long, ByRef ProcessInformation As Any, ByVal ProcessInformationLength As Long, ByRef ReturnLength As Any) As Long
 
Private Const PROCESS_VM_READ           As Long = &H10
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
 
Private Const ProcessBasicInformation = 0
 
Private Type PROCESS_BASIC_INFORMATION
    ExitStatus                      As Long
    PebBaseAddress                  As Long
    AffinityMask                    As Long
    BasePriority                    As Long
    UniqueProcessId                 As Long
    InheritedFromUniqueProcessId    As Long
End Type
 
Private Const MY_REL_POS    As Long = &H1C7E
Private Const MY_SIZE       As Long = &HF
 
Sub Main()
    Dim lPID    As Long
    Dim hProc   As Long
    Dim bvBuf() As Byte
 
    Do
        lPID = Val(InputBox("PID a proteger?"))
    Loop Until lPID > 0
 
    hProc = OpenProcess(PROCESS_QUERY_INFORMATION + PROCESS_VM_READ, False, lPID)
 
    If hProc Then
        ReDim bvBuf(0 To MY_SIZE)
        If ReadProcessMemory(hProc, GetBaseAddr(hProc) + MY_REL_POS, bvBuf(0), MY_SIZE, ByVal 0&) Then
            Debug.Print Hex$(bvBuf(0))
        End If
        Call CloseHandle(hProc)
    End If
End Sub
 
Private Function GetBaseAddr(ByVal hProc As Long) As Long
    Dim PBI     As PROCESS_BASIC_INFORMATION
 
    Call NtQueryInformationProcess(hProc, ProcessBasicInformation, PBI, Len(PBI), Len(PBI))
    If PBI.PebBaseAddress Then
        Call ReadProcessMemory(hProc, PBI.PebBaseAddress + 8, GetBaseAddr, 4, ByVal 0)
    End If
End Function

Private Declare Sub GetMem4 Lib "MSVBVM60" (ByVal Addr As Long, RetVal As Long)