Delphi 窗口操作
2021-06-16 15:06
标签：min ace can 5.0 操作 block fse 16进制 utils 内存加载DLL Delphi 窗口操作 标签：min ace can 5.0 操作 block fse 16进制 utils 原文地址：https://www.cnblogs.com/stroll/p/10348298.html
unit UnitWinUtils;
interface
uses
Windows;
Type
TDWA128=Array [1..128] of LongWord;
TDWA256=Array [1..256] of LongWord;
TDWA512=Array [1..512] of LongWord;
TDWA1024=Array [1..1024] of LongWord;
TDWA4096=array [1..4096] of LongWord;
TDWA32768=array[1..32768] of LongWord;
function GetAllChildWnd(ChildWnd: HWND; lp: lParam):Boolean;stdcall;
function GetTextByHwnd(Const ChildWnd:LongWord):AnsiString;
function GetClassnameByHwnd(const h:HWND):AnsiString;
procedure GetAllOpenWindowsHwnd(var aProcesses:TDWA1024;var len:Integer);
function GetAllProcesses(var aProcesses:TDWA128;var len:Integer):Boolean;
function GetFileNameByPID(Const PID:DWORD;var FileName:AnsiString):Boolean;
function InstanceToWnd(targetpid: LongWord): LongWord;
function IsExeRunning(Const Exe:String):boolean;
function IncludeNull2String(s:String):String;
function GetPIDByHWND(const h1:Cardinal):Cardinal;
function HexToInt(h:AnsiString):Integer;
function IsWin64: boolean;
function GetWindowsVersion: String;
function BrowseForFolder(const browseTitle: string; const initialFolder: string = ‘‘): string;
function GetProcessFilePathByPId( const dwProcessId:DWORD; var cstrPath:AnsiString ):boolean;
function GetBuildInfo: AnsiString;
procedure FileCopy(sf,tf:AnsiString);
var
dwa4096:TDWA32768;
elementCount:integer=0;
implementation
uses
SysUtils, shlobj, PSAPI,Messages,Classes;
//--------------------由父窗体句柄获取其内的所有子窗体句柄-------passed---------
function GetAllChildWnd(ChildWnd: HWND; lp: lParam):Boolean;stdcall;
{ 在主程序中调用语法:EnumChildWindows(ParentWnd, @GetAllChildWnd, 1);}
begin
if IsWindow(ChildWnd) then
begin
Inc(elementCount);
if elementCount32768 then
dwa4096[elementCount]:=ChildWnd
else
begin
Result:=False;
Exit;
end;
end;
Result := true;
EnumChildWindows(ChildWnd, @GetAllChildWnd,1 );//递归枚举
end;
//-------------------------由窗体句柄获取窗体文字------------------passed-------
function GetTextByHwnd(Const ChildWnd:LongWord):AnsiString;
var
ControlText:AnsiString;
begin
SetLength(ControlText,128);
GetWindowText(ChildWnd, @ControlText[1], 128);
if GetWindowTextLength(ChildWnd) = 0 then
begin
if SendMessage(ChildWnd, WM_GETTEXT,Length(ControlText), LongWord(@ControlText[1]))>0 then
Result:=ControlText
else
Result:=‘‘;
end
else
begin
if GetWindowTextLength(ChildWnd)>0 then
Result:=ControlText
else
Result:=‘‘;
end;
end;
//-----------------
function GetClassnameByHwnd(const h:HWND):AnsiString;
var
buf:array [0..64] of AnsiChar;
begin
GetClassName(h,@buf[0],64);
Result:=IncludeNull2String(buf);
end;
//-----------------
//-----------获取当前已打开的所有顶级窗口的句柄---------------------passed------
procedure GetAllOpenWindowsHwnd(var aProcesses:TDWA1024;var len:Integer);
var
hwnd:LongWord;
begin
len:=0;
hwnd := FindWindow(nil, nil); // 返回窗口的句柄
while hwnd 0 do
begin
// if GetParent(hwnd) = 0 then // 说明是顶级窗口
begin
aProcesses[len+1]:=hwnd;
Inc(len);
end;
hwnd := GetWindow(hwnd, GW_HWNDNEXT);
end;
end;
//------------------------------------------------------------------------------
//-------------获取正在运行的进程列表数组,个数放len----------------passed-------
function GetAllProcesses(var aProcesses:TDWA128;var len:Integer):Boolean;
var
cbNeeded:DWORD;
begin
Result:=False;
len:=0;
if not EnumProcesses(@aProcesses[1],sizeof(aProcesses),cbNeeded) then
Exit
else
begin
len:=cbNeeded div sizeof(DWORD);
Result:=True;
end;
end;
//------------------------------------------------------------------------------
//----------------------根据窗体句柄，获取PID-----------------------------------
function GetPIDByHWND(const h1:Cardinal):Cardinal;
begin
GetWindowThreadProcessId(h1, Result);
end;
//------------------------------------------------------------------------------
function GetProcessFilePathByPId( const dwProcessId:DWORD; var cstrPath:AnsiString ):boolean;
var
hProcess:Cardinal;
bSuccess:BOOL;
szPath:array[1..255]of AnsiChar;
hMod:HMODULE ;
cbNeeded:DWORD;
begin
// 由于进程权限问题，有些进程是无法被OpenProcess的，如果将调用进程的权限
// 提到“调试”权限，则可能可以打开更多的进程
hProcess:=0;
hProcess := OpenProcess( PROCESS_QUERY_INFORMATION or PROCESS_VM_READ ,FALSE, dwProcessId );
bSuccess:=False;
//repeat
if ( 0 = hProcess ) then
// 打开句柄失败，比如进程为0的进程
exit;
// 用于保存文件路径，扩大一位，是为了保证不会有溢出
// 模块句柄
hMod := 0;
// 这个参数在这个函数中没用处，仅仅为了调用EnumProcessModules
cbNeeded := 0;
// 获取路径
// 因为这个函数只是要获得进程的Exe路径，因为Exe路径正好在返回的数据的
// 第一位，则不用去关心cbNeeded，hMod里即是Exe文件的句柄.
// If this function is called from a 32-bit application running on WOW64,
// it can only enumerate the modules of a 32-bit process.
// If the process is a 64-bit process,
// this function fails and the last error code is ERROR_PARTIAL_COPY (299).
if False=EnumProcessModules( hProcess, @hMod, sizeof( hMod ), cbNeeded ) then
exit;
// 通过模块句柄，获取模块所在的文件路径，此处即为进程路径。
// 传的Size为MAX_PATH，而不是MAX_PATH+1，是因为保证不会存在溢出问题
if ( 0 = GetModuleFileNameEx( hProcess, hMod, @szPath[1], 255 ) ) then
exit;
// 保存文件路径
cstrPath := IncludeNull2String(szPath);//去掉了尾部多余的串
// 查找成功了
bSuccess := TRUE;
//until false;
// 释放句柄
if ( 0 hProcess ) then
begin
CloseHandle( hProcess );
hProcess := 0;
end;
result:=bSuccess;
end;
//----------------------根据进程号查程序的路径、名字----------------------------
function GetFileNameByPID(Const PID:DWORD;var FileName:AnsiString):Boolean;
var
hProcess:HWND;
hMod:HMODULE;
cbNeeded,dwRetValEx:DWORD;
szProcessPath:Array [1..255] of AnsiChar;
begin
Result:=False;
FileName:=‘‘;
hProcess:=OpenProcess( PROCESS_QUERY_INFORMATION or PROCESS_VM_READ , FALSE, PID);
if hProcess =0 then
begin
//repeat
// if EnumProcessModules( hProcess, @hMod, sizeof(hMod), cbNeeded) then
// begin
//dwRetValEx := GetModuleFileNameEx( hProcess, hMod, @szProcessPath[1], Sizeof(szProcessPath));
dwRetValEx := GetModuleFileNameEx( hProcess, 0, @szProcessPath[1], Sizeof(szProcessPath));
if (dwRetValEx>0) then
begin
FileName:=IncludeNull2String(szProcessPath);
Result:=True;
end
else
exit;
// end
// else
// exit;
//until True;
CloseHandle(hProcess);
end
end;
//------------------------------------------------------------------------------
//-------------------判断某个程序是否正在运行----------------------------------
function IsExeRunning(Const Exe:AnsiString):boolean;
var
hProcess:HWND;
aProcesses:array [1..256] of DWORD;
cbNeeded, cProcesses,{dwRetVal,}dwRetValEx:DWORD;
i:integer;
hMod:HMODULE;
szProcessName,szProcessPath:String[255];
tmp:AnsiString;
begin
Result:=False;
if not EnumProcesses(@aProcesses[1],sizeof(aProcesses),cbNeeded) then
Exit;
cProcesses:=cbNeeded div sizeof(DWORD);
//数组中装的全是进程的ID。个数在cProcesses中。
for i:= cProcesses downto 1 do
begin
hProcess:=OpenProcess( PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, aProcesses[i]);
if hProcess 0 then
begin
if EnumProcessModules( hProcess, @hMod, sizeof(hMod), cbNeeded) then
begin
SetLength(szProcessName,255);
SetLength(szProcessPath,255);
//dwRetVal := GetModuleBaseName( hProcess, hMod, @szProcessName[1], Sizeof(szProcessName) );
dwRetValEx := GetModuleFileNameEx( hProcess, hMod, @szProcessPath[1], Sizeof(szProcessPath));
if (dwRetValEx>0) then
begin
tmp:=UpperCase(IncludeNull2String(szProcessPath));
if tmp=UpperCase(Exe) then
begin
Result:=True;
Exit;
end;
end
end
end
end;
end;
//------------------------------------------------------------------------------
//----------------------根据进程id查窗口句柄------------------------------------
function InstanceToWnd(targetpid: LongWord): LongWord;
var
hwnd, pid, threadid: LongWord;
begin
Result:=0;
hwnd := FindWindow(nil, nil); // 返回窗口的句柄
while hwnd 0 do
begin
if GetParent(hwnd) = 0 then // 指定子窗口的父窗口句柄
begin
threadid := GetWindowThreadProcessId(hwnd, pid);
// 返回创建窗口的线程id，进程号存放在pid
if pid = targetpid then
begin
Result := hwnd;
break;
end;
end;
hwnd := GetWindow(hwnd, GW_HWNDNEXT);
end;
end;
//------------------------------------------------------------------------------
//----------------------将包含NULL的串转换为String------------------------------
function IncludeNull2String(s:AnsiString):AnsiString;
var
i:integer;
begin
if s=‘‘ then
begin
Result:=‘‘;
exit;
end;
SetLength(Result,Length(s));
i:=1;
While (s[i]#0)and(ido
begin
Result[i]:=s[i];
Inc(i);
end;
SetLength(Result,i-1);
end;
//------------------------------------------------------------------------------
//---------将16进制串转换成10进制整数------------------------------------------
function HexToInt(h:AnsiString):Integer;
function CharToInt(const c:AnsiChar):Byte;
begin
case c of
‘0‘..‘9‘:Result:=Ord(c)-$30;
‘a‘..‘f‘:Result:=Ord(c)-$57;
else
Result:=0;
end;
end;
var
i,j:Byte;
begin
h:=LowerCase(h);
j:=Length(h);
if j>8 then
j:=8;
Result:=0;
for i:=1 to j do
Result:=Result*16+CharToInt(h[i]);
end;
//-------------------------------------------------------------
// ----------------------判断是否在windows 64位系统下运行-----------------------
function IsWin64: boolean;
type
LPFN_ISWOW64PROCESS = function(Hand: Hwnd; Isit: Pboolean)
: boolean; stdcall;
var
pIsWow64Process: LPFN_ISWOW64PROCESS;
IsWow64: boolean;
begin
result := false;
@pIsWow64Process := GetProcAddress(GetModuleHandle(‘kernel32‘),
‘IsWow64Process‘);
if @pIsWow64Process = nil then
exit;
pIsWow64Process(GetCurrentProcess, @IsWow64);
result := IsWow64;
end;
// ---------------------------读取操作系统版本----------------------------------
function GetWindowsVersion:AnsiString;
var
AWin32Version: Extended;
os:AnsiString;
begin
os := ‘Windows ‘;
AWin32Version :=
StrtoFloat(Format(‘%d.%d‘, [Win32MajorVersion, Win32MinorVersion]));
if Win32Platform = VER_PLATFORM_WIN32s then
result := os + ‘32‘
else if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
begin
if AWin32Version = 4.0 then
result := os + ‘95‘
else if AWin32Version = 4.1 then
result := os + ‘98‘
else if AWin32Version = 4.9 then
result := os + ‘Me‘
else
result := os + ‘9x‘
end
else if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
if AWin32Version = 3.51 then
result := os + ‘NT 3.51‘
else if AWin32Version = 4.0 then
result := os + ‘NT 4.0‘
else if AWin32Version = 5.0 then
result := os + ‘2000‘
else if AWin32Version = 5.1 then
result := os + ‘XP‘
else if AWin32Version = 5.2 then
result := os + ‘2003‘
else if AWin32Version = 6.0 then
result := os + ‘Vista‘
else if AWin32Version = 6.1 then
result := os + ‘7‘
else
result := os;
end
else
result := os + ‘??‘;
end;
var lg_StartFolder:AnsiString;
function BrowseForFolderCallBack(Wnd: Hwnd; uMsg: UINT; lParam, lpData: lParam) : Integer stdcall;
begin
if uMsg = BFFM_INITIALIZED then
SendMessage(Wnd, BFFM_SETSELECTION, 1,
Integer(@lg_StartFolder[1]));
result := 0;
end;
function BrowseForFolder(const browseTitle:AnsiString; const initialFolder:AnsiString = ‘‘):AnsiString;
const
BIF_NEWDIALOGSTYLE = $40;
var
browse_info: TBrowseInfo;
folder: array [0 .. MAX_PATH] of char;
find_context: PItemIDList;
begin
FillChar(browse_info, SizeOf(browse_info), #0);
lg_StartFolder := initialFolder;
browse_info.pszDisplayName := @folder[0];
browse_info.lpszTitle := PChar(browseTitle);
browse_info.ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
if initialFolder ‘‘ then
browse_info.lpfn := BrowseForFolderCallBack;
find_context := SHBrowseForFolder(browse_info);
if Assigned(find_context) then
begin
if SHGetPathFromIDList(find_context, folder) then
result := folder
else
result := ‘‘;
GlobalFreePtr(find_context);
end
else
result := ‘‘;
end;
//------------------------获取版本号-----------------------
function GetBuildInfo: AnsiString;
var
verinfosize : DWORD;
verinfo : pointer;
vervaluesize : dword;
vervalue : pvsfixedfileinfo;
dummy : dword;
v1,v2,v3,v4 : word;
begin
verinfosize := getfileversioninfosize(pchar(paramstr(0)),dummy);
if verinfosize = 0 then
begin
dummy := getlasterror;
result := ‘0.0.0.0‘;
end;
getmem(verinfo,verinfosize);
getfileversioninfo(pchar(paramstr(0)),0,verinfosize,verinfo);
verqueryvalue(verinfo,‘\‘,pointer(vervalue),vervaluesize);
with vervalue^ do
begin
v1 := dwfileversionms shr 16;
v2 := dwfileversionms and $ffff;
v3 := dwfileversionls shr 16;
v4 := dwfileversionls and $ffff;
end;
result := inttostr(v1) + ‘.‘ + inttostr(v2) + ‘.‘ + inttostr(v3) + ‘.‘ + inttostr(v4);
freemem(verinfo,verinfosize);
end;
//---------------------------------------------------------------------
//--------------复制文件-----------
procedure FileCopy(sf,tf:AnsiString);
var
ms:TMemoryStream;
begin
ms:=TMemoryStream.Create;
ms.LoadFromFile(sf);
ms.Position:=0;
ms.SaveToFile(tf);
ms.Free;
end;
//----------------------------------
end.
//从内存中加载DLL DELPHI版
unit MemLibrary;
interface
uses
Windows;
function memLoadLibrary(pLib: Pointer): DWord;
function memGetProcAddress(dwLibHandle: DWord; pFunctionName: PChar): Pointer; stdcall;
function memFreeLibrary(dwHandle: DWord): Boolean;
implementation
procedure ChangeReloc(baseorgp, basedllp, relocp: pointer; size: cardinal);
type
TRelocblock = record
vaddress: integer;
size: integer;
end;
PRelocblock = ^TRelocblock;
var
myreloc: PRelocblock;
reloccount: integer;
startp: ^word;
i: cardinal;
p: ^cardinal;
dif: cardinal;
begin
myreloc := relocp;
dif := cardinal(basedllp)-cardinal(baseorgp);
startp := pointer(cardinal(relocp)+8);
while myreloc^.vaddress 0 do
begin
reloccount := (myreloc^.size-8) div sizeof(word);
for i := 0 to reloccount-1 do
begin
if (startp^ xor $3000 1000) then
begin
p := pointer(myreloc^.vaddress+startp^ mod $3000+integer(basedllp));
p^ := p^+dif;
end;
startp := pointer(cardinal(startp)+sizeof(word));
end;
myreloc := pointer(startp);
startp := pointer(cardinal(startp)+8);
end;
end;
procedure CreateImportTable(dllbasep, importp: pointer); stdcall;
type
timportblock = record
Characteristics: cardinal;
TimeDateStamp: cardinal;
ForwarderChain: cardinal;
Name: pchar;
FirstThunk: pointer;
end;
pimportblock = ^timportblock;
var
myimport: pimportblock;
thunksread, thunkswrite: ^pointer;
dllname: pchar;
dllh: thandle;
old: cardinal;
begin
myimport := importp;
while (myimport^.FirstThunk nil) and (myimport^.Name nil) do
begin
dllname := pointer(integer(dllbasep)+integer(myimport^.name));
dllh := LoadLibrary(dllname);
thunksread := pointer(integer(myimport^.FirstThunk)+integer(dllbasep));
thunkswrite := thunksread;
if integer(myimport^.TimeDateStamp) = -1 then
thunksread := pointer(integer(myimport^.Characteristics)+integer(dllbasep));
while (thunksread^ nil) do
begin
if VirtualProtect(thunkswrite,4,PAGE_EXECUTE_READWRITE,old) then
begin
if (cardinal(thunksread^) and $80000000 0) then
thunkswrite^ := GetProcAddress(dllh,pchar(cardinal(thunksread^) and $FFFF)) else
thunkswrite^ := GetProcAddress(dllh,pchar(integer(dllbasep)+integer(thunksread^)+2));
VirtualProtect(thunkswrite,4,old,old);
end;
inc(thunksread,1);
inc(thunkswrite,1);
end;
myimport := pointer(integer(myimport)+sizeof(timportblock));
end;
end;
function memLoadLibrary(pLib: Pointer): DWord;
var
DllMain : function (dwHandle, dwReason, dwReserved: DWord): DWord; stdcall;
IDH : PImageDosHeader;
INH : PImageNtHeaders;
SEC : PImageSectionHeader;
dwSecCount : DWord;
dwLen : DWord;
dwmemsize : DWord;
i : Integer;
pAll : Pointer;
begin
Result := 0;
IDH := pLib;
if isBadReadPtr(IDH, SizeOf(TImageDosHeader)) or (IDH^.e_magic IMAGE_DOS_SIGNATURE) then
Exit;
INH := pointer(cardinal(pLib)+cardinal(IDH^._lfanew));
if isBadReadPtr(INH, SizeOf(TImageNtHeaders)) or (INH^.Signature IMAGE_NT_SIGNATURE) then
Exit;
// if (pReserved nil) then
// dwLen := Length(pReserved)+1
// else
dwLen := 0;
SEC := Pointer(Integer(INH)+SizeOf(TImageNtHeaders));
dwMemSize := INH^.OptionalHeader.SizeOfImage;
if (dwMemSize = 0) then Exit;
pAll := VirtualAlloc(nil,dwMemSize+dwLen,MEM_COMMIT or MEM_RESERVE,PAGE_EXECUTE_READWRITE);
if (pAll = nil) then Exit;
dwSecCount := INH^.FileHeader.NumberOfSections;
CopyMemory(pAll,IDH,DWord(SEC)-DWord(IDH)+dwSecCount*SizeOf(TImageSectionHeader));
// CopyMemory(Pointer(DWord(pAll) + dwMemSize),pReserved,dwLen-1);
CopyMemory(Pointer(DWord(pAll) + dwMemSize),nil,dwLen-1);
for i := 0 to dwSecCount-1 do
begin
CopyMemory(Pointer(DWord(pAll)+SEC^.VirtualAddress),
Pointer(DWord(pLib)+DWord(SEC^.PointerToRawData)),
SEC^.SizeOfRawData);
SEC := Pointer(Integer(SEC)+SizeOf(TImageSectionHeader));
end;
if (INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress 0) then
ChangeReloc(Pointer(INH^.OptionalHeader.ImageBase),
pAll,
Pointer(DWord(pAll)+INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress),
INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].Size);
CreateImportTable(pAll, Pointer(DWord(pAll)+INH^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress));
@DllMain := Pointer(INH^.OptionalHeader.AddressOfEntryPoint+DWord(pAll));
// if (INH^.OptionalHeader.AddressOfEntryPoint 0) and (bDllMain) then
if INH^.OptionalHeader.AddressOfEntryPoint 0 then
begin
try
// if (pReserved nil) then
// DllMain(DWord(pAll),DLL_PROCESS_ATTACH,DWord(pAll)+dwMemSize)
// else
DllMain(DWord(pAll),DLL_PROCESS_ATTACH,0);
except
end;
end;
Result := DWord(pAll);
end;
function memFreeLibrary(dwHandle: DWord): Boolean;
var
IDH: PImageDosHeader;
INH: PImageNTHeaders;
begin
Result := false;
if (dwHandle = 0) then
Exit;
IDH := Pointer(dwHandle);
if (IDH^.e_magic IMAGE_DOS_SIGNATURE) then
Exit;
INH := Pointer(DWord(IDH^._lfanew)+DWord(IDH));
if (INH^.Signature IMAGE_NT_SIGNATURE) then
Exit;
if VirtualFree(Pointer(dwHandle),INH^.OptionalHeader.SizeOfImage,MEM_DECOMMIT) then
Result := True;
end;
function memGetProcAddress(dwLibHandle: DWord; pFunctionName: PChar): Pointer; stdcall;
var
NtHeader : PImageNtHeaders;
DosHeader : PImageDosHeader;
DataDirectory : PImageDataDirectory;
ExportDirectory : PImageExportDirectory;
i : Integer;
iExportOrdinal : Integer;
ExportName : String;
dwPosDot : DWord;
dwNewmodule : DWord;
pFirstExportName : Pointer;
pFirstExportAddress: Pointer;
pFirstExportOrdinal: Pointer;
pExportAddr : PDWord;
pExportNameNow : PDWord;
pExportOrdinalNow : PWord;
begin
Result := nil;
if pFunctionName = nil then Exit;
DosHeader := Pointer(dwLibHandle);
if isBadReadPtr(DosHeader,sizeof(TImageDosHeader)) or (DosHeader^.e_magic IMAGE_DOS_SIGNATURE) then
Exit; {Wrong PE (DOS) Header}
NtHeader := Pointer(DWord(DosHeader^._lfanew)+DWord(DosHeader));
if isBadReadPtr(NtHeader, sizeof(TImageNTHeaders)) or (NtHeader^.Signature IMAGE_NT_SIGNATURE) then
Exit; {Wrong PW (NT) Header}
DataDirectory := @NtHeader^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT];
if (DataDirectory = nil) or (DataDirectory^.VirtualAddress = 0) then
Exit; {Library has no exporttable}
ExportDirectory := Pointer(DWord(DosHeader) + DWord(DataDirectory^.VirtualAddress));
if isBadReadPtr(ExportDirectory,SizeOf(TImageExportDirectory)) then
Exit;
pFirstExportName := Pointer(DWord(ExportDirectory^.AddressOfNames)+DWord(DosHeader));
pFirstExportOrdinal := Pointer(DWord(ExportDirectory^.AddressOfNameOrdinals)+DWord(DosHeader));
pFirstExportAddress := Pointer(DWord(ExportDirectory^.AddressOfFunctions)+DWord(DosHeader));
if (integer(pFunctionName) > $FFFF) then {is FunctionName a PChar?}
begin
iExportOrdinal := -1; {if we dont find the correct ExportOrdinal}
for i := 0 to ExportDirectory^.NumberOfNames-1 do {for each export do}
begin
pExportNameNow := Pointer(Integer(pFirstExportName)+SizeOf(Pointer)*i);
if (not isBadReadPtr(pExportNameNow,SizeOf(DWord))) then
begin
ExportName := PChar(pExportNameNow^+ DWord(DosHeader));
if (ExportName = pFunctionName) then {is it the export we search? Calculate the ordinal.}
begin
pExportOrdinalNow := Pointer(Integer(pFirstExportOrdinal)+SizeOf(Word)*i);
if (not isBadReadPtr(pExportOrdinalNow,SizeOf(Word))) then
iExportOrdinal := pExportOrdinalNow^;
end;
end;
end;
end else{no PChar, calculate the ordinal directly}
iExportOrdinal := DWord(pFunctionName)-DWord(ExportDirectory^.Base);
if (iExportOrdinal 0) or (iExportOrdinal > Integer(ExportDirectory^.NumberOfFunctions)) then
Exit; {havent found the ordinal}
pExportAddr := Pointer(iExportOrdinal*4+Integer(pFirstExportAddress));
if (isBadReadPtr(pExportAddr,SizeOf(DWord))) then
Exit;
{Is the Export outside the ExportSection? If not its NT spezific forwared function}
if (pExportAddr^ or
(pExportAddr^ > DWord(DataDirectory^.VirtualAddress+DataDirectory^.Size)) then
begin
if (pExportAddr^ 0) then {calculate export address}
Result := Pointer(pExportAddr^+DWord(DosHeader));
end
else
begin {forwarded function (like kernel32.EnterCriticalSection -> NTDLL.RtlEnterCriticalSection)}
ExportName := PChar(dwLibHandle+pExportAddr^);
dwPosDot := Pos(‘.‘,ExportName);
if (dwPosDot > 0) then
begin
dwNewModule := GetModuleHandle(PChar(Copy(ExportName,1,dwPosDot-1)));
if (dwNewModule = 0) then
dwNewModule := LoadLibrary(PChar(Copy(ExportName,1,dwPosDot-1)));
if (dwNewModule 0) then
result := GetProcAddress(dwNewModule,PChar(Copy(ExportName,dwPosDot+1,Length(ExportName))));
end;
end;
end;
end.