////////////////////////////////////////////////////////////////////////////////
//
//                    Remote VirtualMemory Wrapper for Win32
//                        (Windows 95/98/SE/ME/NT/2K/XP)
//
////////////////////////////////////////////////////////////////////////////////
//
//  The Original Code is:
//    NcxVmx9x.pas, 2005-02-09.
//
//  The Initial Developer of the Original Code is Nico Bendlin <nicode@gmx.net>
//
//  Portions created by Nico Bendlin are
//    Copyright (C) 2005 Nico Bendlin. All Rights Reserved.
//
//  Contributors:
//    <you> ?-)
//
//  The contents of this file are subject to the Mozilla Public License Version
//  1.1 (the "License"); you may not use this file except in compliance with the
//  License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
//
//  Software distributed under the License is distributed on an "AS IS" basis,
//  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
//  the specific language governing rights and limitations under the License.
//
//  Alternatively, the contents of this file may be used under the terms of
//  either the GNU General Public License Version 2 or later (the "GPL"), or
//  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
//  in which case the provisions of the GPL or the LGPL are applicable instead
//  of those above. If you wish to allow use of your version of this file only
//  under the terms of either the GPL or the LGPL, and not to allow others to
//  use your version of this file under the terms of the MPL, indicate your
//  decision by deleting the provisions above and replace them with the notice
//  and other provisions required by the GPL or the LGPL. If you do not delete
//  the provisions above, a recipient may use your version of this file under
//  the terms of any one of the MPL, the GPL or the LGPL.
//
////////////////////////////////////////////////////////////////////////////////


unit NcxVmx9x {platform};

{$ALIGN ON}
{$BOOLEVAL OFF}
{$EXTENDEDSYNTAX ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$IFNDEF FPC}
  {$STACKFRAMES OFF}
{$ELSE}
  {$HINTS OFF}
{$ENDIF}


interface

uses
  Windows;


function VirtualFreeEx(hProcess: THandle; lpAddress: Pointer;
  dwSize, dwFreeType: DWORD): BOOL; stdcall;
function VirtualAllocEx(hProcess: THandle; lpAddress: Pointer;
  dwSize, flAllocationType, flProtect: DWORD): Pointer; stdcall;
function ReadProcessMemory(hProcess: THandle; lpBaseAddress, lpBuffer: Pointer;
  nSize: Cardinal; var lpNumberOfBytesRead: Cardinal): BOOL; stdcall;
function WriteProcessMemory(hProcess: THandle; lpBaseAddress, lpBuffer: Pointer;
  nSize: Cardinal; var lpNumberOfBytesWritten: Cardinal): BOOL; stdcall;

function InitNcxVmx9x: Boolean;
procedure DeinitNcxVmx9x;


implementation


// types

type
  LONG = LongInt;
  SIZE_T = Cardinal;
  HANDLE = Pointer;
  HMODULE = Pointer;
  LPVOID = Pointer;
  LPCVOID = Pointer;

// locks

var
   NcxVmx9xInitialized: Boolean;
   NcxVmx9xInitializing: LONG;
   NcxVmx9xUsageCounter: LONG;

// utils

function InterlockedIncrement(var lpAddend: LONG): LONG; register;
asm
         mov     ecx, eax
         mov     eax, 00000001h
lock     xadd    [ecx], eax
         inc     eax
end;

function InterlockedDecrement(var lpAddend: LONG): LONG; register;
asm
         mov     ecx, eax
         mov     eax, 0FFFFFFFFh
lock     xadd    [ecx], eax
         dec     eax
end;

function InterlockedExchange(var Target: LONG; Value: LONG): LONG; register;
asm
         mov     ecx, eax
         mov     eax, [ecx]
@@0:
{$IFNDEF VER90}{$IFNDEF VER100} // D2/D3 compiler bug (wrong op-codes)
lock     cmpxchg [ecx], edx
{$ELSE}  db      $F0, $0F, $B1, $11 {$ENDIF}
{$ELSE}  db      $F0, $0F, $B1, $11 {$ENDIF}
         jnz     @@0
end;


////////////////////////////////////////////////////////////////////////////////
//
//  Wrappers
//


