procedure IsCorrectExecuteSection(dlln,processname:
string);
function CompareSection(p1,p2: pointer; orig1, orig2: integer; size: integer): boolean;
var i, err: integer;
begin
result := true;
for i := 0
to size-1
do
pbyte(integer(p2)+i)^ := pbyte(integer(p2)+i)^-pbyte(integer(p1)+i)^;
err := 0;
for i := 0
to size-1
do
if pbyte(integer(p2)+i)^ <> 0
then
inc(err);
if err > 4
then // error konstante, 4 bytes sind immer unterschiedlich in der openglcode section
result := false;
// einbau unterschiedlichen dllbasen noch nicht eingebaut
// aber durch orig1,orig2 möglich
end;
function CompareExecuteSections(p1,p2: pointer; orig1,orig2: integer): boolean;
var IDH1, IDH2: PImageDosHeader;
INH1, INH2: PImageNtHeaders;
sectionh1, sectionh2: PImageSectionHeader;
seca1, seca2, i: integer;
begin
result := true;
IDH1 := p1;
IDH2 := p2;
if (IDH1^.e_magic = IMAGE_DOS_SIGNATURE)
and (IDH2^.e_magic = IMAGE_DOS_SIGNATURE)
then
begin
INH1 := pointer(integer(p1)+integer(IDH1^._lfanew));
INH2 := pointer(integer(p2)+integer(IDH2^._lfanew));
if (INH1^.Signature = IMAGE_NT_SIGNATURE)
and (INH2^.Signature = IMAGE_NT_SIGNATURE)
then
begin
seca1 := INH1^.FileHeader.NumberOfSections;
seca2 := INH2^.FileHeader.NumberOfSections;
if (seca1 <> seca2)
then
MessageBox(0,'
sectioncount is not correct',
nil,0)
else
begin
for i := 0
to seca1-1
do
begin
sectionh1 := pointer(pointer(integer(INH1)+integer(sizeof(TImageNtHeaders))+i*sizeof(TImageSectionHeader)));
sectionh2 := pointer(pointer(integer(INH2)+integer(sizeof(TImageNtHeaders))+i*sizeof(TImageSectionHeader)));
if (sectionh1^.VirtualAddress <> sectionh2^.VirtualAddress)
then
MessageBox(0,'
section pointer is not correct',
nil,0)
else
if (sectionh2^.Misc.VirtualSize <> sectionh2^.Misc.VirtualSize)
then
MessageBox(0,'
section size is not correct',
nil,0)
else
begin
if (sectionh1^.Characteristics
and $20000000) = $20000000
then
if CompareSection(pointer(integer(p1)+integer(sectionh1^.VirtualAddress)),
pointer(integer(p2)+integer(sectionh2^.VirtualAddress)),
orig1,orig2,
sectionh1^.Misc.VirtualSize) = false
then
MessageBox(0,'
not same section',
nil,0);
end;
end;
end;
end;
end;
end;
var h1,h2, pr, dllprocsize: integer;
read: cardinal;
buf, buf2: pointer;
begin
pr := uallProcess.FindProcess(processname);
if pr = 0
then
messagebox(0,'
process not loaded',
nil,0)
else
begin
h1 := LoadLibrary(pchar(dlln));
if h1 = 0
then
messagebox(0,'
cant load dll',
nil,0)
else
begin
h2 := uallProcess.GetModuleOffset(dlln,pr);
if h2 = 0
then
MessageBox(0,'
dll in process not found',
nil,0)
else
begin
buf := VirtualAlloc(
nil,$1000,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
pr := OpenProcess(PROCESS_ALL_ACCESS,false,pr);
ReadProcessMemory(pr,pointer(h2),buf,$1000,
read);
dllprocsize := uallUtil.GetModuleVirtualSize(integer(buf));
if uallUtil.GetModuleVirtualSize(h1) <> dllprocsize
then
MessageBox(0,'
other dll loaded',
nil,0)
else
begin
buf2 := VirtualAlloc(
nil,dllprocsize,MEM_COMMIT,PAGE_EXECUTE_READWRITE);
ReadProcessMemory(pr,pointer(h2),buf2,dllprocsize,
read);
if CompareExecuteSections(pointer(h1),buf2,h1,h2)
then
MessageBox(0,'
ok',
nil,0)
else
MessageBox(0,'
execute sections not same',
nil,0);
VirtualFree(buf2,dllprocsize,MEM_DECOMMIT);
end;
VirtualFree(buf,$1000,MEM_DECOMMIT);
end;
end;
FreeLibrary(h1);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IsCorrectExecuteSection('
opengl32.dll','
hl.exe');
end;