+ Merged RTL support for resources

git-svn-id: branches/fixes_2_0@1027 -

.gitattributes

@@ -3300,6 +3300,7 @@ rtl/inc/dosh.inc svneol=native#text/plain
 rtl/inc/dynarr.inc svneol=native#text/plain
 rtl/inc/dynarrh.inc svneol=native#text/plain
 rtl/inc/dynlibs.pp svneol=native#text/plain
+rtl/inc/elfres32.inc svneol=native#text/plain
 rtl/inc/except.inc svneol=native#text/plain
 rtl/inc/fexpand.inc svneol=native#text/plain
 rtl/inc/file.inc svneol=native#text/plain
@@ -3346,6 +3347,7 @@ rtl/inc/printer.inc svneol=native#text/plain
 rtl/inc/printerh.inc svneol=native#text/plain
 rtl/inc/readme -text
 rtl/inc/real2str.inc svneol=native#text/plain
+rtl/inc/resh.inc svneol=native#text/plain
 rtl/inc/rtti.inc svneol=native#text/plain
 rtl/inc/sockets.inc svneol=native#text/plain
 rtl/inc/socketsh.inc svneol=native#text/plain
@@ -3355,6 +3357,7 @@ rtl/inc/sstrings.inc svneol=native#text/plain
 rtl/inc/stdsock.inc svneol=native#text/plain
 rtl/inc/strings.pp svneol=native#text/plain
 rtl/inc/stringsi.inc svneol=native#text/plain
+rtl/inc/sysres.inc svneol=native#text/plain
 rtl/inc/system.fpd -text
 rtl/inc/system.inc svneol=native#text/plain
 rtl/inc/systemh.inc svneol=native#text/plain
@@ -4011,6 +4014,7 @@ rtl/win32/video.pp svneol=native#text/plain
 rtl/win32/wcygprt0.as -text
 rtl/win32/wdllprt0.as -text
 rtl/win32/win32.inc svneol=native#text/plain
+rtl/win32/win32res.inc svneol=native#text/plain
 rtl/win32/wincrt.pp svneol=native#text/plain
 rtl/win32/windows.pp svneol=native#text/plain
 rtl/win32/winevent.pp svneol=native#text/plain

compiler/options.pas

@@ -1796,6 +1796,7 @@ begin
   def_system_macro('FPC_HAS_TYPE_EXTENDED');
   def_system_macro('FPC_HAS_TYPE_DOUBLE');
   def_system_macro('FPC_HAS_TYPE_SINGLE');
+  def_system_macro('FPC_HAS_RESOURCES');
 {$endif}
 {$ifdef m68k}
   def_system_macro('CPU68K');

rtl/inc/elfres32.inc