function EnterWrapper: Boolean;
begin
  Result := False;
  InterlockedIncrement(NcxVmx9xUsageCounter);
  try
    if not NcxVmx9xInitialized then
    begin
      InterlockedDecrement(NcxVmx9xUsageCounter);
      try
        InitNcxVmx9x;
      finally
        InterlockedIncrement(NcxVmx9xUsageCounter);
      end;
    end;
    Result := True;
  finally
    if not Result then
      InterlockedDecrement(NcxVmx9xUsageCounter);
  end;
end;

procedure LeaveWrapper;
begin
  InterlockedDecrement(NcxVmx9xUsageCounter);
end;


// VirtualFreeEx

type
  TFNVirtualFreeEx = function (hProcess: HANDLE; lpAddress: LPVOID;
    dwSize: SIZE_T; dwFreeType: DWORD): BOOL; stdcall;

var
  FNVirtualFreeEx: TFNVirtualFreeEx;

function VirtualFreeEx(hProcess: THandle; lpAddress: Pointer;
  dwSize, dwFreeType: DWORD): BOOL; stdcall;
begin
  Result := False;
  if EnterWrapper then
    try
      if Assigned(FNVirtualFreeEx) then
        Result := FNVirtualFreeEx(HANDLE(hProcess), lpAddress, dwSize,
          dwFreeType)
      else
        SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
    finally
      LeaveWrapper;
    end;
end;


// VirtualAllocEx

type
  TFNVirtualAllocEx = function(hProcess: HANDLE; lpAddress: LPVOID;
    dwSize: SIZE_T; flAllocationType, flProtect: DWORD): LPVOID; stdcall;

var
  FNVirtualAllocEx: TFNVirtualAllocEx;

function VirtualAllocEx(hProcess: THandle; lpAddress: Pointer;
  dwSize, flAllocationType, flProtect: DWORD): Pointer; stdcall;
begin
  Result := nil;
  if EnterWrapper then
    try
      if Assigned(FNVirtualAllocEx) then
        Result := FNVirtualAllocEx(HANDLE(hProcess), lpAddress, dwSize,
          flAllocationType, flProtect)
      else
        SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
    finally
      LeaveWrapper;
    end;
end;


// ReadProcessMemory

type
  TFNReadProcessMemory = function(hProcess: HANDLE; lpBaseAddress: LPCVOID;
    lpBuffer: LPVOID; nSize: SIZE_T;
    var lpNumberOfBytesRead: SIZE_T): BOOL; stdcall;

var
  FNReadProcessMemory: TFNReadProcessMemory;

function ReadProcessMemory(hProcess: THandle; lpBaseAddress, lpBuffer: Pointer;
  nSize: Cardinal; var lpNumberOfBytesRead: Cardinal): BOOL; stdcall;
begin
  Result := False;
  if EnterWrapper then
    try
      if Assigned(FNReadProcessMemory) then
        Result := FNReadProcessMemory(HANDLE(hProcess), lpBaseAddress, lpBuffer,
          nSize, lpNumberOfBytesRead)
      else
        SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
    finally
      LeaveWrapper;
    end;
end;


// WriteProcessMemory

type
  TFNWriteProcessMemory = function(hProcess: HANDLE;
    lpBaseAddress: LPVOID; lpBuffer: LPCVOID; nSize: SIZE_T;
    var lpNumberOfBytesWritten: SIZE_T): BOOL; stdcall;

var
  FNWriteProcessMemory: TFNWriteProcessMemory;

function WriteProcessMemory(hProcess: THandle; lpBaseAddress, lpBuffer: Pointer;
  nSize: Cardinal; var lpNumberOfBytesWritten: Cardinal): BOOL; stdcall;
begin
  Result := False;
  if EnterWrapper then
    try
      if Assigned(FNWriteProcessMemory) then
        Result := FNWriteProcessMemory(HANDLE(hProcess), lpBaseAddress,
          lpBuffer, nSize, lpNumberOfBytesWritten)
      else
        SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
    finally
      LeaveWrapper;
    end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//  VirtualFreeEx9x/NT
//


// VirtualFreeEx9x

function VirtualFreeEx9x(hProcess: HANDLE; lpAddress: LPVOID; dwSize: SIZE_T;
  dwFreeType: DWORD): BOOL; stdcall;
