Delphi 设置Windows API的回调函数为类的方法

参考 SysUtils中TLanguages里面的技巧

{ This stores the languages that the system supports }

TLanguages = class

private

FSysLangs: array of TLangRec;

function LocalesCallback(LocaleID: PChar): Integer; stdcall;

function GetExt(Index: Integer): string;

function GetID(Index: Integer): string;

function GetLCID(Index: Integer): LCID;

function GetName(Index: Integer): string;

function GetNameFromLocaleID(ID: LCID): string;

function GetNameFromLCID(const ID: string): string;

function GetCount: integer;

public

constructor Create;

function IndexOf(ID: LCID): Integer;

property Count: Integer read GetCount;

property Name[Index: Integer]: string read GetName;

property NameFromLocaleID[ID: LCID]: string read GetNameFromLocaleID;

property NameFromLCID[const ID: string]: string read GetNameFromLCID;

property ID[Index: Integer]: string read GetID;

property LocaleID[Index: Integer]: LCID read GetLCID;

property Ext[Index: Integer]: string read GetExt;

end platform;

{ Called for each supported locale. }

function TLanguages.LocalesCallback(LocaleID: PChar): Integer; stdcall;

var

AID: LCID;

ShortLangName: string;

GetLocaleDataProc: function (ID: LCID; Flag: DWORD): string;

begin

if Win32Platform = VER_PLATFORM_WIN32_NT then

GetLocaleDataProc := @GetLocaleDataW

else

GetLocaleDataProc := @GetLocaleDataA;

AID := StrToInt('$' + Copy(LocaleID, 5, 4));

ShortLangName := GetLocaleDataProc(AID, LOCALE_SABBREVLANGNAME);

if ShortLangName <> '' then

begin

SetLength(FSysLangs, Length(FSysLangs) + 1);

with FSysLangs[High(FSysLangs)] do

begin

FName := GetLocaleDataProc(AID, LOCALE_SLANGUAGE);

FLCID := AID;

FExt := ShortLangName;

end;

end;

Result := 1;

end;

constructor TLanguages.Create;

type

TCallbackThunk = packed record

POPEDX: Byte;

MOVEAX: Byte;

SelfPtr: Pointer;

PUSHEAX: Byte;

PUSHEDX: Byte;

JMP: Byte;

JmpOffset: Integer;

end;

var

Callback: TCallbackThunk;

begin

inherited Create;

Callback.POPEDX := $5A;

Callback.MOVEAX := $B8;

Callback.SelfPtr := Self;

Callback.PUSHEAX := $50;

Callback.PUSHEDX := $52;

Callback.JMP := $E9;

Callback.JmpOffset := Integer(@TLanguages.LocalesCallback) - Integer(@Callback.JMP) - 5;

EnumSystemLocales(TFNLocaleEnumProc(@Callback), LCID_SUPPORTED);

end;

function TLanguages.GetCount: Integer;

begin

Result := High(FSysLangs) + 1;

end;

function TLanguages.GetExt(Index: Integer): string;

begin

Result := FSysLangs[Index].FExt;

end;

function TLanguages.GetID(Index: Integer): string;

begin

Result := HexDisplayPrefix + IntToHex(FSysLangs[Index].FLCID, 8);

end;

function TLanguages.GetLCID(Index: Integer): LCID;

begin

Result := FSysLangs[Index].FLCID;

end;

function TLanguages.GetName(Index: Integer): string;

begin

Result := FSysLangs[Index].FName;

end;

function TLanguages.GetNameFromLocaleID(ID: LCID): string;

var

Index: Integer;

begin

Index := IndexOf(ID);

if Index <> - 1 then Result := Name[Index];

if Result = '' then Result := sUnknown;

end;

function TLanguages.GetNameFromLCID(const ID: string): string;

begin

Result := NameFromLocaleID[StrToIntDef(ID, 0)];

end;

function TLanguages.IndexOf(ID: LCID): Integer;

begin

for Result := Low(FSysLangs) to High(FSysLangs) do

if FSysLangs[Result].FLCID = ID then Exit;

Result := -1;

end;

//==================================

将类的方法巧妙的变成windowsAPI的回调函数，

由于类的方法调用时隐含类指针，隐藏在调用时，这里通过一个TCallbackThunk实现在调用时直接跳过类指针来到真实的

方法地址。这种应用需要对类的方法使用过程以及汇编语言中函数调用过程熟悉才能做到。