AdvanceVB

A simple module to read Environment Variables from a remote process. Tested on XP and 7.

'---------------------------------------------------------------------------------------
' Module      : mRemoteGetEnviron
' DateTime    : 23/02/2010 21:29
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://www.advancevb.com.ar
' Purpose     : Read remote process environment variables.
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' Reference   : http://www.codeproject.com/KB/threads/ReadProcEnv.aspx
'
' History     : 23/02/2010 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit

Private Const PROCESS_QUERY_INFORMATION As Long = &H400
Private Const PROCESS_VM_READ           As Long = 16&

Public 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 Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function NtQueryInformationProcess Lib "ntdll.dll" (ByVal ProcessHandle As Long, ByVal ProcessInformationClass As Long, ByVal ProcessInformation As Long, ByVal ProcessInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Private Declare Function RtlAdjustPrivilege Lib "ntdll" (ByVal Privilege As Long, ByVal bEnablePrivilege As Long, ByVal bCurrentThread As Long, ByRef OldState As Long) As Long

Public Function ReadEnviron(ByVal lPid As Long) As Collection
    Dim lPtr            As Long
    Dim lProc           As Long
    Dim cData           As New Collection

    Set ReadEnviron = cData

    Call RtlAdjustPrivilege(20, 1, 0, 0)

    lPtr = GetPEB(lPid)

    lProc = OpenProcess(PROCESS_VM_READ, 0, lPid)

    If lProc Then

        If Not ReadProcessMemory(lProc, ByVal lPtr + &H10, lPtr, &H4, 0&) = 0 Then 'RTL_USER_PROCESS_PARAMETERS

            If Not ReadProcessMemory(lProc, ByVal lPtr + &H48, lPtr, &H4, 0&) = 0 Then 'environment variables block

                Dim bData As Byte
                Dim sData As String
                Dim lOffset As Long

                Do
                    lOffset = lOffset + 2
                    If bData = 0 Then
                        If Not sData = vbNullString Then cData.Add sData
                        sData = vbNullString
                        Call ReadProcessMemory(lProc, ByVal lPtr + lOffset, bData, &H1, 0&)
                        If bData = 0 Then
                            Exit Do
                        End If
                    Else
                        Call ReadProcessMemory(lProc, ByVal lPtr + lOffset, bData, &H1, 0&)
                    End If
                    sData = sData & Chr$(bData)
                Loop
            End If

        End If

        Call CloseHandle(lProc)

    End If

    Set ReadEnviron = cData

End Function

Private Function GetPEB(ByVal lPid As Long) As Long
    Dim tPBI    As PROCESS_BASIC_INFORMATION
    Dim lRet    As Long
    Dim lProc   As Long

    lProc = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lPid)
    If lProc Then
        If NtQueryInformationProcess(lProc, 0, VarPtr(tPBI), Len(tPBI), lRet) = 0 Then
            GetPEB = tPBI.PEBBaseAddress
        End If
        CloseHandle lProc
    End If

End Function