@@ -0,0 +1,160 @@
+
+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;
+
+  TFPCRuntimeResourceInfo = 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;   // Memory pointer to the reosource
+    name:    string;    // String containing the name of the resource
+    size:    longint;   // The size of the resource entry - 32/64 Bit, depending on platform
+  end;
+  PFPCRuntimeResourceInfo = ^TFPCRuntimeResourceInfo;
+
+Var
+  InitRes : Boolean = False;
+{$ifdef FPC_HAS_RESOURCES}
+  FPCResourceSectionLocation : pFPCResourceSectionTable; external name 'FPC_RESLOCATION';
+{$else}
+  FPCResourceSectionLocation : pFPCResourceSectionTable = Nil;
+{$endif}
+  FPCRuntimeResourceInfoArray : PFPCRuntimeResourceInfo;
+  ResInfoCount : Cardinal;
+
+function HashELF(const S : string) : 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;
+  i : longint;
+begin
+  Result := 0;
+  for i := 1 to length(S) do begin
+    Result := (Result shl 4) + ord(S[i]);
+    G := Result and $F0000000;
+    if (G <> 0) then
+      Result := Result xor (G shr 24);
+    Result := Result and (not G);
+  end;
+end;
+  
+procedure InitializeResources;
+
+var 
+  i:longint;
+  CurrentResource:pFPCResourceInfo;
+  
+begin
+  If (FPCResourceSectionLocation=Nil) then
+    ResInfoCount:=0
+  else  
+    ResInfoCount:=FPCResourceSectionLocation^.resentries;
+  If (ResInfoCount<>0) then
+    begin
+    FPCRuntimeResourceInfoArray:=GetMem(SizeOf(TFPCRuntimeResourceInfo)*ResInfoCount);
+    for i:=0 to ResInfoCount-1 do
+      begin
+      CurrentResource:=pFPCResourceInfo(pointer(longint(FPCResourceSectionLocation^.reshash.ptr)+i*sizeof(TFPCResourceInfo)));
+      FPCRuntimeResourceInfoArray[i].reshash:=CurrentResource^.reshash;
+      FPCRuntimeResourceInfoArray[i].restype:=CurrentResource^.restype;
+      FPCRuntimeResourceInfoArray[i].ptr:=pointer(longint(CurrentResource^.ptr)+longint(FPCResourceSectionLocation^.resdata.ptr));
+      FPCRuntimeResourceInfoArray[i].name:=pchar(pointer(longint(CurrentResource^.name)+longint(FPCResourceSectionLocation^.ressym.ptr)));
+      FPCRuntimeResourceInfoArray[i].size:=CurrentResource^.size;
+      end;
+    end;  
+  InitRes:=true;
+end;
+
+Function HINSTANCE : HMODULE;
+
+begin
+  Result:=0;
+end;
+
+function FindResource(ModuleHandle: HMODULE; ResourceName: PChar; ResourceType: PChar): TResourceHandle;
+
+var 
+  i:longint;
+  searchhash:longint;
+  n : string;
+  
+begin
+  Result:=0;
+  if (ResourceName=nil) then 
+    Exit;
+  If Not InitRes then 
+    InitializeResources;
+  searchhash:=HashELF(ResourceName);
+  n:=strpas(resourcename);
+  I:=0;
+  While (Result=0) and (I<ResInfoCount) do
+    begin
+    if (FPCRuntimeResourceInfoArray[i].reshash=searchhash) and (FPCRuntimeResourceInfoArray[i].name=n) then
+      result:=i+1;
+    Inc(I);  
+    end;
+end;
+
+function LoadResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): HGLOBAL;
+begin
+  If Not InitRes then 
+    InitializeResources;
+  if (ResHandle>0) and (ResHandle-1<=ResInfoCount) then
+    result:=HGLOBAL(FPCRuntimeResourceInfoArray[ResHandle-1].ptr)
+  else
+    result:=0;
+end;
+
+function SizeofResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): Integer;
+begin
+  If Not InitRes then 
+    InitializeResources;
+  if (ResHandle>0) and (ResHandle-1<=ResInfoCount) then
+    result:=FPCRuntimeResourceInfoArray[ResHandle-1].size
+  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;

rtl/inc/resh.inc

@@ -0,0 +1,16 @@
+type
+  TResourceHandle = Cardinal;
+  HMODULE = Cardinal;
+  HGLOBAL = Cardinal;
+      
+// Win32 API compatible Resource functions
+Function HINSTANCE : HMODULE;
+Function FindResource(ModuleHandle: HMODULE; ResourceName, ResourceType: PChar): TResourceHandle;
+Function FindResource(ModuleHandle: HMODULE; ResourceName, ResourceType: AnsiString): TResourceHandle;
+Function LoadResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): HGLOBAL;
+Function SizeofResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): Integer;
+Function LockResource(ResData: HGLOBAL): Pointer;
+Function UnlockResource(ResData: HGLOBAL): LongBool;
+Function FreeResource(ResData: HGLOBAL): LongBool;
+
+      

rtl/inc/sysres.inc

@@ -0,0 +1,41 @@
+Function HINSTANCE : HMODULE;
+
+begin
+  Result:=0;
+end;
+
+Function FindResource(ModuleHandle: HMODULE; ResourceName, ResourceType: PChar): TResourceHandle;
+
+begin
+  Result:=0;
+end;
+
+Function LoadResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): HGLOBAL;
+
+begin
+  Result:=0;
+end;
+
+Function SizeofResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): Integer;
+
+begin
+  Result:=-1;
+end;
+
+Function LockResource(ResData: HGLOBAL): Pointer;
+
+begin
+  Result:=Nil;
+end;
+
+Function UnlockResource(ResData: HGLOBAL): LongBool;
+
+begin
+  Result:=False;
+end;
+
+Function FreeResource(ResData: HGLOBAL): LongBool;
+
+begin
+  Result:=False;
+end;

rtl/inc/system.inc

@@ -1012,4 +1012,17 @@ end;
 { OS dependent dir functions }
 {$i sysdir.inc}
 
