* fcl-db/dbase: add support and test for IndexStream so dbf,memo, and index can work without file backing if streams are used

git-svn-id: trunk@24509 -

packages/fcl-db/src/dbase/dbf.pas

@@ -156,6 +156,7 @@ type
     FMasterLink: TDbfMasterLink;
     FParser: TDbfParser;
     FBlobStreams: PDbfBlobList;
+    FUserIndexStream: TStream;
     FUserStream: TStream;  // user stream to open
     FUserMemoStream: TStream; // user-provided/expected stream backing memo file storage
     FTableName: string;    // table path and file name
@@ -400,6 +401,8 @@ type
     property DbfFile: TDbfFile read FDbfFile;
     // Storage for data file if using memory storage
     property UserStream: TStream read FUserStream write FUserStream;
+    // Storage for index file - if any - when using memory storage
+    property UserIndexStream: TStream read FUserIndexStream write FUserIndexStream;
     // Storage for memo file - if any - when using memory storage
     property UserMemoStream: TStream read FUserMemoStream write FUserMemoStream;
     property DisableResyncOnPost: Boolean read FDisableResyncOnPost write FDisableResyncOnPost;
@@ -1150,6 +1153,7 @@ begin
   begin
     FDbfFile.Stream := FUserStream;
     FDbfFile.MemoStream := FUserMemoStream;
+    FDbfFile.IndexStream := FUserIndexStream;
     FDbfFile.Mode := FileModeToMemMode[FileOpenMode];
   end else begin
     FDbfFile.FileName := FAbsolutePath + FTableName;
@@ -1557,6 +1561,7 @@ begin
       if FStorage = stoMemory then
       begin
         FUserStream := FDbfFile.Stream;
+        FUserIndexStream := FDBfFile.IndexStream;
         FUserMemoStream := FDbfFile.MemoStream;
       end;
 

packages/fcl-db/src/dbase/dbf_dbffile.pas

@@ -51,6 +51,7 @@ type
     FFieldDefs: TDbfFieldDefs;
     FIndexNames: TStringList;
     FIndexFiles: TList;
+    FIndexStream: TStream;
     FDbfVersion: TXBaseVersion;
     FPrevBuffer: TRecordBuffer;
     FDefaultBuffer: TRecordBuffer;
@@ -144,6 +145,8 @@ type
     property FieldDefs: TDbfFieldDefs read FFieldDefs;
     property IndexNames: TStringList read FIndexNames;
     property IndexFiles: TList read FIndexFiles;
+    // Backing stream for stream/memory-based index "files"
+    property IndexStream: TStream read FIndexStream write FIndexStream;
     property MdxFile: TIndexFile read FMdxFile;
     property LanguageId: Integer read GetLanguageId;
     property LanguageStr: string read GetLanguageStr;
@@ -535,13 +538,21 @@ begin
         // Deal with case-sensitive filesystems:
         if (FileName<>'') and (UpperCase(FileName)=FileName) then
           lMdxFileName := UpperCase(lMdxFileName);
-        if FileExists(lMdxFileName) then
+        if FileExists(lMdxFileName) or ((Mode in [pfMemoryOpen,pfMemoryCreate])) then
         begin
           // open file
           FMdxFile := TIndexFile.Create(Self);
           FMdxFile.FileName := lMdxFileName;
           FMdxFile.Mode := Mode;
-          FMdxFile.AutoCreate := false;
+          if (Mode in [pfMemoryOpen,pfMemoryCreate]) then
+          begin
+            FMdxFile.Stream := FIndexStream;
+            FMdxFile.AutoCreate := true;
+          end
+          else
+          begin
+            FMdxFile.AutoCreate := false;
+          end;
           FMdxFile.OnLocaleError := FOnLocaleError;
           FMdxFile.CodePage := UseCodePage;
           FMdxFile.Open;
@@ -2439,6 +2450,12 @@ begin
       lIndexFile.FileName := lIndexFileName;
       lIndexFile.Mode := IndexOpenMode[CreateIndex, Mode];
       lIndexFile.AutoCreate := CreateIndex or (Length(IndexField) > 0);
