Browse Source

Merged revisions 14805,14824 from trunk
------------------------------------------------------------------------
r14805 | giulio2 | 2010-01-26 09:54:41 +0100 (Tue, 26 Jan 2010) | 5 lines

* fpcres: Implemented TClosableFileStream to automatically release and acquire
file handles as needed. It avoids running out of file descriptors
(fixes bug #15586)


------------------------------------------------------------------------
r14824 | giulio2 | 2010-01-29 13:19:05 +0100 (Fri, 29 Jan 2010) | 3 lines

Patch from Paul and Dmitry: properly quote resource list file parameter for fpcres
(fixes resource compilation when spaces are in the path)

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@14856 -

giulio2 15 years ago
parent
commit
a08febb2dc

+ 1 - 0
.gitattributes

@@ -10428,6 +10428,7 @@ utils/fpcm/printmakefilefpcrequirements.sh svneol=native#text/plain
 utils/fpcm/readme.txt svneol=native#text/plain
 utils/fpcres/Makefile svneol=native#text/plain
 utils/fpcres/Makefile.fpc svneol=native#text/plain
+utils/fpcres/closablefilestream.pas svneol=native#text/plain
 utils/fpcres/fpcres.pas svneol=native#text/plain
 utils/fpcres/msghandler.pas svneol=native#text/plain
 utils/fpcres/paramparser.pas svneol=native#text/plain

+ 1 - 1
compiler/comprsrc.pas

@@ -288,7 +288,7 @@ begin
       if fCollectCount=0 then
         s:=s+' '+maybequoted(fname)
       else
-        s:=s+' @'+maybequoted(fScriptName);
+        s:=s+' '+maybequoted('@'+fScriptName);
     end;
   { windres doesn't like empty include paths }
   if respath='' then

+ 62 - 62
utils/fpcres/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/01/25]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/02/04]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -445,184 +445,184 @@ ifeq ($(FULL_TARGET),mipsel-linux)
 override TARGET_PROGRAMS+=fpcres
 endif
 ifeq ($(FULL_TARGET),i386-linux)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override CLEAN_UNITS+=msghandler paramparser sourcehandler target
+override CLEAN_UNITS+=closablefilestream msghandler paramparser sourcehandler target
 endif
 override INSTALL_FPCPACKAGE=y
 ifdef REQUIRE_UNITSDIR
@@ -2200,4 +2200,4 @@ ifneq ($(wildcard fpcmake.loc),)
 include fpcmake.loc
 endif
 .NOTPARALLEL:
-fpcres$(EXEEXT): target.pas msghandler.pas paramparser.pas sourcehandler.pas fpcres.pas
+fpcres$(EXEEXT): target.pas msghandler.pas closablefilestream.pas paramparser.pas sourcehandler.pas fpcres.pas

+ 2 - 2
utils/fpcres/Makefile.fpc

@@ -6,7 +6,7 @@
 programs=fpcres
 
 [clean]
-units=msghandler paramparser sourcehandler target
+units=closablefilestream msghandler paramparser sourcehandler target
 
 [require]
 packages=rtl fcl-res
@@ -19,4 +19,4 @@ fpcdir=../..
 
 [rules]
 .NOTPARALLEL:
-fpcres$(EXEEXT): target.pas msghandler.pas paramparser.pas sourcehandler.pas fpcres.pas
+fpcres$(EXEEXT): target.pas msghandler.pas closablefilestream.pas paramparser.pas sourcehandler.pas fpcres.pas

+ 309 - 0
utils/fpcres/closablefilestream.pas

