فهرست منبع

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

git-svn-id: trunk@14805 -

giulio2 15 سال پیش
والد
کامیت
bb5891a560
6فایلهای تغییر یافته به همراه398 افزوده شده و 71 حذف شده
  1. 1 0
      .gitattributes
  2. 80 63
      utils/fpcres/Makefile
  3. 2 2
      utils/fpcres/Makefile.fpc
  4. 309 0
      utils/fpcres/closablefilestream.pas
  5. 3 3
      utils/fpcres/fpcres.pas
  6. 3 3
      utils/fpcres/sourcehandler.pas

+ 1 - 0
.gitattributes

@@ -11209,6 +11209,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

+ 80 - 63
utils/fpcres/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/12/10]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2010/01/26]
 #
 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
+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 i386-nativent 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
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx haiku
 LIMIT83fs = go32v2 os2 emx watcom
@@ -324,6 +324,9 @@ endif
 ifeq ($(FULL_TARGET),i386-symbian)
 override TARGET_PROGRAMS+=fpcres
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+override TARGET_PROGRAMS+=fpcres
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_PROGRAMS+=fpcres
 endif
@@ -445,184 +448,187 @@ 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),i386-nativent)
+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
@@ -967,6 +973,10 @@ ifeq ($(OS_TARGET),symbian)
 SHAREDLIBEXT=.dll
 SHORTSUFFIX=symbian
 endif
+ifeq ($(OS_TARGET),NativeNT)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=nativent
+endif
 else
 ifeq ($(OS_TARGET),go32v1)
 PPUEXT=.pp1
@@ -1472,6 +1482,10 @@ ifeq ($(FULL_TARGET),i386-symbian)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-RES=1
 endif
+ifeq ($(FULL_TARGET),i386-nativent)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FCL-RES=1
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-RES=1
@@ -2006,6 +2020,9 @@ endif
 ifdef EXEFILES
 override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
 endif
+ifdef CLEAN_PROGRAMS
+override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS)))
+endif
 ifdef CLEAN_UNITS
 override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
 endif
@@ -2200,4 +2217,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;