begin
  Result := VirtualFree(lpAddress, dwSize, dwFreeType);
end;


// VirtualFreeExNt

var
  FNVirtualFreeExOrg: TFNVirtualFreeEx;

function VirtualFreeExNt(hProcess: HANDLE; lpAddress: LPVOID; dwSize: SIZE_T;
  dwFreeType: DWORD): BOOL; stdcall;
begin
  if Assigned(FNVirtualFreeExOrg) then
    Result := FNVirtualFreeExOrg(hProcess, lpAddress, dwSize, dwFreeType)
  else
  begin
    Result := False;
    SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//  VirtualAllocEx9x/NT
//


// VirtualAllocEx9x

function VirtualAllocEx9x(hProcess: HANDLE; lpAddress: LPVOID; dwSize: SIZE_T;
  flAllocationType, flProtect: DWORD): LPVOID; stdcall;
const
  VA_SHARED = $08000000;
begin
  Result := VirtualAlloc(lpAddress, dwSize, flAllocationType or VA_SHARED,
    flProtect);
end;


// VirtualAllocExNt

var
  FNVirtualAllocExOrg: TFNVirtualAllocEx;

function VirtualAllocExNt(hProcess: HANDLE; lpAddress: Pointer;
  dwSize, flAllocationType, flProtect: DWORD): Pointer; stdcall;
begin
  if Assigned(FNVirtualAllocExOrg) then
    Result := FNVirtualAllocExOrg(hProcess, lpAddress, dwSize, flAllocationType,
      flProtect)
  else
  begin
    Result := nil;
    SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//  ReadProcessMemory9x/Nt
//


// ReadProcessMemory9x

function ReadProcessMemory9x(hProcess: HANDLE; lpBaseAddress: LPCVOID;
  lpBuffer: LPVOID; nSize: SIZE_T;
  var lpNumberOfBytesRead: SIZE_T): BOOL; stdcall;
begin
  try
    Move(lpBaseAddress^, lpBuffer^, Integer(nSize));
    if @lpNumberOfBytesRead <> nil then
      lpNumberOfBytesRead := nSize;
    Result := True;
  except
    if @lpNumberOfBytesRead <> nil then
      lpNumberOfBytesRead := 0;
    SetLastError(ERROR_PARTIAL_COPY);
    Result := False;
  end;
end;


// ReadProcessMemoryNt

var
  FNReadProcessMemoryOrg: TFNReadProcessMemory;

function ReadProcessMemoryNt(hProcess: HANDLE; lpBaseAddress: LPCVOID;
  lpBuffer: LPVOID; nSize: SIZE_T;
  var lpNumberOfBytesRead: SIZE_T): BOOL; stdcall;
begin
  if Assigned(FNReadProcessMemoryOrg) then
    Result := FNReadProcessMemoryOrg(hProcess, lpBaseAddress, lpBuffer, nSize,
      lpNumberOfBytesRead)
  else
  begin
    Result := False;
    SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//  WriteProcessMemory9x/Nt
//


// WriteProcessMemory9x

function WriteProcessMemory9x(hProcess: HANDLE; lpBaseAddress: LPVOID;
  lpBuffer: LPCVOID; nSize: SIZE_T;
  var lpNumberOfBytesWritten: SIZE_T): BOOL; stdcall;
begin
  try
    Move(lpBuffer^, lpBaseAddress^, Integer(nSize));
    if @lpNumberOfBytesWritten <> nil then
      lpNumberOfBytesWritten := nSize;
    Result := True;
  except
    if @lpNumberOfBytesWritten <> nil then
      lpNumberOfBytesWritten := 0;
    SetLastError(ERROR_PARTIAL_COPY);
    Result := False;
  end;
end;


// WriteProcessMemoryNt

var
  FNWriteProcessMemoryOrg: TFNWriteProcessMemory;

function WriteProcessMemoryNt(hProcess: HANDLE; lpBaseAddress: LPVOID;
  lpBuffer: LPCVOID; nSize: SIZE_T;
  var lpNumberOfBytesWritten: SIZE_T): BOOL; stdcall;
begin
  if Assigned(FNWriteProcessMemoryOrg) then
    Result := FNWriteProcessMemoryOrg(hProcess, lpBaseAddress, lpBuffer, nSize,
      lpNumberOfBytesWritten)
  else
  begin
    Result := False;
    SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
  end;
