[Delphi] Search Memory

[phroyt]

Hi,

Some time ago I found a piece of code to SearchBytes.
After a little I come out with this.

//XE10 Compatible

uses
  System.SysUtils,
  System.Classes,
  Winapi.PsApi,
  Winapi.Windows;

Function SearchMemory(Module: hModule; wildcard: Byte; searchCode: Array of Byte; size: Integer; Offset: Cardinal = 0) : Pointer;

Implementation

//Search Memory
Function SearchMemory(Module: hModule; wildcard: Byte; searchCode: Array of Byte; size: Integer; Offset: Cardinal = 0) : Pointer;
Const
  UCHAR_MAX = 255;
Var
  scan,lastByte,defaultSkip, searchEnd,searchSuccess : NativeUInt;
  skipLength : ARRAY of Integer;
  dllInfo : TModuleInfo;
  p : pointer;
  OldProtect: DWORD;
begin

  searchSuccess := 0;
  lastByte := size - 1;
  result := nil;

  while searchCode[lastByte] = wildcard do
    Dec(lastByte);

  defaultSkip := lastByte;

  for scan:= 0 to lastByte - 1 do
  begin
    if searchCode[scan] = wildcard then
      defaultSkip := lastByte - scan;
  end;

  if defaultSkip > 1 then
    defaultSkip := defaultSkip - 1;

  //Is just setting the default skip length
  SetLength(skipLength, UCHAR_MAX);
  for scan:=0 to UCHAR_MAX do
    skipLength[scan] := defaultSkip;

  for scan := 0 to lastByte-1 do
    if searchCode[scan] <> wildcard then
      begin
        skipLength[searchCode[scan]] := lastByte - scan;
      end;

  if GetModuleInformation(GetCurrentProcess, Module, @dllInfo, sizeof(dllInfo)) then
    begin

      p := dllInfo.lpBaseOfDll;


      try

        searchEnd := Cardinal(dllInfo.lpBaseOfDll) + dllInfo.SizeOfImage;
        searchEnd := searchEnd - (lastByte + 1);

        if ((Cardinal(p)+offset) <= searchEnd) then
          p := Pointer(Cardinal(p)+offset);


        //FM: remove the write protect on Code Segment
        VirtualProtect(p, searchEnd, PAGE_EXECUTE_READWRITE, OldProtect);

        while Cardinal(p) <= searchEnd do
          begin
            scan := lastByte;

            while ((searchCode[scan] = wildcard) or (PByte(Cardinal(p)+scan)^ = searchCode[scan])) do
            begin
              if scan = 0 then
              begin
                Result := P;
                Inc(searchSuccess);
                Break;
              end;
              scan := scan-1;
            end;

            if ( searchSuccess <> 0 ) then
              break;

            p := Pointer(NativeInt(p)+skipLength[PByte(NativeUInt(p)+lastByte)^]);
          end;

        if ( searchSuccess = 0 ) then
          result := nil;

        if ( searchSuccess > 1 ) then
          result := nil;
      finally
        VirtualProtect(P, searchEnd, OldProtect, @OldProtect);
      end;
    end;
end;

Even without writing anything to Module memory, sometimes I got a wrong Byte value. Changing the protection solved this.


Any thoughts to improve?


Sample use:

const
//SFNTQueryFeature
Const SFNTQueryFeature_SIG :   Array [0..15] of Byte = ($55, $8B, $EC, $83, $EC,
                          $24, $C7, $45, $DC, $02, $00, $00, $00, $51, $31, $C9);

var
  base: hModule;
  proc1,
  proc2: Pointer;
  offset: Cardinal;

begin

  base := GetModuleHandle(nil);

  proc1 := SearchMemory(base, $00, SFNTGetLicense_SIG, length(SFNTGetLicense_SIG));

  if (proc1 <> nil) then
    offset := Cardinal(proc1)+1 - base;
  
  proc2 := SearchMemory(base, $00, SFNTGetLicense_SIG, length(SFNTGetLicense_SIG), offset);

[kjms]

Hi any one please compile as file, i am not familiar in delphi.

[chessgod101]

This is a library for searching memory of a loaded module in your delphi application. It isn't something you can just compile directly into a working program. It you need a means to search bytes in memory, use your favorite hex editor.

[[ID]ZE]

It's excellent reference code.I have quoted it to search for some encrypted video sig bytes.Thx for ur work.