+{*****************************************************************************
+                            Resources support
+*****************************************************************************}
 
+
+{$ifndef HAS_RESOURCES}
+{$i sysres.inc}
+{$endif}
+
+Function FindResource(ModuleHandle: HMODULE; ResourceName, ResourceType: AnsiString): TResourceHandle;
+
+begin
+  Result:=FindResource(ModuleHandle,PChar(ResourceName),PChar(ResourceType));
+end;

rtl/inc/systemh.inc

@@ -672,6 +672,11 @@ const
 { Generic threadmanager }
 {$i threadh.inc}
 
+{*****************************************************************************
+                          Resources support
+*****************************************************************************}
+
+{$i resh.inc}
 
 {*****************************************************************************
                    FPDoc phony declarations.

rtl/linux/system.pp

@@ -16,11 +16,13 @@
 
 { These things are set in the makefile, }
 { But you can override them here.}
-
-
 { If you use an aout system, set the conditional AOUT}
 { $Define AOUT}
 
+{$ifdef i386}
+{$DEFINE ELFRES32}
+{$endif}
+
 Unit System;
 
 Interface
@@ -33,6 +35,12 @@ Interface
 
 Implementation
 
+{ Include ELF resources }
+
+{$ifdef ELFRES32}
+{$define HAS_RESOURCES}
+{$i elfres32.inc}
+{$endif}
 
 {$I system.inc}
 

rtl/win32/system.pp

@@ -90,7 +90,6 @@ var
 { Win32 Info }
   startupinfo : tstartupinfo;
   hprevinst,
-  HInstance,
   MainInstance,
   cmdshow     : longint;
   DLLreason,DLLparam:longint;
@@ -106,11 +105,16 @@ const
   Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
   Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
 
-type
-  HMODULE = THandle;
-
 implementation
 
+var
+  SysInstance : Longint;
+
+{$ifdef i386}
+{$define HAS_RESOURCES}
+{$i win32res.inc}
+{$endif}
+
 { used by wstrings.inc because wstrings.inc is included before sysos.inc
   this is put here (FK) }
 
@@ -1127,7 +1131,7 @@ begin
   { some misc Win32 stuff }
   hprevinst:=0;
   if not IsLibrary then
-    HInstance:=getmodulehandle(GetCommandFile);
+    SysInstance:=getmodulehandle(GetCommandFile);
   MainInstance:=HInstance;
   cmdshow:=startupinfo.wshowwindow;
   { Setup heap }

rtl/win32/win32res.inc

@@ -0,0 +1,48 @@
+
+function SysFindResource(hModule:HMODULE; lpName:Pchar; lpType:Pchar):TResourceHandle; external 'kernel32' name 'FindResourceA';
+function SysLoadResource(hModule:HMODULE; hResInfo:TResourceHandle):HGLOBAL; external 'kernel32' name 'LoadResource';
+function SysSizeofResource(hModule:HMODULE; hResInfo:TResourceHandle):DWORD; external 'kernel32' name 'SizeofResource';
+function SysLockResource(hResData:HGLOBAL):Pointer; external 'kernel32' name 'LockResource';
+function SysFreeResource(hResData:HGLOBAL):Longbool; external 'kernel32' name 'FreeResource';
+
+Function HINSTANCE : HMODULE;
+
+begin
+  Result:=sysinstance;
+end;
+
+Function FindResource(ModuleHandle: HMODULE; ResourceName, ResourceType: PChar): TResourceHandle;
+
+begin
+  Result:=SysFindResource(ModuleHandle,ResourceName,ResourceType);
+end;
+
+Function LoadResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): HGLOBAL;
+
+begin
+  Result:=SysLoadresource(ModuleHandle,Reshandle);
+end;
+
+Function SizeofResource(ModuleHandle: HMODULE; ResHandle: TResourceHandle): Integer;
+
+begin
+  Result:=SysSizeofResource(ModuleHandle,Reshandle);
+end;
+
+Function LockResource(ResData: HGLOBAL): Pointer;
+
+begin
+  Result:=SysLockResource(ResData);
+end;
+
+Function UnlockResource(ResData: HGLOBAL): LongBool;
+
+begin
+  Result:=FreeResource(ResData);
+end;
+
+Function FreeResource(ResData: HGLOBAL): LongBool;
+
+begin
+  Result:=SysFreeResource(ResData);
+end;