[Delphi] FindPattern + DataCompare

Guten Abend,
brauche unbedingt die beiden Funktionen FindPattern und DataCompare in Delphi, da meine DLL Injection mit C nicht so funktioniert, wie ich es möchte...deshalb Delphi. Doch leider scheitert es schon dran, den Code in Delphi zu übersetzen :wall:
Kann mir vielleicht einer der wenigen Personen, die Delphi können, dabei helfen? Wäre wirklich nett!

Code:
bool bDataCompare(const BYTE* pData, const BYTE* bMask, const char* szMask)
{
    for(;*szMask;++szMask,++pData,++bMask)
    {
        if(*szMask=='x' && *pData!=*bMask )
        {
            return false;
        }
    }
    return (*szMask) == NULL;
}
 
DWORD FindPattern(DWORD dwAddress,DWORD dwLen,BYTE *bMask,char * szMask)
{
    for(DWORD i=0; i < dwLen; i++)
    {
        if( bDataCompare( (BYTE*)( dwAddress+i ),bMask,szMask) )
        {
            return (DWORD)(dwAddress+i);
        }
    }
    return 0;
}
 
Die Funktionen stammen übrigens von dom1nik und/oder P47R!CK soweit ich mich erinnere und man findet sie im OGC Sourcecode.

Ich habe vor Jahren beide Funktionen in Delphi übersetzt.
Posten will ich das jetz eigentlich nicht.

Wäre doch besser, wenn du später selbst übersetzen kannst, anstatt immer darum zu betteln, oder?

Poste doch mal deinen Vorschlag soweit du kommst und wir schauen mal, wo es noch hakt.
 
Die Funktionen stammen übrigens von dom1nik und/oder P47R!CK soweit ich mich erinnere und man findet sie im OGC Sourcecode.
Ah danke für die Quelle, habe den Code selbst von einer Seite ohne Angaben.

