fpc/rtl/inc/elfres32.inc
2007-09-04 12:28:14 +00:00

186 lines
5.1 KiB
PHP

const
fpcres2elf_version=1;
type
TFPCResourceSectionInfo = packed record
ptr: pointer; // This always contains the absolute memory address of the section at runtime
size: longint; // The size of the section in bytes
end;
PTFPCResourceSectionInfo = ^TFPCResourceSectionInfo;
TFPCResourceSectionTable = packed record
version: longint;
resentries: longint;
ressym: TFPCResourceSectionInfo;
reshash: TFPCResourceSectionInfo;
resdata: TFPCResourceSectionInfo;
resspare: TFPCResourceSectionInfo;
resstr: TFPCResourceSectionInfo;
end;
PFPCResourceSectionTable = ^TFPCResourceSectionTable;
TFPCResourceInfo = packed record
reshash: longint; // always 32bit, contains an ELF hash of the resource entries name
restype: longint; // always 32bit, contains the resource type ID compatible with Windows RES IDs
ptr: pointer; // This contains the offset to the resource inside the resdata
// section.
name: pChar; // The byte offset to the the resource name inside the ressym section.
size: longint; // The size of the resource entry - 32/64 Bit, depending on platform
end;
PFPCResourceInfo = ^TFPCResourceInfo;
Var
{$ifdef FPC_HAS_RESOURCES}
FPCResourceSectionLocation : pFPCResourceSectionTable; external name 'FPC_RESLOCATION';
{$else}
FPCResourceSectionLocation : pFPCResourceSectionTable = Nil;
{$endif}
const
LCase: set of char = ['a'..'z'];
function HashELFUppercase(S: PChar) : longint;
{Note: this hash function is described in "Practical Algorithms For
Programmers" by Andrew Binstock and John Rex, Addison Wesley,
with modifications in Dr Dobbs Journal, April 1996}
var
G: longint;
C: Char;
begin
Result := 0;
while S^ <> #0 do begin
C := S^;
if C in LCase then Dec(ord(C), 32);
Result := (Result shl 4) + ord(C);
Inc(S);
G := Result and $F0000000;
if (G <> 0) then
Result := Result xor (G shr 24);
Result := Result and (not G);
end;
end;
Function HINSTANCE : HMODULE;
begin
Result:=0;
end;
function _StrIComp(S1, S2: PChar): LongInt;
var
C1, C2: Char;
begin
Result := 0;
repeat
C1 := S1^;
C2 := S2^;
Result := ord(C1) - ord(C2);
if Result <> 0 then
begin
if C1 in LCase then Dec(ord(C1), 32);
if C2 in LCase then Dec(ord(C2), 32);
Result := ord(C1) - ord(C2);
end;
Inc(S1);
Inc(S2);
until (Result <> 0) or ((S1^ = #0) or (S2^ = #0));
end;
function FindResource(ModuleHandle: HMODULE; ResourceName: PChar; ResourceType: PChar): TResourceHandle;
var
i:longint;
searchhash:longint;
ResEntry: PFPCResourceInfo;
pResName: PChar;
tmp: array[0..7] of char;
begin
Result:=0;
if (ResourceName=nil) or (FPCResourceSectionLocation = nil) then
Exit;
{ This is a temporary fix to stay compatible with fpcres
which currently converts all string types to RT_RCDATA. }
if ResourceType > PChar($FFFF) then
ResourceType := PChar(10);
{ support numeric resource IDs }
if ResourceName <= PChar($FFFF) then
begin
{ convert number to string inline, this should be faster than messing with strings }
i := LongInt(ResourceName);
ResourceName := @tmp[7];
ResourceName^ := #0;
Dec(ResourceName);
repeat
ResourceName^ := Char((i mod 10) + ord('0'));
Dec(ResourceName);
i := i div 10;
until i = 0;
ResourceName^ := '#';
end;
{ resources aren't case sensitive }
searchhash := HashELFUppercase(ResourceName);
ResEntry := FPCResourceSectionLocation^.reshash.ptr;
for i:=0 to FPCResourceSectionLocation^.resentries-1 do
with ResEntry[I] do
begin
if (PChar(ResType) = ResourceType) and (reshash = searchhash) then
begin
pResName := PChar(FPCResourceSectionLocation^.ressym.ptr);
Inc(pResName, PtrUInt(Name));
if _StrIComp(pResName, ResourceName) = 0 then
begin
result:=i+1;
break;
end;
end;
end;
end;
function LoadResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): HGLOBAL;
var
ResEntry: PFPCResourceInfo;
begin
if FPCResourceSectionLocation = nil then
Exit;
if (ResHandle>0) and (LongInt(ResHandle)-1<=FPCResourceSectionLocation^.resentries) then
begin
ResEntry := FPCResourceSectionLocation^.reshash.ptr;
result := HGLOBAL(PtrUInt(FPCResourceSectionLocation^.resdata.ptr) + PtrUInt(ResEntry[LongInt(ResHandle)-1].ptr));
end
else
result:=0;
end;
function SizeofResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): Integer;
var
ResEntry: PFPCResourceInfo;
begin
if FPCResourceSectionLocation = nil then
Exit;
if (ResHandle>0) and (LongInt(ResHandle)-1<=FPCResourceSectionLocation^.resentries) then
begin
ResEntry := FPCResourceSectionLocation^.reshash.ptr;
result := ResEntry[LongInt(ResHandle)-1].size;
end
else
result:=0;
end;
function LockResource(ResData: HGLOBAL): Pointer;
begin
result:=Pointer(ResData);
end;
function UnlockResource(ResData: HGLOBAL): LongBool;
begin
result:=False;
end;
function FreeResource(ResData: HGLOBAL): LongBool;
begin
result:=True;
end;