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实现在调用时直接跳过类指针来到真实的
方法地址。这种应用需要对类的方法使用过程以及汇编语言中函数调用过程熟悉才能做到。
