[GExperts-CVS] gexperts/unstable/Comps GpStructuredStorage.pas, 1.6, 1.7

[Erik B. <eb...@us...>]

Update of /cvsroot/gexperts/gexperts/unstable/Comps
In directory sc8-pr-cvs2.sourceforge.net:/tmp/cvs-serv1339/Comps

Modified Files:
	GpStructuredStorage.pas 
Log Message:
Fix folder memory leak, update to latest version

Index: GpStructuredStorage.pas
===================================================================
RCS file: /cvsroot/gexperts/gexperts/unstable/Comps/GpStructuredStorage.pas,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- GpStructuredStorage.pas	4 May 2005 04:34:12 -0000	1.6
+++ GpStructuredStorage.pas	20 Jul 2006 10:09:45 -0000	1.7
@@ -6,7 +6,7 @@
 
 This software is distributed under the BSD license.
 
-Copyright (c) 2004, Primoz Gabrijelcic
+Copyright (c) 2006, Primoz Gabrijelcic
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without modification,
@@ -32,10 +32,20 @@
 
    Author            : Primoz Gabrijelcic
    Creation date     : 2003-11-10
-   Last modification : 2005-05-02
-   Version           : 1.08a
+   Last modification : 2006-07-20
+   Version           : 1.10b
 </pre>*)(*
    History:
+     1.10b:
+       - Memory leak fixed: Internal objects representing folders were never freed. 
+     1.10a: 2006-01-30
+       - Fixed TGpStructuredStorage.Delete to not unnecessary auto-create parent folders.
+       - Fixed TGpStructuredStorage.IsFolderEmpty to work when unexistent path is passed
+         as a parameter.
+     1.10: 2006-01-29
+       - Added method IGpStructuredStorage.IsFolderEmpty.
+     1.09: 2006-01-20
+       - Major speedup in Folder flushing.
      1.08a: 2005-05-02
        - Fixed crash in Compact (signature of GetTempFileName was invalid).
      1.08: 2004-12-16
@@ -91,8 +101,10 @@
 interface
 
 uses
+  Windows,
   SysUtils,
-  Classes;
+  Classes,
+  GpLists;
 
 type
   {:Structured storage exception class.
@@ -161,10 +173,12 @@
     function  FileExists(const fileName: string): boolean;
     //:Checks whether the specified folder exists.
     function  FolderExists(const folderName: string): boolean;
-    //:Returns list of files in folder 'folderName'. Caller must destroy the result.
+    //:Returns list of files in folder 'folderName'.
     procedure FileNames(const folderName: string; {out} files: TStrings);
-    //:Returns list of folders in folder 'folderName'. Caller must destroy the result.
+    //:Returns list of folders in folder 'folderName'. 
     procedure FolderNames(const folderName: string; {out} folders: TStrings);
+    //:Fast way to check if folder is empty.
+    function  IsFolderEmpty(const folderName: string): boolean;
     //:Compacts the structured storage (by copying it to a temporary file and then back).
     procedure Compact;
     //:Returns name of the underlying data file or '' if storage is stream-based.
@@ -175,6 +189,10 @@
     property FileInfo[const fileName: string]: IGpStructuredFileInfo read GetFileInfo;
   end; { IGpStructuredStorage }
 
+  IGpDebugStructuredStorage = interface ['{8F6AA5E9-24DF-4312-A779-19DD78C5CB96}']
+    procedure Dump(const fileName: string);
+  end; { IGpDebugStructuredStorage }
+
 {:Creates an instance of a structured storage.
   @since   2004-12-16
 }
@@ -185,8 +203,6 @@
 uses
   Contnrs,
   Math,
-  Windows,
-  GpLists,
   GpMemStr;
 
 const
@@ -339,7 +355,6 @@
       attributes: TGpStructuredFileAttributes);
     destructor  Destroy; override;
     //TStream interface
-    // TODO 3 -oPrimoz Gabrijelcic: Make this D7-compatible
     function Read(var buffer; count: longint): longint; override;
     function Write(const buffer; count: longint): longint; override;
     function Seek(offset: longint; origin: Word): longint; override;
@@ -531,8 +546,8 @@
     procedure Rename(parentFolder: TGpStructuredFolder; const oldName, newName: string);
     procedure Reparent(parentFolder: TGpStructuredFolder; const folderName: string;
       newParentFolder: TGpStructuredFolder);
-    property SubFolder[parentFolder: TGpStructuredFolder; subFolder: string]: TGpStructuredFolder
-      read GetSubFolder write SetSubFolder; default;
+    property SubFolder[parentFolder: TGpStructuredFolder; subFolder: string]:
+      TGpStructuredFolder read GetSubFolder write SetSubFolder; default;
   end; { TGpStructuredFolderCache }
 
   {:Structured storage implementation. File names are eight bit, case-preserving and ansi
@@ -541,7 +556,7 @@
     size is 2 GB.
     @since   2003-11-10
   }
-  TGpStructuredStorage = class(TInterfacedObject, IGpStructuredStorage)
+  TGpStructuredStorage = class(TInterfacedObject, IGpStructuredStorage, IGpDebugStructuredStorage)
   private
     gssFAT         : TGpStructuredFAT;
     gssFileInfoList: TList;
@@ -561,8 +576,8 @@
     procedure CreateEmptyStorage;
     function  CreateFileInfo(owner: TGpStructuredStorage;
       folder: TGpStructuredFolder; const fileName: string): IGpStructuredFileInfo;
-    function  DescendTree(folderName: string;
-      autoCreate: boolean = true): TGpStructuredFolder;
+    function  DescendTree(folderName: string; autoCreate: boolean = true):
+      TGpStructuredFolder;
     function  GetDataFile: string;
     function  GetDataSize: integer;
     function  GetFileInfo(const fileName: string): IGpStructuredFileInfo;
@@ -598,13 +613,12 @@
     procedure FolderNames(const folderName: string; {out} folders: TStrings);
     procedure Initialize(const storageDataFile: string; mode: word); overload;
     procedure Initialize(storageDataStream: TStream); overload;
+    function  IsFolderEmpty(const folderName: string): boolean;
     function  IsStructuredStorage(const storageDataFile: string): boolean; overload;
     function  IsStructuredStorage(storageDataStream: TStream): boolean; overload;
     procedure Move(const objectName, newName: string);
     function  OpenFile(const fileName: string; mode: word): TStream;
-  {$IFDEF DebugStructuredStorage}
     procedure Dump(const fileName: string);
-  {$ENDIF DebugStructuredStorage}
     property DataFile: string read GetDataFile;
     property DataSize: integer read GetDataSize;
     property FileInfo[const fileName: string]: IGpStructuredFileInfo read GetFileInfo;
@@ -1370,13 +1384,13 @@
 destructor TGpStructuredFolder.Destroy;
 begin
   FreeAndNil(sfEntries);
-  if assigned(Owner) then
+  if assigned(Owner) and (sfAccessCount > 0) then
     sfOwner.ReleaseFolder(self);
   inherited;
 end; { TGpStructuredFolder.Destroy }
 
-function TGpStructuredFolder.DetachEntry(
-  const entryName: string): TGpStructuredFolderEntry;
+function TGpStructuredFolder.DetachEntry(const entryName: string):
+  TGpStructuredFolderEntry;
 var
   idxEntry: integer;
 begin
@@ -1454,14 +1468,21 @@
 procedure TGpStructuredFolder.Flush;
 var
   iEntry    : integer;
+  memFolder : TMemoryStream;
   terminator: word;
 begin
-  Position := 0;
-  for iEntry := 0 to CountEntries-1 do
-    Entry[iEntry].SaveTo(self);
-  terminator := 0;
-  Write(terminator, 2);
-  Size := Position;
+  memFolder := TMemoryStream.Create;
+  try
+    for iEntry := 0 to CountEntries-1 do
+      Entry[iEntry].SaveTo(memFolder);
+    terminator := 0;
+    memFolder.Write(terminator, 2);
+    Position := 0;
+    memFolder.Position := 0;
+    CopyFrom(memFolder, 0);
+    if Size <> Position then
+      Size := Position;
+  finally FreeAndNil(memFolder); end;
 end; { TGpStructuredFolder.Flush }
 
 function TGpStructuredFolder.FolderExists(const folderName: string): boolean;
@@ -1590,8 +1611,8 @@
 {:Opens/creates a file information entry.
   @since   2004-02-15
 }
-function TGpStructuredFolder.OpenFile(const fileName: string;
-  mode: word): TGpStructuredFile;
+function TGpStructuredFolder.OpenFile(const fileName: string; mode: word):
+  TGpStructuredFile;
 var
   idxEntry: integer;
 begin
@@ -1610,8 +1631,8 @@
 {:Opens/creates a folder information entry.
   @since   2004-02-16
 }
-function TGpStructuredFolder.OpenFolder(const folderName: string;
-  mode: word): TGpStructuredFolder;
+function TGpStructuredFolder.OpenFolder(const folderName: string; mode: word):
+  TGpStructuredFolder;
 var
   idxEntry: integer;
 begin
@@ -1749,7 +1770,7 @@
   Result := sfHeader.FirstEmptyBlock;
   sfHeader.FirstEmptyBlock := Entry[Result];
   Entry[Result] := 0; // return unconnected block
-  Flush;
+  Flush; 
 end; { TGpStructuredFAT.AllocateBlock }
 
 {:Allocates FAT block that is stored at the end of the storage and manages next
@@ -1847,7 +1868,7 @@
 var
   block : cardinal;
   iBlock: integer;
-begin
+begin 
   block := 1;
   for iBlock := 0 to sfBlocks.Count-1 do begin
     TGpStructuredFATBlock(sfBlocks[iBlock]).Save(block);
@@ -2180,7 +2201,7 @@
   if assigned(gssFat) and assigned(gssFat.sfBlocks) then
     gssFAT.Truncate;
   {$IFDEF DebugStructuredStorage}
-  Dump('test.dmp');
+  //Dump('test.dmp');
   {$ENDIF DebugStructuredStorage}
   UnregisterAllFileInfo;
   FreeAndNil(gssFileInfoList);
@@ -2309,7 +2330,6 @@
   gssRootFolder.OnSizeChanged := RootFolderSizeChanged;
   gssRootFolder.Initialize(0);
   gssHeader.FirstRootFolderBlock := gssRootFolder.FirstBlock;
-//  RootFolderSizeChanged(gssRootFolder);
   gssHeader.StorageAttributeFile := gssFAT.AllocateBlock;
   gssHeader.StorageAttributeFileSize := 0;
 end; { TGpStructuredStorage.CreateEmptyStorage }
@@ -2347,14 +2367,16 @@
   stgFolder: TGpStructuredFolder;
 begin
   SplitFileName(objectName, folder, name);
-  stgFolder := DescendTree(folder);
-  try
-    stgFolder.DeleteEntry(name);
-    if not stgFolder.IsEmpty then
-      folder := '';
-  finally ReleaseFolder(stgFolder); end;
-  if (folder <> '') and (folder <> CFolderDelim) and (name = '') then
-    Delete(StripTrailingDelimiter(folder)); // delete folder too; strip last delimiter to prevent recursion
+  stgFolder := DescendTree(folder, false);
+  if assigned(stgFolder) then begin
+    try
+      stgFolder.DeleteEntry(name);
+      if not stgFolder.IsEmpty then
+        folder := '';
+    finally ReleaseFolder(stgFolder); end;
+    if (folder <> '') and (folder <> CFolderDelim) and (name = '') then
+      Delete(StripTrailingDelimiter(folder)); // delete folder too; strip last delimiter to prevent recursion
+  end;
 end; { TGpStructuredStorage.Delete }
 
 {:Descends to the folder inside the storage.
@@ -2370,7 +2392,7 @@
 var
   parent: TGpStructuredFolder;
   pDelim: integer;
-begin
+begin 
   if (folderName = '') or (folderName[1] <> CFolderDelim) then
     raise Exception.CreateFmt('TGpStructuredStorage: Invalid folder name %s', [folderName]);
   System.Delete(folderName, 1, 1);
@@ -2399,12 +2421,16 @@
     FreeAndNil(gssStorage);
   inherited;
 end; { TGpStructuredStorage.Destroy }
-  
-{$IFDEF DebugStructuredStorage}
+
 procedure TGpStructuredStorage.Dump(const fileName: string);
+{$IFDEF DebugStructuredStorage}
 var
   df: textfile;
+{$ENDIF DebugStructuredStorage}
 begin
+  {$IFNDEF DebugStructuredStorage}
+  raise Exception.Create('TGpStructuredStorage.Dump: Not supported');
+  {$ELSE}
   AssignFile(df, fileName);
   Rewrite(df);
   try
@@ -2423,9 +2449,9 @@
     Writeln(df, 'Folders:');
     gssRootFolder.Dump(df, '');
   finally CloseFile(df) end;
+  {$ENDIF DebugStructuredStorage}
 end; { TGpStructuredStorage.Dump }
-{$ENDIF DebugStructuredStorage}
-  
+
 {:Checks whether the specified file or folder exists.
   @since   2004-03-02
 }
@@ -2566,6 +2592,21 @@
   FreeAndNil(gssStorage);
 end; { TGpStructuredStorage.IsStructuredStorage }
 
+{:Checks if folder is empty.
+  @since   2006-01-29
+}
+function TGpStructuredStorage.IsFolderEmpty(const folderName: string): boolean;
+var
+  stgFolder: TGpStructuredFolder;
+begin
+  stgFolder := DescendTree(NormalizeFileName(folderName, true), false);
+  if not assigned(stgFolder) then
+    Result := true
+  else try
+    Result := stgFolder.IsEmpty;
+  finally ReleaseFolder(stgFolder); end;
+end; { TGpStructuredStorage.IsFolderEmpty }
+
 {:Checks if a stream contains structured storage.
   @since   2004-12-16
 }
@@ -2715,7 +2756,7 @@
     gssHeader.StorageAttributeFile, gssHeader.StorageAttributeFileSize,
     [sfAttrIsAttributeFile]);
   Result.OnSizeChanged := StorageAttributeFileSizeChanged;
-end; { TGpStructuredStorage.ReleaseFolder }
+end; { TGpStructuredStorage.OpenStorageAttributeFile }
 
 procedure TGpStructuredStorage.PrepareStructures;
 begin
@@ -2735,7 +2776,9 @@
   begin
     if not gssFolderCache.Remove(folder.Folder, folder.FileName) then
       raise Exception.CreateFmt(
-        'TGpStructuredStorage: Folder %s is not stored in the cache.', [folder.FileName]);
+        'TGpStructuredStorage: Folder %s is not stored in the cache.', [folder.FileName])
+    else
+      FreeAndNil(folder);
   end;
 end; { TGpStructuredStorage.ReleaseFolder }