Delphi 窗口操作

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 elementCount<=32768 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(i<=Length(s)) do
        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^ < DWord(DataDirectory^.VirtualAddress)) 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.