+      if (Mode in [pfMemoryOpen,pfMemoryCreate]) then
+      begin
+        if FIndexStream = nil then
+          FIndexStream := TMemoryStream.Create;
+        lIndexFile.Stream := FIndexStream;
+      end;
       lIndexFile.CodePage := UseCodePage;
       lIndexFile.OnLocaleError := FOnLocaleError;
       lIndexFile.Open;

packages/fcl-db/src/dbase/history.txt

@@ -32,6 +32,7 @@ BUGS & WARNINGS
 
 
 FreePascal trunk (future V7.0.0):
+- add support for memo and index stream so no disk files are needed when using streams
 - clarification on field types; remove some workarounds (r24169) todo: reinstate depending on test set
 - initial support for (Visual) FoxPro files (r24139)
 - annotated constants/file structure (r24139)

packages/fcl-db/tests/testspecifictdbf.pas

@@ -56,11 +56,13 @@ type
     // Tests like TestMemo, but closes and reopens in memory file
     // in between. Data should still be there.
     procedure TestMemoClose;
+    // Same as TestMemoClose except added index stream
+    procedure TestIndexClose;
     // Tests string field with
     // 254 characters (max for DBase IV)
     // 32767 characters (FoxPro, Visual FoxPro)
     procedure TestLargeString;
-    // Tests codepage in created dbf
+    // Tests codepage in created dbf equals requested codepage
     procedure TestCodePage;
   end;
 
@@ -426,6 +428,68 @@ begin
   MemoStream.Free;
 end;
 
+procedure TTestSpecificTDBF.TestIndexClose;
+const
+  MaxRecs = 10;
+var
+  ds : TDBF;
+  i: integer;
+  DBFStream: TMemoryStream;
+  IndexStream: TMemoryStream;
+  MemoStream: TMemoryStream;
+begin
+  ds := TDBF.Create(nil);
+  DBFStream:=TMemoryStream.Create;
+  IndexStream:=TMemoryStream.Create;
+  MemoStream:=TMemoryStream.Create;
+  DS.Storage:=stoMemory;
+  DS.UserStream:=DBFStream;
+  DS.UserIndexStream:=IndexStream;
+  DS.UserMemoStream:=MemoStream;
+  DS.FieldDefs.Add('ID',ftInteger);
+  DS.FieldDefs.Add('NAME',ftMemo);
+  DS.OpenMode:=omAutoCreate; //let dbf code create memo etc files when needed
+  DS.CreateTable;
+
+  DS.Exclusive:=true;//needed for index
+  DS.Open;
+  DS.AddIndex('idxID','ID', [ixPrimary, ixUnique]);
+  DS.Close;
+  DS.Exclusive:=false;
+
+  DS.Open;
+  for i := 1 to MaxRecs do
+    begin
+    DS.Append;
+    DS.FieldByName('ID').AsInteger := i;
+    DS.FieldByName('NAME').AsString := 'TestName' + inttostr(i);
+    DS.Post;
+    end;
+  DS.Close; //in old implementations, this erased memo memory
+
+  // Check streams have content
+  CheckNotEquals(0,DBFStream.Size,'DBF stream should have content');
+  CheckNotEquals(0,IndexStream.Size,'Index stream should have content');
+  CheckNotEquals(0,MemoStream.Size,'Memo stream should have content');
+
+  DS.Open;
+  DS.First;
+  for i := 1 to MaxRecs do
+    begin
+    CheckEquals(i,DS.fieldbyname('ID').asinteger);
+    CheckEquals('TestName' + inttostr(i),DS.fieldbyname('NAME').AsString);
+    DS.next;
+    end;
+  CheckTrue(DS.EOF,'After reading all records the dataset should show EOF');
+  DS.Close;
+
+  ds.free;
+
+  DBFStream.Free;
+  IndexStream.Free;
+  MemoStream.Free;
+end;
+
 procedure TTestSpecificTDBF.TestLargeString;
 var
   ds : TDBF;