Option Explicit
 
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 Long, lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesRead As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
Private Memoria(0 To 100)   As Long
 
Private Sub Command1_Click()
Dim i As Long
Dim bToFind()               As Byte
    For i = 20 To 35
        Memoria(i) = (i + 4658984)
    Next
    bToFind() = LongToByte(4658984 + 20)
    ' // tiene que dar la dirrecion en memoria del indice de    varptr(Memoria(20))
    MsgBox VarPtr(Memoria(20)) = FindInMemory(Me.hWnd, bToFind, VarPtr(Memoria(0)), (VarPtr(Memoria(100))) + LenB(Memoria(100)))
End Sub
 
Public Function FindInMemory(ByVal hWnd As Long, _
                             ByRef bToFind() As Byte, _
                             ByVal lptrIni As Long, _
                             ByVal lptrend As Long) As Long
' No termine bien la funcion solo es un pequeño Esbozo para el tema.
Dim hproc                   As Long
Dim babuff()                As Byte
Dim llnbuff                 As Long
Dim llnread                 As Long
Dim lret                    As Long
Dim lptradd                 As Long
Dim pId                     As Long
 
Dim q                       As Long
Dim c                       As Long
 
    FindInMemory = 0
    llnbuff = ArrayCount(bToFind())
    If Not ((lptrIni = 0) And (hWnd = 0) And (llnbuff = 0) And (lptrend = 0)) And (llnbuff <= (lptrend - lptrIni)) Then
        GetWindowThreadProcessId hWnd, pId
        hproc = OpenProcess(PROCESS_ALL_ACCESS, False, pId)
        If Not (hproc = 0) Then
            ReDim babuff(0 To (llnbuff - 1))
            lptradd = 0
            Do  '   //  Se puede optimizar bastante...
                ReadProcessMemory hproc, ByVal (lptrIni + lptradd), ByVal VarPtr(babuff(0)), llnbuff, llnread
                lret = InByteArray(0, bToFind, babuff)
                If (lret >= 0) Then
                    FindInMemory = ((lptrIni + lptradd) + lret)
                    Exit Do
                End If
                lptradd = (lptradd + 1)
                DoEvents
            Loop Until ((lptrIni + lptradd) = (lptrend - llnbuff))
            CloseHandle hproc
        End If
    End If
End Function
 
 

 
Option Explicit
 
Public Declare Function VarPtrA Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Public Declare Sub lCopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
 
Public Const InvalidValueArray = -1
 
Public Function InByteArray(ByVal lStart As Long, ByRef bArray1() As Byte, ByRef bArray2() As Byte) As Long
Dim llna1               As Long
Dim llna2               As Long
Dim llimt               As Long
Dim q                   As Long
Dim c                   As Long
    InByteArray = (-1)
    If (lStart >= 0) Then
        llna1 = ArrayCount(bArray1())
        llna2 = ArrayCount(bArray2())
        If Not ((llna1 = 0) And (llna2 = 0)) Then
            llimt = (llna1 - llna2)
            If (llimt >= 0) Then
                q = lStart
                Do While (q <= llimt)
                    Do While (bArray1(q + c) = bArray2(c))
                        c = (c + 1)
                        If (c = llna2) Then
                            InByteArray = q
                            GoTo ExitFunc
                        End If
                    Loop
                    q = ((q + c) + 1)
                    c = 0
                Loop
            End If
        End If
    End If
ExitFunc:
End Function
 
Public Function LongToByte(ByVal lVal As Long) As Byte()
Dim bRet(0 To 3)        As Byte
    bRet(3) = (lVal And &HFF000000) \ &H1000000
    bRet(2) = (lVal And &HFF0000) \ &H10000
    bRet(1) = (lVal And &HFF00&) \ &H100
    bRet(0) = (lVal And &HFF)
    LongToByte = bRet
End Function
 
Public Function ArrayCount(ByRef vArray() As Byte)
    If Itsarrayini(VarPtrA(vArray)) Then
        If LBound(vArray) = 0 Then
            ArrayCount = 1
        End If
        ArrayCount = ArrayCount + UBound(vArray)
    Else
        ArrayCount = 0
    End If
End Function
 
Public Function Itsarrayini(ByVal lngPtr As Long, Optional LnBytes As Long = 4) As Boolean
Dim lng_PtrSA                   As Long
    If lngPtr <> 0 And LnBytes > 0 Then
        Call lCopyMemory(ByVal VarPtr(lng_PtrSA), ByVal lngPtr, LnBytes)
        Itsarrayini = Not lng_PtrSA = 0
    End If
End Function