mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-09 11:18:40 +02:00
186 lines
5.1 KiB
PHP
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;
|