end;


////////////////////////////////////////////////////////////////////////////////
//
//  Initialization / Deinitialization
//


function InitNcxVmx9x: Boolean;
var
  Kernel: HMODULE;
  Memory: LPVOID;
begin
  if InterlockedExchange(NcxVmx9xInitializing, 1) <> 0 then
    try
      while InterlockedExchange(NcxVmx9xInitializing, 1) <> 0 do
        Sleep(0);
      Result := NcxVmx9xInitialized;
    finally
      InterlockedExchange(NcxVmx9xInitializing, 0);
    end
  else
    try
      if NcxVmx9xInitialized then
        Result := NcxVmx9xInitialized
      else
      begin

        Result := False;

        if not Assigned(FNVirtualFreeEx) or
          not Assigned(FNVirtualAllocEx) or
          not Assigned(FNReadProcessMemory) or
          not Assigned(FNWriteProcessMemory) then
        begin
          Kernel := HMODULE(GetModuleHandle('kernel32.dll'));
          FNVirtualFreeExOrg := TFNVirtualFreeEx(
            GetProcAddress(THandle(Kernel), 'VirtualFreeEx'));
          FNVirtualAllocExOrg := TFNVirtualAllocEx(
            GetProcAddress(THandle(Kernel), 'VirtualAllocEx'));
          FNReadProcessMemoryOrg := TFNReadProcessMemory(
            GetProcAddress(THandle(Kernel), 'ReadProcessMemory'));
          FNWriteProcessMemoryOrg := TFNWriteProcessMemory(
            GetProcAddress(THandle(Kernel), 'WriteProcessMemory'));
          Memory := nil;
          if Assigned(FNVirtualFreeExOrg) and
            Assigned(FNVirtualAllocExOrg) and
            Assigned(FNReadProcessMemoryOrg) and
            Assigned(FNWriteProcessMemoryOrg) then
          begin
            Memory := FNVirtualAllocExOrg(HANDLE(GetCurrentProcess), nil,
              1, MEM_COMMIT, PAGE_READWRITE);
            if Memory <> nil then
            begin
              FNVirtualFreeExOrg(HANDLE(GetCurrentProcess), Memory, 0,
                MEM_RELEASE);
              FNVirtualFreeEx := TFNVirtualFreeEx(@VirtualFreeExNt);
              FNVirtualAllocEx := TFNVirtualAllocEx(@VirtualAllocExNt);
              FNReadProcessMemory :=
                TFNReadProcessMemory(@ReadProcessMemoryNt);
              FNWriteProcessMemory :=
                TFNWriteProcessMemory(@WriteProcessMemoryNt);
              Result := True;
            end;
          end;
          if (nil = Memory) and
            (GetVersion and DWORD($80000000) <> 0) then
          begin
            FNVirtualFreeEx := TFNVirtualFreeEx(@VirtualFreeEx9x);
            FNVirtualAllocEx := TFNVirtualAllocEx(@VirtualAllocEx9x);
            FNReadProcessMemory :=
              TFNReadProcessMemory(@ReadProcessMemory9x);
            FNWriteProcessMemory :=
              TFNWriteProcessMemory(@WriteProcessMemory9x);
            Result := True;
          end;
        end;

        NcxVmx9xInitialized := Result;

      end;
    finally
      InterlockedExchange(NcxVmx9xInitializing, 0);
    end;
end;


procedure DeinitNcxVmx9x;
begin
  while InterlockedExchange(NcxVmx9xInitializing, 1) <> 0 do
    Sleep(0);
  try
    NcxVmx9xInitialized := False;
    while InterlockedIncrement(NcxVmx9xUsageCounter) > 1 do
      try
        Sleep(0);
      finally
        InterlockedDecrement(NcxVmx9xUsageCounter);
      end;
    FNVirtualFreeEx := nil;
    FNVirtualAllocEx := nil;
    FNReadProcessMemory := nil;
    FNWriteProcessMemory := nil;
    InterlockedDecrement(NcxVmx9xUsageCounter);
  finally
    InterlockedExchange(NcxVmx9xInitializing, 0);
  end;
end;


end.