* Fixed inclusion of multiple resource files with icons or cursors. Patch by Sergei Gorelkin modified by me to reduce memory usage. Bug #9459.

git-svn-id: trunk@8324 -

compiler/comprsrc.pas

@@ -45,6 +45,8 @@ type
    TWinLikeResourceFile = class(tresourcefile)
    private
       FOut: TCFileStream;
+      FLastIconID: longint;
+      FLastCursorID: longint;
    public
       function IsCompiled(const fn : ansistring) : boolean;override;
       procedure Collect(const fn : ansistring);override;
@@ -228,12 +230,37 @@ type
   TResHeader = packed record
     DataSize: dword;
     HeaderSize: dword;
+    ResTypeFlag: word;
+    ResTypeID: word;
+  end;
+  
+  PIconHeader = ^TIconHeader;
+  TIconHeader = packed record
+    Reserved: word;
+    wType: word;
+    wCount: word;
+  end;
+  
+  PIconDir = ^TIconDir;
+  TIconDir = packed record
+    bWidth: byte;
+    bHeight: byte;
+    bColorCount: byte;
+    bReserved: byte;
+    wPlanes: word;
+    wBitCount: word;
+    lBytesInRes: dword;
+    wNameOrdinal: word;
   end;
 
 var
   fs: TCFileStream;
-  i, sz: longint;
+  i, sz, rsz, IconCount, CursorCount: longint;
   hdr: TResHeader;
+  P: pointer;
+  PData: PIconHeader;
+  PDir: PIconDir;
+  ResNameBuf: array[0..1] of word;
 begin
   if fn='' then
     begin
@@ -262,18 +289,62 @@ begin
       else
         fs.Seek(32, soFromBeginning);
       sz:=fs.Size;
+      IconCount := 0;
+      CursorCount := 0;
       repeat
         fs.ReadBuffer(hdr, SizeOf(hdr));
         FOut.WriteBuffer(hdr, SizeOf(hdr));
-        i:=hdr.HeaderSize + hdr.DataSize - SizeOf(hdr);
-        if fs.Position + i > sz then
+        rsz:=hdr.HeaderSize + hdr.DataSize - SizeOf(hdr);
+        if fs.Position + rsz > sz then
           begin
             Comment(V_Error,'Invalid resource file: '+fn);
             Include(current_settings.globalswitches, cs_link_nolink);
             fs.Free;
             exit;
           end;
-        FOut.CopyFrom(fs, i);
+        { Adjusting cursor and icon IDs }
+        if hdr.ResTypeFlag = $FFFF then       { resource type is ordinal }
+          case hdr.ResTypeID of
+            1, 3:
+              { cursor or icon resource }
+              begin
+                fs.ReadBuffer(ResNameBuf, SizeOf(ResNameBuf));
+                if ResNameBuf[0] = $FFFF then   { resource name is ordinal }
+                  if hdr.ResTypeID = 1 then
+                    begin
+                      Inc(ResNameBuf[1], FLastCursorID);
+                      Inc(CursorCount);
+                    end
+                  else
+                    begin
+                      Inc(ResNameBuf[1], FLastIconID);
+                      Inc(IconCount);
+                    end;
+                FOut.WriteBuffer(ResNameBuf, SizeOf(ResNameBuf));
+                Dec(rsz, SizeOf(ResNameBuf));
+              end;
+            12, 14:
+              { cursor or icon group resource }
+              begin
+                GetMem(P, rsz);
+                fs.ReadBuffer(P^, rsz);
+                PData := PIconHeader(P + hdr.HeaderSize - sizeof(hdr));
+                PDir := PIconDir(Pointer(PData) + sizeof(TIconHeader));
+                for i := 0 to PData^.wCount-1 do
+                  begin
+                    if hdr.ResTypeID = 12 then
+                      Inc(PDir^.wNameOrdinal, FLastCursorID)
+                    else
+                      Inc(PDir^.wNameOrdinal, FLastIconID);
+                    Inc(PDir);
+                  end;
+                FOut.WriteBuffer(P^, rsz);
+                rsz:=0;
+                FreeMem(P);
+              end;
+          end;
+        { copy rest of the resource data }
+        FOut.CopyFrom(fs, rsz);
         { align resource to dword }
         i:=4 - FOut.Position mod 4;
         if i<4 then
@@ -284,6 +355,8 @@ begin
           fs.Seek(i, soFromCurrent);
       until fs.Position + SizeOf(hdr) >= sz;
       fs.Free;
+      Inc(FLastCursorID, CursorCount);
+      Inc(FLastIconID, IconCount);
     except
       on E:EOSError do begin
         Comment(V_Error,'Error processing resource file: '+fn+': '+E.Message);