@@ -0,0 +1,309 @@
+{
+
+    FPCRes - Free Pascal Resource Converter
+    Part of the Free Pascal distribution
+    Copyright (C) 2008-2010 by Giulio Bernardi
+
+    Support for file streams that can be temporarily closed
+
+    See the file COPYING, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+unit closablefilestream;
+
+{$MODE OBJFPC} {$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+type
+  TClosableFileNotifier = class;
+
+  { TClosableFileStream }
+
+  TClosableFileStream = class(TStream)
+  private
+    fStream : TFileStream;
+    fFileName : string;
+    fMode : word;
+    fListener : TClosableFileNotifier;
+    fPosition : int64;
+    procedure EnsureHandleOpen;
+  protected
+    procedure SetSize(NewSize: Longint); override;
+    procedure SetSize(const NewSize: Int64); override;
+    function RetryOpen : boolean;
+  public
+    constructor Create(const AFileName: String; Mode: Word);
+    destructor Destroy; override;
+    function Read(var Buffer; Count: Longint): Longint; override;
+    function Write(const Buffer; Count: Longint): Longint; override;
+    function Seek(Offset: Longint; Origin: Word): Longint; override;
+    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
+    procedure CloseHandle;
+end;
+
+TClosableFileNotifier = class
+protected
+  procedure NotifyFileOpened(aStream : TClosableFileStream); virtual; abstract;
+  function NotifyOpenFailed(aStream: TClosableFileStream) : boolean;
+    virtual; abstract;
+end;
+
+
+implementation
+
+type
+  PQueueItem = ^TQueueItem;
+  TQueueItem = record
+    prev : PQueueItem;
+    next : PQueueItem;
+    data : pointer;
+  end;
+
+  { TFIFOQueue }
+
+  TFIFOQueue = class
+  private
+    fHead : PQueueItem;
+    fTail : PQueueItem;
+    fCount : integer;
+  protected
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Add(p : pointer);
+    function Remove : Pointer;
+    property Count : integer read fCount;
+  end;
+
+
+  { TFileKeeper }
+
+  TFileKeeper = class(TClosableFileNotifier)
+  private
+    fOpenFiles : TFIFOQueue;
+    fMaxOpen : longint;
+  private
+    procedure CloseFiles(const count : integer);
+  protected
+    procedure NotifyFileOpened(aStream : TClosableFileStream);  override;
+    function NotifyOpenFailed(aStream: TClosableFileStream) : boolean; override;
+  public
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+{ TFIFOQueue }
+
+constructor TFIFOQueue.Create;
+begin
+  fHead:=nil;
+  fTail:=nil;
+  fCount:=0;
+end;
+
+destructor TFIFOQueue.Destroy;
+var
+  el : PQueueItem;
+begin
+  while fHead<>nil do
+  begin
+    el:=fHead;
+    fHead:=fHead^.next;
+    FreeMem(el);
+  end;
+end;
+
+procedure TFIFOQueue.Add(p: pointer);
+var
+  el : PQueueItem;
+begin
+  el:=GetMem(sizeof(TQueueItem));
+  el^.data:=p;
+  el^.prev:=nil;
+  el^.next:=fHead;
+  if fHead<>nil then
+    fHead^.prev:=el;
+  fHead:=el;
+  if fTail=nil then
+    fTail:=fHead;
+  inc(fCount);
+end;
+
+function TFIFOQueue.Remove: Pointer;
+var
+  el : PQueueItem;
+begin
+  if fCount=0 then
+  begin
+    Result:=nil;
+    exit;
+  end;
+  Result:=fTail^.data;
+  el:=fTail;
+  fTail:=fTail^.prev;
+  if fTail=nil then
+    fHead:=nil
+  else
+    fTail^.next:=nil;
+  FreeMem(el);
+  dec(fCount);
+end;
+
+{ TFileKeeper }
+
+procedure TFileKeeper.CloseFiles(const count: integer);
+var
+  i,max : integer;
+  tmp : TClosableFileStream;
+begin
+  max:=count;
+  if fOpenFiles.Count<max then
+    max:=fOpenFiles.Count;
+  for i:=0 to max-1 do
+  begin
+    tmp:=TClosableFileStream(fOpenFiles.Remove);
+    tmp.CloseHandle;
+  end;
+end;
+
+procedure TFileKeeper.NotifyFileOpened(aStream: TClosableFileStream);
+begin
+   fOpenFiles.Add(aStream);
+   if (fOpenFiles.Count>=fMaxOpen) then
+     CloseFiles(1);
+end;
+
+function TFileKeeper.NotifyOpenFailed(aStream: TClosableFileStream) : boolean;
+var
+  decrement : longint;
+begin
+  Result:=false;
+  decrement:=round(0.1*fOpenFiles.Count);
+  if decrement<=0 then exit;
+  CloseFiles(decrement);
+  Result:=aStream.RetryOpen;
+  if Result then
+    fMaxOpen:=fOpenFiles.Count+1;
+end;
+
+constructor TFileKeeper.Create;
+begin
+  fOpenFiles:=TFIFOQueue.Create;
+  fMaxOpen:=high(longint);
+end;
+
+destructor TFileKeeper.Destroy;
+begin
+  fOpenFiles.Free;
+end;
+
+var
+  FileKeeper : TFileKeeper;
+
+{ TClosableFileStream }
+
+procedure TClosableFileStream.EnsureHandleOpen;
+begin
+  if fStream<>nil then
+    exit;
+  try
+    fStream:=TFileStream.Create(fFileName,fMode);
+  except
+    if not fListener.NotifyOpenFailed(self) then
+      raise;
+  end;
+  fStream.Position:=fPosition;
+  fListener.NotifyFileOpened(self);
+end;
+
+procedure TClosableFileStream.SetSize(NewSize: Longint);
+begin
+  SetSize(int64(NewSize));
+end;
+
+procedure TClosableFileStream.SetSize(const NewSize: Int64);
+begin
+  EnsureHandleOpen;
+  fStream.Size:=NewSize;
+end;
+
+function TClosableFileStream.RetryOpen: boolean;
+begin
+  try
+    fStream:=TFileStream.Create(fFileName,fMode);
+  except
+    Result:=false;
+    exit;
+  end;
+  Result:=true;
+end;
+
+constructor TClosableFileStream.Create(const AFileName: String; Mode: Word);
+begin
+  fListener:=FileKeeper;
+  fFileName:=aFileName;
+  fMode:=Mode;
+  fPosition:=0;
+  fStream:=nil;
+  EnsureHandleOpen;
+  //if the file has been created, ensure that further openings don't recreate
+  //it again!
+  if fMode=fmCreate then
+    fMode:=fmOpenReadWrite;
+end;
+
+destructor TClosableFileStream.Destroy;
+begin
+  if fStream<>nil then
+    CloseHandle;
+end;
+
+function TClosableFileStream.Read(var Buffer; Count: Longint): Longint;
+begin
+  EnsureHandleOpen;
+  Result:=fStream.Read(Buffer,Count);
+end;
+
+function TClosableFileStream.Write(const Buffer; Count: Longint): Longint;
+begin
+  EnsureHandleOpen;
+  Result:=fStream.Write(Buffer,Count);
+end;
+
+function TClosableFileStream.Seek(Offset: Longint; Origin: Word): Longint;
+begin
+  EnsureHandleOpen;
+  Result:=fStream.Seek(Offset,Origin);
+end;
+
+function TClosableFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin
+  ): Int64;
+begin
+  EnsureHandleOpen;
+  Result:=fStream.Seek(Offset,Origin);
+end;
+
+procedure TClosableFileStream.CloseHandle;
+begin
+  fPosition:=fStream.Position;
+  fStream.Free;
+  fStream:=nil;
+end;
+
+initialization
+  FileKeeper:=TFileKeeper.Create;
+
+finalization
+  FileKeeper.Destroy;
+
+end.
+

+ 3 - 3
utils/fpcres/fpcres.pas

@@ -20,7 +20,7 @@ program fpcres;
 
 uses
   SysUtils, Classes, paramparser, target, msghandler, sourcehandler,
-  resource,
+  closablefilestream, resource,
 //readers
   resreader, coffreader, winpeimagereader, elfreader, machoreader,
   externalreader, dfmreader,
@@ -279,13 +279,13 @@ begin
 end;
 
 procedure WriteOutputFile;
-var aStream : TFileStream;
+var aStream : TClosableFileStream;
     aWriter : TAbstractResourceWriter;
     msg : string;
 begin
   Messages.DoVerbose(Format('Trying to create output file %s...',[params.OutputFile]));
   try
-    aStream:=TFileStream.Create(params.OutputFile,fmCreate or fmShareDenyWrite);
+    aStream:=TClosableFileStream.Create(params.OutputFile,fmCreate or fmShareDenyWrite);
   except
     Messages.DoError(Format(SCantCreateFile,[params.OutputFile]));
     halt(halt_write_err);

+ 3 - 3
utils/fpcres/sourcehandler.pas

@@ -46,7 +46,7 @@ type
   
 implementation
 
-uses msghandler;
+uses msghandler, closablefilestream;
 
 { TSourceFiles }
 
@@ -67,7 +67,7 @@ end;
 
 procedure TSourceFiles.Load(aResources: TResources);
 var aReader : TAbstractResourceReader;
-    aStream : TFileStream;
+    aStream : TClosableFileStream;
     i : integer;
     tmpres : TResources;
 begin
@@ -77,7 +77,7 @@ begin
     begin
       Messages.DoVerbose(Format('Trying to open file %s...',[fFileList[i]]));
       try
-        aStream:=TFileStream.Create(fFileList[i],fmOpenRead or fmShareDenyWrite);
+        aStream:=TClosableFileStream.Create(fFileList[i],fmOpenRead or fmShareDenyWrite);
       except
         raise ECantOpenFileException.Create(fFileList[i]);
       end;