Ich habe vor Jahren beide Funktionen in Delphi übersetzt.
Posten will ich das jetz eigentlich nicht.
Schade... :(

Wäre doch besser, wenn du später selbst übersetzen kannst, anstatt immer darum zu betteln, oder?

Poste doch mal deinen Vorschlag soweit du kommst und wir schauen mal, wo es noch hakt.
Mein Ansatz ist sozusagen Zeile für Zeile übersetzt (und nicht mal das wirklich gut), ergibt aber auch nicht den gewünschten logischen Sinn...

Code:
function DataCompare(pData: Byte; bMask: Byte; szMask: PChar): boolean;
begin
 while(szMask<>'') do
 begin
  if (szMask = 'x') and (pData <> bMask) then
  begin
   result:= false;
   exit;
  end;
  inc(szMask);
  inc(pData);
  inc(bMask);
 end;

 result:= szMask = '';
end;

function FindPattern(dwAddress: DWORD; dwLen: DWORD; bMask: Byte; szMask: PChar): DWORD;
var n: DWORD;
begin
 result:= 0;
 for n:= 0 to dwLen-1 do
  if DataCompare(Byte(dwAddress+n),bMask,szMask) then
  begin
   result:= dwAddress+n;
  end;
end;
 
(1) bMask ist ja ein Pointer zu einem ByteArray welches später die Signatur enthält. Es ist nicht ein einzelnes Byte, sondern ein Zeiger zu einem ByteArray.
Also nicht "bMask: Byte", sondern: "bMask: PByte" bzw ^Byte;

(2) Dasselbe gilt für pData. Es soll auf das aktuelle Byte im Speicher zeigen, welches wir gegen die Signatur vergleichen wollen.

(3) Um also ein Pointer auf die aktuelle Adresse an bDataCompare zu übergeben, muss ein Pointer auf ein Byte daraus werden.
Also wir übergeben PByte(dwAddress + n)

(4) szMask ist ein ganzer String, also die Maske, die wir für den Signaturen-Vergleich anwenden wollen.
Wir möchten in der Schleife gucken, ob wir schon am Ende des Strings sind indem wir auf den den NULL-Terminator checken.
Allerdings checkst du da im While den ganzen String gegen ''
Wir wollen aber nur das aktuelle Zeichen checken. Wir müssen also wieder casten. Gibt mehrere Möglichkeiten. Eine wäre: while (PByte(szMask)^ <> $00) do

Dasselbe gilt beim checken auf 'x'. Dort ist es aber einfacher auf ein einzelnes Char zu casten.

(5) pData <> pMask macht ja deswegen keinen Sinn mehr, da wir ja Pointer haben, die in jedem Fall unterschiedlich sind. Wir wollen jeweils die Bytes vergleichen worauf dieZeiger zeigen. Also -> dereferenzieren

(6) Inc() kann leider keine Pointer direkt inkrementieren. Also musst du alle drei Pointer vorher als DWORD() casten um zu inkrementieren.
 
Erstmal vielen vielen Dank für die Hilfe!!!

Nach den Verbesserungen sieht der Code nun so aus:
Code:
function DataCompare(pData: PByte; bMask: PByte; szMask: PChar): boolean;
begin
 while (PByte(szMask)^ <> $00) do
 begin
  if (Char(szMask) = 'x') and (pData^ <> bMask^) then
  begin
   result:= false;
   exit;
  end;
  inc(DWORD(szMask));
  inc(DWORD(pData));
  inc(DWORD(bMask));
 end;

 result:= szMask = '';
end;

function FindPattern(dwAddress: DWORD; dwLen: DWORD; bMask: PByte; szMask: PChar): DWORD;
var n: DWORD;
begin
 result:= 0;
 for n:= 0 to dwLen-1 do
  if DataCompare(PByte(dwAddress + n),bMask,szMask) then
  begin
   result:= dwAddress+n;
  end;
end;

Entspricht das dem von dir Verbessertem?
 
Eine Sache noch:

Char(szMask): Wo hast du hier dereferenziert? Hier versuchst du einen Pointer als einzelnes Zeichen zu casten.

Ansonsten sieht es ganz gut aus. Jetzt kannst du die Phase des Kompilierens und Testens einleiten. :wink:
 
Okay, dann habe ich gleich mal losgelegt...
Meine Test-DLL:
Code:
library FindPattern;

uses
  SysUtils,
  Windows,
  SysInit,
  Classes;

{$R *.res}

function DataCompare(pData: PByte; bMask: PByte; szMask: PChar): boolean;
begin
 while (PByte(szMask)^ <> $00) do
 begin
  if (Char(szMask^) = 'x') and (pData^ <> bMask^) then
  begin
   result:= false;
   exit;
  end;
  inc(DWORD(szMask));
  inc(DWORD(pData));
  inc(DWORD(bMask));
 end;

 result:= szMask = '';
end;

function dwFindPattern(dwAddress: DWORD; dwLen: DWORD; bMask: PByte; szMask: PChar): DWORD;
var n: DWORD;
begin
 result:= 0;
 for n:= 0 to dwLen-1 do
  if DataCompare(PByte(dwAddress + n),bMask,szMask) then
  begin
   result:= dwAddress+n;
  end;
end;

procedure StartSearching();
var nStartAddress, nSize: integer;
    cItem, cMask: string;
begin
 nStartAddress:= 44040192;
 nSize:= 27262976;

 cItem:= '\x8B\xCE\x90\x90\x90\xB8\x00\x00\x00\x00\xE8\x00\x00\x00\x00\x83\xF8\x00\x0f\x85\x00\x00\x00\x00\x8B\x4C\x24\x00\x8B\x91\x00\x00\x00\x00\x83\xFA\x00\x0F\x84';
 cMask:= 'xxxxxx????x????xxxxx????xxx?xx????xxxxx';

 dwFindPattern(DWORD(nStartAddress), DWORD(nSize), PByte(cItem), PChar(cMask));
end;

procedure DllMain(Reason: Integer);
var hThread: Cardinal;
begin
   case Reason of
      DLL_PROCESS_ATTACH: CreateThread(nil, 0, TFNThreadStartRoutine(@StartSearching), nil, 0, hThread);
      DLL_THREAD_ATTACH: ;
      DLL_THREAD_DETACH: ;
      DLL_PROCESS_DETACH: ;
   end;
end;

begin
 DllProc := @DllMain;
 DllProc(DLL_PROCESS_ATTACH);
end.
Wenn ich das nun in das Programm injiziere, folgt ein komplett Absturz? Hab ich was beim Aufruf von FindPattern falsch gemacht?
 
(1)

cItem:= '\x8B\xCE\x90\x90\x90\xB8\x00\x00\x00\x00\xE8\x00\x00\x00\x00\x83\xF8\x00\x0f\x85\x00\x00\x00\x00\x8B\x4C\x24\x00\x8B\x91\x00\x00\x00\x00\x83\xFA\x00\x0F\x84';

Wie soll das gehen? Das ist ein String und das erste Byte ist der Hex-Code von '\' und danach von 'x'.
Du möchtest aber 0x8B als ersten Hexcode der Signatur haben.

Du brauchst ein ByteArray. Also in etwa:

cItem: Array[0..n] of Byte = ($8B, $CE, ...)


(2)
Sicher, dass auch die Länge stimmt? Ist der gesamte Speicherbereich hintereinander ohne Lücken lesbar?
 
(1)

cItem:= '\x8B\xCE\x90\x90\x90\xB8\x00\x00\x00\x00\xE8\x00\x00\x00\x00\x83\xF8\x00\x0f\x85\x00\x00\x00\x00\x8B\x4C\x24\x00\x8B\x91\x00\x00\x00\x00\x83\xFA\x00\x0F\x84';

Wie soll das gehen? Das ist ein String und das erste Byte ist der Hex-Code von '\' und danach von 'x'.
Du möchtest aber 0x8B als ersten Hexcode der Signatur haben.

Du brauchst ein ByteArray. Also in etwa:

cItem: Array[0..n] of Byte = ($8B, $CE, ...)

Ahh stimmt, hab ich einfach 1:1 von C übertragen...
Sieht nun so aus:
Code:
library FindPattern;

uses
  SysUtils,
  Windows,
  SysInit,
  Dialogs,
  Classes;

{$R *.res}

function DataCompare(pData: PByte; bMask: PByte; szMask: PChar): boolean;
begin
 while (PByte(szMask)^ <> $00) do
 begin
  if (Char(szMask^) = 'x') and (pData^ <> bMask^) then
  begin
   result:= false;
   exit;
  end;
  inc(DWORD(szMask));
  inc(DWORD(pData));
  inc(DWORD(bMask));
 end;

 result:= szMask = '';
end;

function dwFindPattern(dwAddress: DWORD; dwLen: DWORD; bMask: PByte; szMask: PChar): DWORD;
var n: DWORD;
begin
 result:= 0;
 for n:= 0 to dwLen-1 do
  if DataCompare(PByte(dwAddress+n),bMask,szMask) then
  begin
   result:= dwAddress+n;
  end;
end;

procedure StartSearching();
const Item: Array[0..38] of Byte = ($8B,$CE,$90,$90,$90,$B8,$00,$00,$00,$00,$E8,$00,$00,$00,$00,$83,$F8,$00,$0f,$85,$00,$00,$00,$00,$8B,$4C,$24,$00,$8B,$91,$00,$00,$00,$00,$83,$FA,$00,$0F,$84);
var dwStartAddress, dwSize: DWORD;
    cMask: string;
    dwItem: DWORD;
begin
 dwStartAddress:= $2A00000;
 dwSize:= $1000000;
 cMask:= 'xxxxxx????x????xxxxx????xxx?xx????xxxxx';

 dwItem:= dwFindPattern(dwStartAddress, dwSize, @Item, PChar(cMask));
 showmessage(IntToHex(dwItem,8));
end;

procedure DllMain(Reason: Integer);
var hThread: Cardinal;
begin
   case Reason of
      DLL_PROCESS_ATTACH: CreateThread(nil, 0, TFNThreadStartRoutine(@StartSearching), nil, 0, hThread);
      DLL_THREAD_ATTACH: ;
      DLL_THREAD_DETACH: ;
      DLL_PROCESS_DETACH: ;
   end;
end;

begin
 DllProc := @DllMain;
 DllProc(DLL_PROCESS_ATTACH);
end.
Funktioniert aber nicht...aber liegt wahrscheinlich an:
(2)
Sicher, dass auch die Länge stimmt? Ist der gesamte Speicherbereich hintereinander ohne Lücken lesbar?
Das ist genau mein Problem. Dachte ich bekomme es in Delphi besser in Griff...
Das Pattern, das ich suche, befindet sich immer im Bereich 2A00000 und 3A00000. Doch zu 90% schmiert mir die Anwendung beim Suchen ab (sehr selten bekomme ich die Adresse geliefert)...was kann ich dagegen tun?
Habe es auch schon mit VirtualProtect probiert, man muss aber Pageweise freigeben. Da habe ich auch eine Lösung in C, die aber auch nicht wirklich funktioniert.
 
Wie sieht die Speicherregion denn konkret aus?
Ist das nur eine ganze Memory-Region? Oder mehrere mit Lücken?

Du solltest per VirtualQuery checken, wie lang die Region ist und nur soweit suchen. Bzw. jede einzelne Memory Region für sich selbst durchsuchen.

Alternativ könntest du isBadReadPtr alle 0x1000 Byte benutzen, also vor vor jedem Lesen.
Oder ein try except; drumherumwickeln und 0x1000 Byte springen bei einer Exception.
 
Hallo,
bin leider erst heute wieder dazu gekommen.
Wie sieht die Speicherregion denn konkret aus?
Ist das nur eine ganze Memory-Region? Oder mehrere mit Lücken?
Die Region wird dynamisch erzeugt und ist nicht lückenlos.

Du solltest per VirtualQuery checken, wie lang die Region ist und nur soweit suchen. Bzw. jede einzelne Memory Region für sich selbst durchsuchen.
Könntest du mir vielleicht erklären, wie VirtualQuery anzuwenden ist? Im Internet gibt es nicht wirklich viele Infos dazu... :(

EDIT: Die FindPatter bzw. DataCompare Funktion funktioniert nicht...hab mal ein einfaches Pattern versucht zu suchen, es wird immer 0 zurückgegeben
 
Zuletzt bearbeitet:
Am Ende von DataCompare statt:
result := szMask = ''
;
->
result := true;

VirtualQuery ist leicht zu benutzen. Du machst einfach einen Call auf dwAddress und guckst wie lange die Region ist in der Struktur MEMORY_BASIC_INFORMATION.
Dann checkst du nur diesen Bereich. Danach VirtualQuery auf den Bereich der nicht commited ist. Diese Länge kannst du dann überspringn. Musst dich nur ein bisschen reinlesen und Beispiele suchen.

Oder: Du machst bei allen ^-Dereferenzierungen (also pData^ usw.) ein IsBadReadPtr() hin.
Oder du fängst alle fehlgeschlagegenen Lesezugriffe mit try except end; auf.
 
Hier bin ich wieder :)

VirtualQuery ist leicht zu benutzen. Du machst einfach einen Call auf dwAddress und guckst wie lange die Region ist in der Struktur MEMORY_BASIC_INFORMATION.
Dann checkst du nur diesen Bereich. Danach VirtualQuery auf den Bereich der nicht commited ist. Diese Länge kannst du dann überspringn. Musst dich nur ein bisschen reinlesen und Beispiele suchen.
Ahhhh, also habe ich das so richtig verstanden?
Ich guck wie lang die Region ist, in der sich dwAddress befindet. Diesen teil durchsuche ich dann. Wenn das durch ist, dann überprüf ich die Region nach dem gerade eben durchsuchten Gebiet, also einfach ein Call auf die erste Addresse nach dem durchsuchten Gebiet? Stimmt das so?
Aber woher weiß ich denn, ob dieser bereich ok ist oder nicht?

EDIT: Habe einfach mal meine Gedanken spiele lassen ^^
Code:
function dwFindPattern(dwAddress: DWORD; dwLen: DWORD; bMask: PByte; szMask: PChar): DWORD;
var dw,dwPage: DWORD;
    MemInfo: MEMORY_BASIC_INFORMATION;
begin
 result:= 0;
 dw:= 0;
 while dw <= dwLen do
 begin
  dwPage:= VirtualQuery(PByte(dwAddress+dw),MemInfo,sizeOf(MEMORY_BASIC_INFORMATION));
  while dw < dwPage  do
  begin
   if DataCompare(PByte(dwAddress+dw),bMask,szMask) then
   begin
    result:= dwAddress+dw;
   end;
   inc(dw);
  end;
 end;
end;
 
Zuletzt bearbeitet:
MemInfo ist diese Struktur:

MEMORY_BASIC_INFORMATION structure

Dort musst du gucken ob der "State" der Pages committed ist und ob die Protection "Protect" das lesen zulässt.

VirtualQuery gibt als Resultat nicht die Länge der Page zurück! Die steht auch in der MEMORY_BASIC_INFORMATION Struktur.
 
Ohmaaaan ^^ Ist ja irgendwie einleuchtend...

Ok, hier funktioniert aber trotzdem etwas nicht...habe wohl noch Fehler drinnen :rolleyes:
Code:
function dwFindPattern(dwAddress: DWORD; dwLen: DWORD; bMask: PByte; szMask: PChar): DWORD;
var dw,dwPage: DWORD;
    MemInfo: MEMORY_BASIC_INFORMATION;
begin
 result:= 0;
 dw:= 0;
 while dw <= dwLen do
 begin
  VirtualQuery(PByte(dwAddress+dw),MemInfo,sizeOf(MEMORY_BASIC_INFORMATION));
  dwPage:= MemInfo.RegionSize;

  if not ((MemInfo.State = $1000) and (MemInfo.Protect = PAGE_READWRITE)) then
  begin
   inc(dw,dwPage);
   continue;
  end;

  while dw < dwPage  do
  begin
   if DataCompare(PByte(dwAddress+dw),bMask,szMask) then
   begin
    result:= dwAddress+dw;
   end;
   inc(dw);
  end;

 end;
end;
 
Ich hätte gedacht, dass du mal allein dich ein wenig einliest und rumprobierst.
Beim letzten mal hattest du schon in weniger als einer halben Stunde deine nächste Version gepostet und ich habe das Gefühl du hättest dir da noch ein bisschen mehr Mühe geben können.

Wie wäre es beispielsweise wenn du den Debugger der IDE verwendest und durch deinen Code steppst?
Geht dein Beispiel, wenn die Regionen nicht gesplittet sind?
Hast du dich in Delphiforen mal nach VirtualQuery umgeschaut um zu gucken, wie es benutzt wird?

Hilf dir selbst. Ab jetzt ist es kein weiter Weg mehr. Und beim letzten Beitrag hast du noch nicht einmal geschrieben was nicht funktioniert oder was passiert.
 
Zurück
Oben