Browse Source

+ Version 6.4.5

git-svn-id: trunk@626 -
michael 20 years ago
parent
commit
4aa997ed50

+ 129 - 124
fcl/db/dbase/dbf.pas

@@ -4,19 +4,19 @@ unit dbf;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   Classes,
   Classes,
   Db,
   Db,
-  Dbf_Common,
-  Dbf_DbfFile,
-  Dbf_Parser,
-  Dbf_PrsDef,
-  Dbf_Cursor,
-  Dbf_Fields,
-  Dbf_PgFile,
-  Dbf_IdxFile;
+  dbf_common,
+  dbf_dbffile,
+  dbf_parser,
+  dbf_prsdef,
+  dbf_cursor,
+  dbf_fields,
+  dbf_pgfile,
+  dbf_idxfile;
 // If you got a compilation error here or asking for dsgnintf.pas, then just add
 // If you got a compilation error here or asking for dsgnintf.pas, then just add
 // this file in your project:
 // this file in your project:
 // dsgnintf.pas in 'C: \Program Files\Borland\Delphi5\Source\Toolsapi\dsgnintf.pas'
 // dsgnintf.pas in 'C: \Program Files\Borland\Delphi5\Source\Toolsapi\dsgnintf.pas'
@@ -232,11 +232,11 @@ type
     function  GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; {virtual abstract}
     function  GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; {virtual abstract}
     function  GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
     function  GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
     function  GetRecordSize: Word; override; {virtual abstract}
     function  GetRecordSize: Word; override; {virtual abstract}
-    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override; {virtual abstract}
+    procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override; {virtual abstract}
     procedure InternalClose; override; {virtual abstract}
     procedure InternalClose; override; {virtual abstract}
     procedure InternalDelete; override; {virtual abstract}
     procedure InternalDelete; override; {virtual abstract}
     procedure InternalFirst; override; {virtual abstract}
     procedure InternalFirst; override; {virtual abstract}
-    procedure InternalGotoBookmark(Bookmark: Pointer); override; {virtual abstract}
+    procedure InternalGotoBookmark(ABookmark: Pointer); override; {virtual abstract}
     procedure InternalHandleException; override; {virtual abstract}
     procedure InternalHandleException; override; {virtual abstract}
     procedure InternalInitFieldDefs; override; {virtual abstract}
     procedure InternalInitFieldDefs; override; {virtual abstract}
     procedure InternalInitRecord(Buffer: PChar); override; {virtual abstract}
     procedure InternalInitRecord(Buffer: PChar); override; {virtual abstract}
@@ -245,7 +245,9 @@ type
     procedure InternalEdit; override; {virtual}
     procedure InternalEdit; override; {virtual}
     procedure InternalCancel; override; {virtual}
     procedure InternalCancel; override; {virtual}
 {$ifndef FPC}
 {$ifndef FPC}
+{$ifndef DELPHI_3}
     procedure InternalInsert; override; {virtual}
     procedure InternalInsert; override; {virtual}
+{$endif}
 {$endif}
 {$endif}
     procedure InternalPost; override; {virtual abstract}
     procedure InternalPost; override; {virtual abstract}
     procedure InternalSetToRecord(Buffer: PChar); override; {virtual abstract}
     procedure InternalSetToRecord(Buffer: PChar); override; {virtual abstract}
@@ -309,9 +311,9 @@ type
 
 
     // index support (use same syntax as ttable but is not related)
     // index support (use same syntax as ttable but is not related)
 {$ifdef SUPPORT_DEFAULT_PARAMS}
 {$ifdef SUPPORT_DEFAULT_PARAMS}
-    procedure AddIndex(const AIndexName, Fields: String; Options: TIndexOptions; const DescFields: String='');
+    procedure AddIndex(const AIndexName, AFields: String; Options: TIndexOptions; const DescFields: String='');
 {$else}
 {$else}
-    procedure AddIndex(const AIndexName, Fields: String; Options: TIndexOptions);
+    procedure AddIndex(const AIndexName, AFields: String; Options: TIndexOptions);
 {$endif}
 {$endif}
     procedure RegenerateIndexes;
     procedure RegenerateIndexes;
 
 
@@ -398,7 +400,8 @@ type
     property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
     property StoreDefs: Boolean read FStoreDefs write FStoreDefs default False;
     property TableName: string read FTableName write SetTableName;
     property TableName: string read FTableName write SetTableName;
     property TableLevel: Integer read FTableLevel write SetTableLevel;
     property TableLevel: Integer read FTableLevel write SetTableLevel;
-    property UseFloatFields: Boolean read FUseFloatFields write FUseFloatFields default true;
+    property UseFloatFields: Boolean read FUseFloatFields write FUseFloatFields;
+      (* default {$ifdef SUPPORT_INT64} false {$else} true {$endif}; *)
     property Version: string read GetVersion write SetVersion stored false;
     property Version: string read GetVersion write SetVersion stored false;
     property BeforeAutoCreate: TBeforeAutoCreateEvent read FBeforeAutoCreate write FBeforeAutoCreate;
     property BeforeAutoCreate: TBeforeAutoCreateEvent read FBeforeAutoCreate write FBeforeAutoCreate;
     property OnCompareRecord: TNotifyEvent read FOnCompareRecord write FOnCompareRecord;
     property OnCompareRecord: TNotifyEvent read FOnCompareRecord write FOnCompareRecord;
@@ -455,16 +458,16 @@ uses
 {$else}
 {$else}
 {$ifdef KYLIX}
 {$ifdef KYLIX}
   Libc,
   Libc,
-{$endif}
+{$endif}  
   Types,
   Types,
-  Dbf_Wtil,
+  dbf_wtil,
 {$endif}
 {$endif}
 {$ifdef DELPHI_6}
 {$ifdef DELPHI_6}
   Variants,
   Variants,
 {$endif}
 {$endif}
-  Dbf_IdxCur,
-  Dbf_Memo,
-  Dbf_Str;
+  dbf_idxcur,
+  dbf_memo,
+  dbf_str;
 
 
 {$ifdef FPC}
 {$ifdef FPC}
 const
 const
@@ -548,7 +551,7 @@ begin
     Translate(true);
     Translate(true);
     Dbf.FDbfFile.MemoFile.WriteMemo(FMemoRecNo, FReadSize, Self);
     Dbf.FDbfFile.MemoFile.WriteMemo(FMemoRecNo, FReadSize, Self);
     Dbf.FDbfFile.SetFieldData(FBlobField.FieldNo-1, ftInteger, @FMemoRecNo,
     Dbf.FDbfFile.SetFieldData(FBlobField.FieldNo-1, ftInteger, @FMemoRecNo,
-      @pDbfRecord(TDbf(FBlobField.DataSet).ActiveBuffer).DeletedFlag);
+      @pDbfRecord(TDbf(FBlobField.DataSet).ActiveBuffer)^.DeletedFlag);
     FDirty := false;
     FDirty := false;
   end;
   end;
 end;
 end;
@@ -621,6 +624,7 @@ begin
   FReadOnly := false;
   FReadOnly := false;
   FExclusive := false;
   FExclusive := false;
   FUseFloatFields := true;
   FUseFloatFields := true;
+  //FUseFloatFields := {$ifdef SUPPORT_INT64} false {$else} true {$endif};
   FDisableResyncOnPost := false;
   FDisableResyncOnPost := false;
   FTempExclusive := false;
   FTempExclusive := false;
   FCopyDateTimeAsString := false;
   FCopyDateTimeAsString := false;
@@ -659,7 +663,7 @@ end;
 
 
 procedure TDbf.FreeRecordBuffer(var Buffer: PChar); {override virtual abstract from TDataset}
 procedure TDbf.FreeRecordBuffer(var Buffer: PChar); {override virtual abstract from TDataset}
 begin
 begin
-  FreeMem(Buffer);
+  FreeMemAndNil(Pointer(Buffer));
 end;
 end;
 
 
 procedure TDbf.GetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
 procedure TDbf.GetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
@@ -676,14 +680,14 @@ function TDbf.GetCurrentBuffer: PChar;
 begin
 begin
   case State of
   case State of
     dsFilter:     Result := FFilterBuffer;
     dsFilter:     Result := FFilterBuffer;
-    dsCalcFields: Result := @(pDbfRecord(CalcBuffer).DeletedFlag);
+    dsCalcFields: Result := @(pDbfRecord(CalcBuffer)^.DeletedFlag);
 //    dsSetKey:     Result := FKeyBuffer;     // TO BE Implemented
 //    dsSetKey:     Result := FKeyBuffer;     // TO BE Implemented
   else
   else
     if IsEmpty then
     if IsEmpty then
     begin
     begin
       Result := nil;
       Result := nil;
     end else begin
     end else begin
-      Result := @(pDbfRecord(ActiveBuffer).DeletedFlag);
+      Result := @(pDbfRecord(ActiveBuffer)^.DeletedFlag);
     end;
     end;
   end;
   end;
 end;
 end;
@@ -811,8 +815,8 @@ begin
       begin
       begin
         Result := grError;
         Result := grError;
       end else begin
       end else begin
-        FDbfFile.ReadRecord(lPhysicalRecNo, @pRecord.DeletedFlag);
-        acceptable := (FShowDeleted or (pRecord.DeletedFlag <> '*'))
+        FDbfFile.ReadRecord(lPhysicalRecNo, @pRecord^.DeletedFlag);
+        acceptable := (FShowDeleted or (pRecord^.DeletedFlag <> '*'))
       end;
       end;
     end;
     end;
 
 
@@ -820,7 +824,7 @@ begin
     begin
     begin
       if Filtered or FFindRecordFilter then
       if Filtered or FFindRecordFilter then
       begin
       begin
-        FFilterBuffer := @pRecord.DeletedFlag;
+        FFilterBuffer := @pRecord^.DeletedFlag;
         SaveState := SetTempState(dsFilter);
         SaveState := SetTempState(dsFilter);
         DoFilterRecord(acceptable);
         DoFilterRecord(acceptable);
         RestoreState(SaveState);
         RestoreState(SaveState);
@@ -833,12 +837,12 @@ begin
 
 
   if (Result = grOK) and not FFindRecordFilter then
   if (Result = grOK) and not FFindRecordFilter then
   begin
   begin
-    pRecord.BookmarkData.PhysicalRecNo := FCursor.PhysicalRecNo;
-    pRecord.BookmarkFlag := bfCurrent;
-    pRecord.SequentialRecNo := FCursor.SequentialRecNo;
+    pRecord^.BookmarkData.PhysicalRecNo := FCursor.PhysicalRecNo;
+    pRecord^.BookmarkFlag := bfCurrent;
+    pRecord^.SequentialRecNo := FCursor.SequentialRecNo;
     GetCalcFields(Buffer);
     GetCalcFields(Buffer);
   end else begin
   end else begin
-    pRecord.BookmarkData.PhysicalRecNo := -1;
+    pRecord^.BookmarkData.PhysicalRecNo := -1;
   end;
   end;
 end;
 end;
 
 
@@ -847,7 +851,7 @@ begin
   Result := FDbfFile.RecordSize;
   Result := FDbfFile.RecordSize;
 end;
 end;
 
 
-procedure TDbf.InternalAddRecord(Buffer: Pointer; Append: Boolean); {override virtual abstract from TDataset}
+procedure TDbf.InternalAddRecord(Buffer: Pointer; AAppend: Boolean); {override virtual abstract from TDataset}
   // this function is called from TDataSet.InsertRecord and TDataSet.AppendRecord
   // this function is called from TDataSet.InsertRecord and TDataSet.AppendRecord
   // goal: add record with Edit...Set Fields...Post all in one step
   // goal: add record with Edit...Set Fields...Post all in one step
 var
 var
@@ -859,7 +863,7 @@ begin
 
 
   // we can not insert records in DBF files, only append
   // we can not insert records in DBF files, only append
   // ignore Append parameter
   // ignore Append parameter
-  newRecord := FDbfFile.Insert(@pRecord.DeletedFlag);
+  newRecord := FDbfFile.Insert(@pRecord^.DeletedFlag);
   if newRecord > 0 then
   if newRecord > 0 then
     FCursor.PhysicalRecNo := newRecord;
     FCursor.PhysicalRecNo := newRecord;
 
 
@@ -898,8 +902,8 @@ begin
   if FBlobStreams <> nil then
   if FBlobStreams <> nil then
   begin
   begin
     for I := 0 to Pred(FieldCount) do
     for I := 0 to Pred(FieldCount) do
-      if FBlobStreams[I] <> nil then
-        FBlobStreams[I].Free;
+      if FBlobStreams^[I] <> nil then
+        FBlobStreams^[I].Free;
     FreeMemAndNil(Pointer(FBlobStreams));
     FreeMemAndNil(Pointer(FBlobStreams));
   end;
   end;
   FreeRecordBuffer(FTempBuffer);
   FreeRecordBuffer(FTempBuffer);
@@ -924,8 +928,8 @@ var
 begin
 begin
   // cancel blobs
   // cancel blobs
   for I := 0 to Pred(FieldCount) do
   for I := 0 to Pred(FieldCount) do
-    if Assigned(FBlobStreams[I]) then
-      FBlobStreams[I].Cancel;
+    if Assigned(FBlobStreams^[I]) then
+      FBlobStreams^[I].Cancel;
   // if we have locked a record, unlock it
   // if we have locked a record, unlock it
   if FEditingRecNo >= 0 then
   if FEditingRecNo >= 0 then
   begin
   begin
@@ -939,15 +943,16 @@ var
   lRecord: pDbfRecord;
   lRecord: pDbfRecord;
 begin
 begin
   // start editing
   // start editing
-  Edit;
+  InternalEdit;
+  SetState(dsEdit);
   // get record pointer
   // get record pointer
   lRecord := pDbfRecord(ActiveBuffer);
   lRecord := pDbfRecord(ActiveBuffer);
   // flag we deleted this record
   // flag we deleted this record
-  lRecord.DeletedFlag := '*';
+  lRecord^.DeletedFlag := '*';
   // notify indexes this record is deleted
   // notify indexes this record is deleted
-  FDbfFile.RecordDeleted(FEditingRecNo, @lRecord.DeletedFlag);
+  FDbfFile.RecordDeleted(FEditingRecNo, @lRecord^.DeletedFlag);
   // done!
   // done!
-  Post;
+  InternalPost;
 end;
 end;
 
 
 procedure TDbf.InternalFirst; {override virtual abstract from TDataset}
 procedure TDbf.InternalFirst; {override virtual abstract from TDataset}
@@ -955,9 +960,9 @@ begin
   FCursor.First;
   FCursor.First;
 end;
 end;
 
 
-procedure TDbf.InternalGotoBookmark(Bookmark: Pointer); {override virtual abstract from TDataset}
+procedure TDbf.InternalGotoBookmark(ABookmark: Pointer); {override virtual abstract from TDataset}
 begin
 begin
-  with PBookmarkData(Bookmark)^ do
+  with PBookmarkData(ABookmark)^ do
   begin
   begin
     if (PhysicalRecNo = 0) then begin
     if (PhysicalRecNo = 0) then begin
       First;
       First;
@@ -1003,6 +1008,9 @@ begin
     else
     else
       FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);
       FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);
 
 
+    if TempFieldDef.FieldType = ftFloat then
+      FieldDefs[I].Precision := TempFieldDef.Precision;
+
 {$ifdef SUPPORT_FIELDDEF_ATTRIBUTES}
 {$ifdef SUPPORT_FIELDDEF_ATTRIBUTES}
     // AutoInc fields are readonly
     // AutoInc fields are readonly
     if TempFieldDef.FieldType = ftAutoInc then
     if TempFieldDef.FieldType = ftAutoInc then
@@ -1078,11 +1086,11 @@ var
   pRecord: pDbfRecord;
   pRecord: pDbfRecord;
 begin
 begin
   pRecord := pDbfRecord(Buffer);
   pRecord := pDbfRecord(Buffer);
-  pRecord.BookmarkData.PhysicalRecNo := 0;
-  pRecord.BookmarkFlag := bfCurrent;
-  pRecord.SequentialRecNo := 0;
+  pRecord^.BookmarkData.PhysicalRecNo := 0;
+  pRecord^.BookmarkFlag := bfCurrent;
+  pRecord^.SequentialRecNo := 0;
 // Init Record with zero and set autoinc field with next value
 // Init Record with zero and set autoinc field with next value
-  FDbfFile.InitRecord(@pRecord.DeletedFlag);
+  FDbfFile.InitRecord(@pRecord^.DeletedFlag);
 end;
 end;
 
 
 procedure TDbf.InternalLast; {override virtual abstract from TDataset}
 procedure TDbf.InternalLast; {override virtual abstract from TDataset}
@@ -1092,17 +1100,17 @@ end;
 
 
 procedure TDbf.DetermineTranslationMode;
 procedure TDbf.DetermineTranslationMode;
 var
 var
-  codePage: Cardinal;
+  lCodePage: Cardinal;
 begin
 begin
-  codePage := FDbfFile.UseCodePage;
-  if codePage = GetACP then
+  lCodePage := FDbfFile.UseCodePage;
+  if lCodePage = GetACP then
     FTranslationMode := tmNoneNeeded
     FTranslationMode := tmNoneNeeded
   else
   else
-  if codePage = GetOEMCP then
+  if lCodePage = GetOEMCP then
     FTranslationMode := tmSimple
     FTranslationMode := tmSimple
   // check if this code page, although non default, is installed
   // check if this code page, although non default, is installed
   else
   else
-  if DbfGlobals.CodePageInstalled(codePage) then
+  if DbfGlobals.CodePageInstalled(lCodePage) then
     FTranslationMode := tmAdvanced
     FTranslationMode := tmAdvanced
   else
   else
     FTranslationMode := tmNoneAvailable;
     FTranslationMode := tmNoneAvailable;
@@ -1123,8 +1131,8 @@ begin
   FreeAndNil(FDbfFile);
   FreeAndNil(FDbfFile);
 
 
   // does file not exist? -> create
   // does file not exist? -> create
-  if ((FStorage = stoFile) and
-        not FileExists(FAbsolutePath + FTableName) and
+  if ((FStorage = stoFile) and 
+        not FileExists(FAbsolutePath + FTableName) and 
         (FOpenMode in [omAutoCreate, omTemporary])) or
         (FOpenMode in [omAutoCreate, omTemporary])) or
      ((FStorage = stoMemory) and (FUserStream = nil)) then
      ((FStorage = stoMemory) and (FUserStream = nil)) then
   begin
   begin
@@ -1142,10 +1150,10 @@ begin
   FDbfFile.Open;
   FDbfFile.Open;
 
 
   // fail open?
   // fail open?
-{$ifndef FPC}
+{$ifndef FPC}  
   if FDbfFile.ForceClose then
   if FDbfFile.ForceClose then
     Abort;
     Abort;
-{$endif}
+{$endif}    
 
 
   // determine dbf version
   // determine dbf version
   case FDbfFile.DbfVersion of
   case FDbfFile.DbfVersion of
@@ -1187,7 +1195,7 @@ begin
   // create array of blobstreams to store memo's in. each field is a possible blob
   // create array of blobstreams to store memo's in. each field is a possible blob
   GetMem(FBlobStreams, FieldCount * SizeOf(TDbfBlobStream));
   GetMem(FBlobStreams, FieldCount * SizeOf(TDbfBlobStream));
   for I := 0 to Pred(FieldCount) do
   for I := 0 to Pred(FieldCount) do
-    FBlobStreams[I] := nil;
+    FBlobStreams^[I] := nil;
 
 
   // check codepage settings
   // check codepage settings
   DetermineTranslationMode;
   DetermineTranslationMode;
@@ -1283,20 +1291,22 @@ begin
   // reread blobs, execute cancel -> clears remembered memo pageno,
   // reread blobs, execute cancel -> clears remembered memo pageno,
   // causing it to reread the memo contents
   // causing it to reread the memo contents
   for I := 0 to Pred(FieldCount) do
   for I := 0 to Pred(FieldCount) do
-    if Assigned(FBlobStreams[I]) then
-      FBlobStreams[I].Cancel;
+    if Assigned(FBlobStreams^[I]) then
+      FBlobStreams^[I].Cancel;
   // try to lock this record
   // try to lock this record
-  FDbfFile.LockRecord(FEditingRecNo, @pDbfRecord(ActiveBuffer).DeletedFlag);
+  FDbfFile.LockRecord(FEditingRecNo, @pDbfRecord(ActiveBuffer)^.DeletedFlag);
   // succeeded!
   // succeeded!
 end;
 end;
 
 
 {$ifndef FPC}
 {$ifndef FPC}
+{$ifndef DELPHI_3}
 
 
 procedure TDbf.InternalInsert; {override virtual from TDataset}
 procedure TDbf.InternalInsert; {override virtual from TDataset}
 begin
 begin
   CursorPosChanged;
   CursorPosChanged;
 end;
 end;
 
 
+{$endif}
 {$endif}
 {$endif}
 
 
 procedure TDbf.InternalPost; {override virtual abstract from TDataset}
 procedure TDbf.InternalPost; {override virtual abstract from TDataset}
@@ -1308,17 +1318,17 @@ begin
   pRecord := pDbfRecord(ActiveBuffer);
   pRecord := pDbfRecord(ActiveBuffer);
   // commit blobs
   // commit blobs
   for I := 0 to Pred(FieldCount) do
   for I := 0 to Pred(FieldCount) do
-    if Assigned(FBlobStreams[I]) then
-      FBlobStreams[I].Commit;
+    if Assigned(FBlobStreams^[I]) then
+      FBlobStreams^[I].Commit;
   if State = dsEdit then
   if State = dsEdit then
   begin
   begin
     // write changes
     // write changes
-    FDbfFile.UnlockRecord(FEditingRecNo, @pRecord.DeletedFlag);
+    FDbfFile.UnlockRecord(FEditingRecNo, @pRecord^.DeletedFlag);
     // not editing anymore
     // not editing anymore
     FEditingRecNo := -1;
     FEditingRecNo := -1;
   end else begin
   end else begin
     // insert
     // insert
-    newRecord := FDbfFile.Insert(@pRecord.DeletedFlag);
+    newRecord := FDbfFile.Insert(@pRecord^.DeletedFlag);
     if newRecord > 0 then
     if newRecord > 0 then
       FCursor.PhysicalRecNo := newRecord;
       FCursor.PhysicalRecNo := newRecord;
   end;
   end;
@@ -1395,7 +1405,7 @@ procedure TDbf.CreateTableEx(DbfFieldDefs: TDbfFieldDefs);
 var
 var
   I: Integer;
   I: Integer;
   lIndex: TDbfIndexDef;
   lIndex: TDbfIndexDef;
-  IndexName: string;
+  lIndexName: string;
   tempFieldDefs: Boolean;
   tempFieldDefs: Boolean;
 begin
 begin
   CheckInactive;
   CheckInactive;
@@ -1447,8 +1457,8 @@ begin
       for I := 0 to FIndexDefs.Count-1 do
       for I := 0 to FIndexDefs.Count-1 do
       begin
       begin
         lIndex := FIndexDefs.Items[I];
         lIndex := FIndexDefs.Items[I];
-        IndexName := ParseIndexName(lIndex.IndexFile);
-        FDbfFile.OpenIndex(IndexName, lIndex.SortField, true, lIndex.Options);
+        lIndexName := ParseIndexName(lIndex.IndexFile);
+        FDbfFile.OpenIndex(lIndexName, lIndex.SortField, true, lIndex.Options);
       end;
       end;
     except
     except
       // dbf file created?
       // dbf file created?
@@ -1569,6 +1579,7 @@ begin
   CheckBrowseMode;
   CheckBrowseMode;
   DoBeforeScroll;
   DoBeforeScroll;
   Result := false;
   Result := false;
+  UpdateCursorPos;
   oldRecNo := RecNo;
   oldRecNo := RecNo;
   try
   try
     FFindRecordFilter := true;
     FFindRecordFilter := true;
@@ -1583,9 +1594,13 @@ begin
   finally
   finally
     FFindRecordFilter := false;
     FFindRecordFilter := false;
     if not Result then
     if not Result then
+    begin
       RecNo := oldRecNo;
       RecNo := oldRecNo;
-    CursorPosChanged;
-    Resync([]);
+    end else begin
+      CursorPosChanged;
+      Resync([]);
+      DoAfterScroll;
+    end;
   end;
   end;
 end;
 end;
 
 
@@ -1819,16 +1834,16 @@ begin
   // check if in editing mode if user wants to write
   // check if in editing mode if user wants to write
   if (Mode = bmWrite) or (Mode = bmReadWrite) then
   if (Mode = bmWrite) or (Mode = bmReadWrite) then
     if not (State in [dsEdit, dsInsert]) then
     if not (State in [dsEdit, dsInsert]) then
-{$ifdef DELPHI_3}
+{$ifdef DELPHI_3}    
       DatabaseError(SNotEditing);
       DatabaseError(SNotEditing);
-{$else}
+{$else}    
       DatabaseError(SNotEditing, Self);
       DatabaseError(SNotEditing, Self);
-{$endif}
+{$endif}      
   // already created a `placeholder' blob for this field?
   // already created a `placeholder' blob for this field?
   MemoFieldNo := Field.FieldNo - 1;
   MemoFieldNo := Field.FieldNo - 1;
-  if FBlobStreams[MemoFieldNo] = nil then
-    FBlobStreams[MemoFieldNo] := TDbfBlobStream.Create(Field);
-  lBlob := FBlobStreams[MemoFieldNo].AddReference;
+  if FBlobStreams^[MemoFieldNo] = nil then
+    FBlobStreams^[MemoFieldNo] := TDbfBlobStream.Create(Field);
+  lBlob := FBlobStreams^[MemoFieldNo].AddReference;
   // update pageno of blob <-> location where to read/write in memofile
   // update pageno of blob <-> location where to read/write in memofile
   if FDbfFile.GetFieldData(Field.FieldNo-1, ftInteger, GetCurrentBuffer, @MemoPageNo) then
   if FDbfFile.GetFieldData(Field.FieldNo-1, ftInteger, GetCurrentBuffer, @MemoPageNo) then
   begin
   begin
@@ -1846,7 +1861,7 @@ begin
       lBlob.ReadSize := 0;
       lBlob.ReadSize := 0;
     end;
     end;
     lBlob.MemoRecNo := MemoPageNo;
     lBlob.MemoRecNo := MemoPageNo;
-  end else
+  end else 
   if not lBlob.Dirty or (Mode = bmWrite) then
   if not lBlob.Dirty or (Mode = bmWrite) then
   begin
   begin
     // reading and memo is empty and not written yet, or rewriting
     // reading and memo is empty and not written yet, or rewriting
@@ -1855,7 +1870,7 @@ begin
     lBlob.MemoRecNo := 0;
     lBlob.MemoRecNo := 0;
   end;
   end;
   { this is a hack, we actually need to know per user who's modifying, and who is not }
   { this is a hack, we actually need to know per user who's modifying, and who is not }
-  { Mode is more like: the mode of the last "creation"
+  { Mode is more like: the mode of the last "creation" }
   { if create/free is nested, then everything will be alright, i think ;-) }
   { if create/free is nested, then everything will be alright, i think ;-) }
   lBlob.Mode := Mode;
   lBlob.Mode := Mode;
   { this is a hack: we actually need to know per user what it's position is }
   { this is a hack: we actually need to know per user what it's position is }
@@ -1929,11 +1944,11 @@ end;
 
 
 procedure TDbf.ClearCalcFields(Buffer: PChar);
 procedure TDbf.ClearCalcFields(Buffer: PChar);
 var
 var
-  RealBuffer, CalcBuffer: PChar;
+  lRealBuffer, lCalcBuffer: PChar;
 begin
 begin
-  RealBuffer := @pDbfRecord(Buffer).DeletedFlag;
-  CalcBuffer := RealBuffer + FDbfFile.RecordSize;
-  FillChar(CalcBuffer^, CalcFieldsSize, 0);
+  lRealBuffer := @pDbfRecord(Buffer)^.DeletedFlag;
+  lCalcBuffer := lRealBuffer + FDbfFile.RecordSize;
+  FillChar(lCalcBuffer^, CalcFieldsSize, 0);
 end;
 end;
 
 
 procedure TDbf.InternalSetToRecord(Buffer: PChar); {override virtual abstract from TDataset}
 procedure TDbf.InternalSetToRecord(Buffer: PChar); {override virtual abstract from TDataset}
@@ -1943,11 +1958,11 @@ begin
   if Buffer <> nil then
   if Buffer <> nil then
   begin
   begin
     pRecord := pDbfRecord(Buffer);
     pRecord := pDbfRecord(Buffer);
-    if pRecord.BookmarkFlag = bfInserted then
+    if pRecord^.BookmarkFlag = bfInserted then
     begin
     begin
       // do what ???
       // do what ???
     end else begin
     end else begin
-      FCursor.SequentialRecNo := pRecord.SequentialRecNo;
+      FCursor.SequentialRecNo := pRecord^.SequentialRecNo;
     end;
     end;
   end;
   end;
 end;
 end;
@@ -1980,11 +1995,11 @@ begin
   if (Field.FieldNo >= 0) then
   if (Field.FieldNo >= 0) then
   begin
   begin
     pRecord := pDbfRecord(ActiveBuffer);
     pRecord := pDbfRecord(ActiveBuffer);
-    dst := @pRecord.DeletedFlag;
+    dst := @pRecord^.DeletedFlag;
     FDbfFile.SetFieldData(Field.FieldNo - 1,Field.DataType,Buffer,Dst);
     FDbfFile.SetFieldData(Field.FieldNo - 1,Field.DataType,Buffer,Dst);
   end else begin    { ***** fkCalculated, fkLookup ***** }
   end else begin    { ***** fkCalculated, fkLookup ***** }
     pRecord := pDbfRecord(CalcBuffer);
     pRecord := pDbfRecord(CalcBuffer);
-    Dst := @pRecord.DeletedFlag;
+    Dst := @pRecord^.DeletedFlag;
     Inc(PChar(Dst), RecordSize + Field.Offset);
     Inc(PChar(Dst), RecordSize + Field.Offset);
 //    Boolean(dst^) := LongBool(Buffer);
 //    Boolean(dst^) := LongBool(Buffer);
 //    if Boolean(dst^) then begin
 //    if Boolean(dst^) then begin
@@ -2012,7 +2027,7 @@ begin
 
 
   // check if FCursor open
   // check if FCursor open
   if FCursor = nil then
   if FCursor = nil then
-    exit;
+    exit; 
 
 
   // store current position
   // store current position
   prevRecNo := FCursor.SequentialRecNo;
   prevRecNo := FCursor.SequentialRecNo;
@@ -2124,7 +2139,7 @@ begin
   inherited;
   inherited;
 
 
   // refilter dataset if filtered
   // refilter dataset if filtered
-  if (FDbfFile <> nil) and Filtered then Resync([]);
+  if (FDbfFile <> nil) and Filtered then Refresh;
 end;
 end;
 
 
 procedure TDbf.SetFiltered(Value: Boolean); {override;}
 procedure TDbf.SetFiltered(Value: Boolean); {override;}
@@ -2137,11 +2152,7 @@ begin
 
 
   // only refresh if active
   // only refresh if active
   if FCursor <> nil then
   if FCursor <> nil then
-  begin
-    UpdateCursorPos;
-    CursorPosChanged;
-    Resync([]);
-  end;
+    Refresh;
 end;
 end;
 
 
 procedure TDbf.SetFilePath(const Value: string);
 procedure TDbf.SetFilePath(const Value: string);
@@ -2156,7 +2167,7 @@ begin
   begin
   begin
     FAbsolutePath := IncludeTrailingPathDelimiter(Value);
     FAbsolutePath := IncludeTrailingPathDelimiter(Value);
   end else begin
   end else begin
-    FAbsolutePath := GetCompletePath(DbfBasePath, FRelativePath);
+    FAbsolutePath := GetCompletePath(DbfBasePath(), FRelativePath);
   end;
   end;
 end;
 end;
 
 
@@ -2184,7 +2195,7 @@ end;
 procedure TDbf.SetLanguageID(NewID: Byte);
 procedure TDbf.SetLanguageID(NewID: Byte);
 begin
 begin
   CheckInactive;
   CheckInactive;
-
+  
   FLanguageID := NewID;
   FLanguageID := NewID;
 end;
 end;
 
 
@@ -2252,16 +2263,16 @@ begin
 end;
 end;
 
 
 {$ifdef SUPPORT_DEFAULT_PARAMS}
 {$ifdef SUPPORT_DEFAULT_PARAMS}
-procedure TDbf.AddIndex(const AIndexName, Fields: String; Options: TIndexOptions; const DescFields: String='');
+procedure TDbf.AddIndex(const AIndexName, AFields: String; Options: TIndexOptions; const DescFields: String='');
 {$else}
 {$else}
-procedure TDbf.AddIndex(const AIndexName, Fields: String; Options: TIndexOptions);
+procedure TDbf.AddIndex(const AIndexName, AFields: String; Options: TIndexOptions);
 {$endif}
 {$endif}
 var
 var
   lIndexFileName: string;
   lIndexFileName: string;
 begin
 begin
   CheckActive;
   CheckActive;
   lIndexFileName := ParseIndexName(AIndexName);
   lIndexFileName := ParseIndexName(AIndexName);
-  FDbfFile.OpenIndex(lIndexFileName, Fields, true, Options);
+  FDbfFile.OpenIndex(lIndexFileName, AFields, true, Options);
 
 
   // refresh our indexdefs
   // refresh our indexdefs
   InternalInitFieldDefs;
   InternalInitFieldDefs;
@@ -2269,7 +2280,7 @@ end;
 
 
 procedure TDbf.SetIndexName(AIndexName: string);
 procedure TDbf.SetIndexName(AIndexName: string);
 var
 var
-  RecNo: Integer;
+  lRecNo: Integer;
 begin
 begin
   FIndexName := AIndexName;
   FIndexName := AIndexName;
   if FDbfFile = nil then
   if FDbfFile = nil then
@@ -2278,13 +2289,13 @@ begin
   // get accompanying index file
   // get accompanying index file
   AIndexName := ParseIndexName(Trim(AIndexName));
   AIndexName := ParseIndexName(Trim(AIndexName));
   FIndexFile := FDbfFile.GetIndexByName(AIndexName);
   FIndexFile := FDbfFile.GetIndexByName(AIndexName);
-  // store current recno
+  // store current lRecNo
   if FCursor = nil then
   if FCursor = nil then
   begin
   begin
-    RecNo := 1;
+    lRecNo := 1;
   end else begin
   end else begin
     UpdateCursorPos;
     UpdateCursorPos;
-    RecNo := FCursor.PhysicalRecNo;
+    lRecNo := FCursor.PhysicalRecNo;
   end;
   end;
   // select new cursor
   // select new cursor
   FreeAndNil(FCursor);
   FreeAndNil(FCursor);
@@ -2299,8 +2310,8 @@ begin
     FCursor := TDbfCursor.Create(FDbfFile);
     FCursor := TDbfCursor.Create(FDbfFile);
     FIndexName := EmptyStr;
     FIndexName := EmptyStr;
   end;
   end;
-  // reset previous recno
-  FCursor.PhysicalRecNo := RecNo;
+  // reset previous lRecNo
+  FCursor.PhysicalRecNo := lRecNo;
   // refresh records
   // refresh records
   if State = dsBrowse then
   if State = dsBrowse then
     Resync([]);
     Resync([]);
@@ -2384,7 +2395,7 @@ var
   I: Integer;
   I: Integer;
 begin
 begin
   Strings.Clear;
   Strings.Clear;
-  if FDbfFile = nil then
+  if FDbfFile <> nil then
   begin
   begin
     if dfDbf in Files then
     if dfDbf in Files then
       Strings.Add(FDbfFile.FileName);
       Strings.Add(FDbfFile.FileName);
@@ -2393,7 +2404,8 @@ begin
     if dfIndex in Files then
     if dfIndex in Files then
       for I := 0 to Pred(FDbfFile.IndexFiles.Count) do
       for I := 0 to Pred(FDbfFile.IndexFiles.Count) do
         Strings.Add(TPagedFile(FDbfFile.IndexFiles.Items[I]).FileName);
         Strings.Add(TPagedFile(FDbfFile.IndexFiles.Items[I]).FileName);
-  end;
+  end else
+    Strings.Add(IncludeTrailingPathDelimiter(FilePathFull) + TableName);   
 end;
 end;
 
 
 {$ifdef SUPPORT_DEFAULT_PARAMS}
 {$ifdef SUPPORT_DEFAULT_PARAMS}
@@ -2404,20 +2416,12 @@ function TDbf.GetFileNamesString(Files: TDbfFileNames ): string;
 var
 var
   sl: TStrings;
   sl: TStrings;
 begin
 begin
-  if Files = [dfDbf] then
-  begin
-    //even if closed!
-    // do it myself, since it is rather faster than the code below
-    Result := IncludeTrailingPathDelimiter(FilePathFull) + TableName;
-  end else begin
-    CheckActive;
-    sl := TStringList.Create;
-    try
-      GetFileNames(sl, Files);
-      Result := sl.Text;
-    finally
-      sl.Free
-    end;
+  sl := TStringList.Create;
+  try
+    GetFileNames(sl, Files);
+    Result := sl.Text;
+  finally
+    sl.Free;
   end;
   end;
 end;
 end;
 
 
@@ -2489,7 +2493,7 @@ begin
     FShowDeleted := Value;
     FShowDeleted := Value;
     // refresh view only if active
     // refresh view only if active
     if FCursor <> nil then
     if FCursor <> nil then
-      Resync([]);
+      Refresh;
   end;
   end;
 end;
 end;
 
 
@@ -2527,7 +2531,7 @@ begin
   // disable current range if any
   // disable current range if any
   FIndexFile.CancelRange;
   FIndexFile.CancelRange;
   // reretrieve previous and next records
   // reretrieve previous and next records
-  Resync([]);
+  Refresh;
 end;
 end;
 
 
 procedure TDbf.SetRangeBuffer(LowRange: PChar; HighRange: PChar);
 procedure TDbf.SetRangeBuffer(LowRange: PChar; HighRange: PChar);
@@ -2614,7 +2618,7 @@ begin
     Result := nil;
     Result := nil;
     exit;
     exit;
   end;
   end;
-
+  
   Result := TIndexCursor(FCursor).IndexFile.PrepareKey(Buffer, BufferType);
   Result := TIndexCursor(FCursor).IndexFile.PrepareKey(Buffer, BufferType);
 end;
 end;
 
 
@@ -2691,7 +2695,7 @@ begin
   fieldsVal := TIndexCursor(FCursor).IndexFile.PrepareKey(fieldsVal, FMasterLink.Parser.ResultType);
   fieldsVal := TIndexCursor(FCursor).IndexFile.PrepareKey(fieldsVal, FMasterLink.Parser.ResultType);
   SetRangeBuffer(fieldsVal, fieldsVal);
   SetRangeBuffer(fieldsVal, fieldsVal);
 end;
 end;
-
+    
 procedure TDbf.MasterChanged(Sender: TObject);
 procedure TDbf.MasterChanged(Sender: TObject);
 begin
 begin
   CheckBrowseMode;
   CheckBrowseMode;
@@ -2719,7 +2723,7 @@ begin
     DatabaseError(SCircularDataLink);
     DatabaseError(SCircularDataLink);
 {$endif}
 {$endif}
   end;
   end;
-{$endif}
+{$endif}  
   FMasterLink.DataSource := Value;
   FMasterLink.DataSource := Value;
 end;
 end;
 
 
@@ -2876,7 +2880,7 @@ end;
 
 
 function TDbfMasterLink.GetFieldsVal: PChar;
 function TDbfMasterLink.GetFieldsVal: PChar;
 begin
 begin
-  Result := FParser.ExtractFromBuffer(@pDbfRecord(TDbf(DataSet).ActiveBuffer).DeletedFlag);
+  Result := FParser.ExtractFromBuffer(@pDbfRecord(TDbf(DataSet).ActiveBuffer)^.DeletedFlag);
 end;
 end;
 
 
 ////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////
@@ -2894,3 +2898,4 @@ initialization
   DbfBasePath := ApplicationPath;
   DbfBasePath := ApplicationPath;
 
 
 end.
 end.
+

+ 40 - 84
fcl/db/dbase/dbf_common.pas

@@ -2,22 +2,22 @@ unit dbf_common;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   SysUtils, Classes, DB
   SysUtils, Classes, DB
 {$ifndef WIN32}
 {$ifndef WIN32}
-  , Types, Dbf_Wtil
+  , Types, dbf_wtil
 {$ifdef KYLIX}
 {$ifdef KYLIX}
   , Libc
   , Libc
-{$endif}
+{$endif}  
 {$endif}
 {$endif}
   ;
   ;
 
 
 
 
 const
 const
   TDBF_MAJOR_VERSION      = 6;
   TDBF_MAJOR_VERSION      = 6;
-  TDBF_MINOR_VERSION      = 41;
+  TDBF_MINOR_VERSION      = 45;
   TDBF_SUB_MINOR_VERSION  = 0;
   TDBF_SUB_MINOR_VERSION  = 0;
 
 
   TDBF_TABLELEVEL_FOXPRO = 25;
   TDBF_TABLELEVEL_FOXPRO = 25;
@@ -108,6 +108,13 @@ function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PChar; Length: Integ
 // Does not stop at null (#0) terminator!
 // Does not stop at null (#0) terminator!
 function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;
 function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;
 
 
+// Delphi 3 does not have a Min function
+{$ifdef DELPHI_3}
+{$ifndef DELPHI_4}
+function Min(x, y: integer): integer;
+{$endif}
+{$endif}
+
 implementation
 implementation
 
 
 {$ifdef WIN32}
 {$ifdef WIN32}
@@ -167,44 +174,10 @@ end;
 procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar; const PadChar: Char);
 procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PChar; const PadChar: Char);
 var
 var
   Temp: array[0..10] of Char;
   Temp: array[0..10] of Char;
-  I, J, K: Integer;
+  I, J: Integer;
   NegSign: boolean;
   NegSign: boolean;
 begin
 begin
-  if Width <= 0 then
-    exit;
-
-  NegSign := Val < 0;
-  Val := Abs(Val);
-  // we'll have to store characters backwards first
-  I := 0;
-  J := 0;
-  repeat
-    Temp[I] := Chr((Val mod 10) + Ord('0'));
-    Val := Val div 10;
-    Inc(I);
-  until Val = 0;
-  // add sign
-  if NegSign then
-  begin
-    Dst[J] := '-';
-    Inc(J);
-  end;
-  // add spaces
-  for K := 0 to Width - I - J - 1 do
-  begin
-    Dst[J] := PadChar;
-    Inc(J);
-  end;
-  // if field too long, cut off
-  if J + I > Width then
-    I := Width - J;
-  // copy value, remember: stored backwards
-  repeat
-    Dst[J] := Temp[I-1];
-    Inc(J);
-    Dec(I);
-  until I = 0;
-  // done!
+  {$I getstrfromint.inc}
 end;
 end;
 
 
 {$ifdef SUPPORT_INT64}
 {$ifdef SUPPORT_INT64}
@@ -212,44 +185,10 @@ end;
 procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char);
 procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PChar; const PadChar: Char);
 var
 var
   Temp: array[0..19] of Char;
   Temp: array[0..19] of Char;
-  I, J, K: Integer;
+  I, J: Integer;
   NegSign: boolean;
   NegSign: boolean;
 begin
 begin
-  if Width <= 0 then
-    exit;
-
-  NegSign := Val < 0;
-  Val := Abs(Val);
-  // we'll have to store characters backwards first
-  I := 0;
-  J := 0;
-  repeat
-    Temp[I] := Chr((Val mod 10) + Ord('0'));
-    Val := Val div 10;
-    inc(I);
-  until Val = 0;
-  // add sign
-  if NegSign then
-  begin
-    Dst[J] := '-';
-    inc(J);
-  end;
-  // add spaces
-  for K := 0 to Width - I - J - 1 do
-  begin
-    Dst[J] := PadChar;
-    inc(J);
-  end;
-  // if field too long, cut off
-  if J + I > Width then
-    I := Width - J;
-  // copy value, remember: stored backwards
-  repeat
-    Dst[J] := Temp[I-1];
-    inc(J);
-    dec(I);
-  until I = 0;
-  // done!
+  {$I getstrfromint.inc}
 end;
 end;
 
 
 {$endif}
 {$endif}
@@ -403,19 +342,19 @@ end;
 
 
 {$ifdef USE_ASSEMBLER_486_UP}
 {$ifdef USE_ASSEMBLER_486_UP}
 
 
-function SwapInt(const Value: Cardinal): Cardinal; register;
+function SwapInt(const Value: Cardinal): Cardinal; register; assembler;
 asm
 asm
   BSWAP EAX;
   BSWAP EAX;
 end;
 end;
 
 
-procedure SwapInt64(Value {EAX}, Result {EDX}: Pointer); register;
+procedure SwapInt64(Value {EAX}, Result {EDX}: Pointer); register; assembler;
 asm
 asm
-  MOV ECX, dword ptr [EAX]
-  MOV EAX, dword ptr [EAX + 4]
-  BSWAP ECX
-  BSWAP EAX
-  MOV dword ptr [EDX+4], ECX
-  MOV dword ptr [EDX], EAX
+  MOV ECX, dword ptr [EAX] 
+  MOV EAX, dword ptr [EAX + 4] 
+  BSWAP ECX 
+  BSWAP EAX 
+  MOV dword ptr [EDX+4], ECX 
+  MOV dword ptr [EDX], EAX 
 end;
 end;
 
 
 {$else}
 {$else}
@@ -516,4 +455,21 @@ end;
 
 
 {$endif}
 {$endif}
 
 
+{$ifdef DELPHI_3}
+{$ifndef DELPHI_4}
+
+function Min(x, y: integer): integer;
+begin
+  if x < y then
+    result := x
+  else
+    result := y;
+end;
+
+{$endif}
+{$endif}
+
 end.
 end.
+
+
+

+ 4 - 3
fcl/db/dbase/dbf_cursor.pas

@@ -2,13 +2,13 @@ unit dbf_cursor;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   SysUtils,
   SysUtils,
   Classes,
   Classes,
-  Dbf_PgFile,
-  Dbf_Common;
+  dbf_pgfile,
+  dbf_common;
 
 
 type
 type
 
 
@@ -61,3 +61,4 @@ begin
 end;
 end;
 
 
 end.
 end.
+

+ 161 - 122
fcl/db/dbase/dbf_dbffile.pas

@@ -2,25 +2,28 @@ unit dbf_dbffile;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
-  Classes, SysUtils, Math,
+  Classes, SysUtils,
+{$ifdef SUPPORT_MATH_UNIT}
+  Math,
+{$endif}
 {$ifdef WIN32}
 {$ifdef WIN32}
   Windows,
   Windows,
 {$else}
 {$else}
 {$ifdef KYLIX}
 {$ifdef KYLIX}
-  Libc,
-{$endif}
-  Types, Dbf_Wtil,
+  Libc, 
+{$endif}  
+  Types, dbf_wtil,
 {$endif}
 {$endif}
   Db,
   Db,
-  Dbf_Common,
-  Dbf_Cursor,
-  Dbf_PgFile,
-  Dbf_Fields,
-  Dbf_Memo,
-  Dbf_IdxFile;
+  dbf_common,
+  dbf_cursor,
+  dbf_pgfile,
+  dbf_fields,
+  dbf_memo,
+  dbf_idxfile;
 
 
 //====================================================================
 //====================================================================
 //=== Dbf support (first part)
 //=== Dbf support (first part)
@@ -72,7 +75,7 @@ type
     function GetLanguageStr: string;
     function GetLanguageStr: string;
     function GetUseFloatFields: Boolean;
     function GetUseFloatFields: Boolean;
     procedure SetUseFloatFields(NewUse: Boolean);
     procedure SetUseFloatFields(NewUse: Boolean);
-
+    
   protected
   protected
     procedure ConstructFieldDefs;
     procedure ConstructFieldDefs;
     procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField);
     procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField);
@@ -102,6 +105,7 @@ type
     procedure ApplyAutoIncToBuffer(DestBuf: PChar);     // dBase7 support. Writeback last next-autoinc value
     procedure ApplyAutoIncToBuffer(DestBuf: PChar);     // dBase7 support. Writeback last next-autoinc value
     procedure FastPackTable;
     procedure FastPackTable;
     procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
     procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
+    procedure Rename(DestFileName: string; NewIndexFileNames: TStrings; DeleteFiles: boolean);
     function  GetFieldInfo(FieldName: string): TDbfFieldDef;
     function  GetFieldInfo(FieldName: string): TDbfFieldDef;
     function  GetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer): Boolean;
     function  GetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer): Boolean;
     function  GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType; Src, Dst: Pointer): Boolean;
     function  GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType; Src, Dst: Pointer): Boolean;
@@ -163,7 +167,7 @@ type
     FDefaultCreateLangId: Byte;
     FDefaultCreateLangId: Byte;
     FUserName: string;
     FUserName: string;
     FUserNameLen: DWORD;
     FUserNameLen: DWORD;
-
+	
     function  GetDefaultCreateCodePage: Integer;
     function  GetDefaultCreateCodePage: Integer;
     procedure SetDefaultCreateCodePage(NewCodePage: Integer);
     procedure SetDefaultCreateCodePage(NewCodePage: Integer);
     procedure InitUserName;
     procedure InitUserName;
@@ -194,12 +198,12 @@ uses
   BaseUnix,
   BaseUnix,
 {$endif}
 {$endif}
 {$endif}
 {$endif}
-  Dbf_Str, Dbf_Lang;
+  dbf_str, dbf_lang;
 
 
 const
 const
   sDBF_DEC_SEP = '.';
   sDBF_DEC_SEP = '.';
 
 
-{$I Dbf_Struct.inc}
+{$I dbf_struct.inc}
 
 
 //====================================================================
 //====================================================================
 // International separator
 // International separator
@@ -245,6 +249,9 @@ var
 begin
 begin
   // convert to temporary buffer
   // convert to temporary buffer
   resLen := FloatToText(@Buffer[0], Val, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, Size, Precision);
   resLen := FloatToText(@Buffer[0], Val, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, Size, Precision);
+  // prevent overflow in destination buffer
+  if resLen > Size then
+    resLen := Size;
   // null-terminate buffer
   // null-terminate buffer
   Buffer[resLen] := #0;
   Buffer[resLen] := #0;
   // we only have to convert if decimal separator different
   // we only have to convert if decimal separator different
@@ -358,7 +365,7 @@ begin
       //  $03,$8B dBaseIV/V       Header Byte $1d=$00, Float -> N($14.$05) DateTime D($08)
       //  $03,$8B dBaseIV/V       Header Byte $1d=$00, Float -> N($14.$05) DateTime D($08)
       //  $03,$F5 FoxPro Level 25 Header Byte $1d=$09, Float -> N($14.$05) DateTime D($08)
       //  $03,$F5 FoxPro Level 25 Header Byte $1d=$09, Float -> N($14.$05) DateTime D($08)
 
 
-      version := PDbfHdr(Header).VerDBF;
+      version := PDbfHdr(Header)^.VerDBF;
       case (version and $07) of
       case (version and $07) of
         $03:
         $03:
           if LanguageID = 0 then
           if LanguageID = 0 then
@@ -380,8 +387,8 @@ begin
         end;
         end;
       end;
       end;
       FFieldDefs.DbfVersion := FDbfVersion;
       FFieldDefs.DbfVersion := FDbfVersion;
-      RecordSize := PDbfHdr(Header).RecordSize;
-      HeaderSize := PDbfHdr(Header).FullHdrSize;
+      RecordSize := PDbfHdr(Header)^.RecordSize;
+      HeaderSize := PDbfHdr(Header)^.FullHdrSize;
       if (HeaderSize = 0) or (RecordSize = 0) then
       if (HeaderSize = 0) or (RecordSize = 0) then
       begin
       begin
         HeaderSize := 0;
         HeaderSize := 0;
@@ -391,21 +398,21 @@ begin
         exit;
         exit;
       end;
       end;
       // check if specified recordcount correct
       // check if specified recordcount correct
-      if PDbfHdr(Header).RecordCount <> RecordCount then
+      if PDbfHdr(Header)^.RecordCount <> RecordCount then
       begin
       begin
         // This message was annoying
         // This message was annoying
         // and was not understood by most people
         // and was not understood by most people
         // ShowMessage('Invalid Record Count,'+^M+
         // ShowMessage('Invalid Record Count,'+^M+
         //             'RecordCount in Hdr : '+IntToStr(PDbfHdr(Header).RecordCount)+^M+
         //             'RecordCount in Hdr : '+IntToStr(PDbfHdr(Header).RecordCount)+^M+
         //             'expected : '+IntToStr(RecordCount));
         //             'expected : '+IntToStr(RecordCount));
-        PDbfHdr(Header).RecordCount := RecordCount;
+        PDbfHdr(Header)^.RecordCount := RecordCount;
         WriteHeader;        // Correct it
         WriteHeader;        // Correct it
       end;
       end;
       // determine codepage
       // determine codepage
       if FDbfVersion >= xBaseVII then
       if FDbfVersion >= xBaseVII then
       begin
       begin
         // cache language str
         // cache language str
-        LangStr := @PAfterHdrVII(PChar(Header) + SizeOf(rDbfHdr)).LanguageDriverName;
+        LangStr := @PAfterHdrVII(PChar(Header) + SizeOf(rDbfHdr))^.LanguageDriverName;
         // VdBase 7 Language strings
         // VdBase 7 Language strings
         //  'DBWIN...' -> Charset 1252 (ansi)
         //  'DBWIN...' -> Charset 1252 (ansi)
         //  'DB999...' -> Code page 999, 9 any digit
         //  'DB999...' -> Code page 999, 9 any digit
@@ -438,7 +445,7 @@ begin
         FFileLangId := GetLangId_From_LangName(LanguageStr);
         FFileLangId := GetLangId_From_LangName(LanguageStr);
       end else begin
       end else begin
         // FDbfVersion <= xBaseV
         // FDbfVersion <= xBaseV
-        FFileLangId := PDbfHdr(Header).Language;
+        FFileLangId := PDbfHdr(Header)^.Language;
         FFileCodePage := LangId_To_CodePage[FFileLangId];
         FFileCodePage := LangId_To_CodePage[FFileLangId];
       end;
       end;
       // determine used codepage, if no codepage, then use default codepage
       // determine used codepage, if no codepage, then use default codepage
@@ -467,12 +474,12 @@ begin
         FMemoFile.Open;
         FMemoFile.Open;
         // set header blob flag corresponding to field list
         // set header blob flag corresponding to field list
         if FDbfVersion <> xFoxPro then
         if FDbfVersion <> xFoxPro then
-          PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF or $80;
+          PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80;
       end else
       end else
         if FDbfVersion <> xFoxPro then
         if FDbfVersion <> xFoxPro then
-          PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF and $7F;
+          PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF and $7F;
       // check if mdx flagged
       // check if mdx flagged
-      if (FDbfVersion <> xFoxPro) and (PDbfHdr(Header).MDXFlag <> 0) then
+      if (FDbfVersion <> xFoxPro) and (PDbfHdr(Header)^.MDXFlag <> 0) then
       begin
       begin
         // open mdx file if present
         // open mdx file if present
         lMdxFileName := ChangeFileExt(FileName, '.mdx');
         lMdxFileName := ChangeFileExt(FileName, '.mdx');
@@ -503,7 +510,7 @@ begin
             FOnIndexMissing(deleteLink);
             FOnIndexMissing(deleteLink);
           // correct flag
           // correct flag
           if deleteLink then
           if deleteLink then
-            PDbfHdr(Header).MDXFlag := 0
+            PDbfHdr(Header)^.MDXFlag := 0
           else
           else
             FForceClose := true;
             FForceClose := true;
         end;
         end;
@@ -527,7 +534,7 @@ begin
     for I := 0 to FIndexFiles.Count - 1 do
     for I := 0 to FIndexFiles.Count - 1 do
     begin
     begin
       TIndexFile(FIndexFiles.Items[I]).Close;
       TIndexFile(FIndexFiles.Items[I]).Close;
-      if FIndexFiles.Items[I] = FMdxFile then
+      if TIndexFile(FIndexFiles.Items[I]) = FMdxFile then
         MdxIndex := I;
         MdxIndex := I;
     end;
     end;
     // free memo file if any
     // free memo file if any
@@ -587,11 +594,11 @@ begin
       HeaderSize := SizeOf(rDbfHdr) + SizeOf(rAfterHdrVII);
       HeaderSize := SizeOf(rDbfHdr) + SizeOf(rAfterHdrVII);
       RecordSize := SizeOf(rFieldDescVII);
       RecordSize := SizeOf(rFieldDescVII);
       FillChar(Header^, HeaderSize, #0);
       FillChar(Header^, HeaderSize, #0);
-      PDbfHdr(Header).VerDBF := $04;
+      PDbfHdr(Header)^.VerDBF := $04;
       // write language string
       // write language string
       StrPLCopy(
       StrPLCopy(
-        @PAfterHdrVII(PChar(Header)+SizeOf(rDbfHdr)).LanguageDriverName[32],
-        ConstructLangName(FFileCodePage, lLocaleID, false),
+        @PAfterHdrVII(PChar(Header)+SizeOf(rDbfHdr))^.LanguageDriverName[32],
+        ConstructLangName(FFileCodePage, lLocaleID, false), 
         63-32);
         63-32);
       lFieldDescPtr := @lFieldDescVII;
       lFieldDescPtr := @lFieldDescVII;
     end else begin
     end else begin
@@ -601,14 +608,14 @@ begin
       FillChar(Header^, HeaderSize, #0);
       FillChar(Header^, HeaderSize, #0);
       if FDbfVersion = xFoxPro then
       if FDbfVersion = xFoxPro then
       begin
       begin
-        PDbfHdr(Header).VerDBF := $02
+        PDbfHdr(Header)^.VerDBF := $02
       end else
       end else
-        PDbfHdr(Header).VerDBF := $03;
+        PDbfHdr(Header)^.VerDBF := $03;
       // standard language WE, dBase III no language support
       // standard language WE, dBase III no language support
       if FDbfVersion = xBaseIII then
       if FDbfVersion = xBaseIII then
-        PDbfHdr(Header).Language := 0
+        PDbfHdr(Header)^.Language := 0
       else
       else
-        PDbfHdr(Header).Language := FFileLangId;
+        PDbfHdr(Header)^.Language := FFileLangId;
       // init field ptr
       // init field ptr
       lFieldDescPtr := @lFieldDescIII;
       lFieldDescPtr := @lFieldDescIII;
     end;
     end;
@@ -663,10 +670,10 @@ begin
         // TODO: bug-endianness
         // TODO: bug-endianness
         if FDbfVersion = xFoxPro then
         if FDbfVersion = xFoxPro then
           lFieldDescIII.FieldOffset := lFieldOffset;
           lFieldDescIII.FieldOffset := lFieldOffset;
-        if (PDbfHdr(Header).VerDBF = $02) and (lFieldDef.NativeFieldType in ['0', 'Y', 'T', 'O', '+']) then
-          PDbfHdr(Header).VerDBF := $30;
-        if (PDbfHdr(Header).VerDBF = $30) and (lFieldDef.NativeFieldType = '+') then
-          PDbfHdr(Header).VerDBF := $31;
+        if (PDbfHdr(Header)^.VerDBF = $02) and (lFieldDef.NativeFieldType in ['0', 'Y', 'T', 'O', '+']) then
+          PDbfHdr(Header)^.VerDBF := $30;
+        if (PDbfHdr(Header)^.VerDBF = $30) and (lFieldDef.NativeFieldType = '+') then
+          PDbfHdr(Header)^.VerDBF := $31;
       end;
       end;
 
 
       // update our field list
       // update our field list
@@ -688,32 +695,32 @@ begin
     if lHasBlob then
     if lHasBlob then
     begin
     begin
       if FDbfVersion = xBaseIII then
       if FDbfVersion = xBaseIII then
-        PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF or $80
+        PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $80
       else
       else
       if FDbfVersion = xFoxPro then
       if FDbfVersion = xFoxPro then
       begin
       begin
-        if PDbfHdr(Header).VerDBF = $02 then
-          PDbfHdr(Header).VerDBF := $F5;
+        if PDbfHdr(Header)^.VerDBF = $02 then
+          PDbfHdr(Header)^.VerDBF := $F5;
       end else
       end else
-        PDbfHdr(Header).VerDBF := PDbfHdr(Header).VerDBF or $88;
+        PDbfHdr(Header)^.VerDBF := PDbfHdr(Header)^.VerDBF or $88;
     end;
     end;
 
 
     // update header
     // update header
-    PDbfHdr(Header).RecordSize := lFieldOffset;
-    PDbfHdr(Header).FullHdrSize := HeaderSize + RecordSize * FieldDefs.Count + 1;
-    // add empty "back-link" info, whatever it is:
-    { A 263-byte range that contains the backlink, which is the relative path of
-      an associated database (.dbc) file, information. If the first byte is 0x00,
-      the file is not associated with a database. Therefore, database files always
+    PDbfHdr(Header)^.RecordSize := lFieldOffset;
+    PDbfHdr(Header)^.FullHdrSize := HeaderSize + RecordSize * FieldDefs.Count + 1;
+    // add empty "back-link" info, whatever it is: 
+    { A 263-byte range that contains the backlink, which is the relative path of 
+      an associated database (.dbc) file, information. If the first byte is 0x00, 
+      the file is not associated with a database. Therefore, database files always 
       contain 0x00. }
       contain 0x00. }
     if FDbfVersion = xFoxPro then
     if FDbfVersion = xFoxPro then
-      Inc(PDbfHdr(Header).FullHdrSize, 263);
+      Inc(PDbfHdr(Header)^.FullHdrSize, 263);
 
 
     // write dbf header to disk
     // write dbf header to disk
     inherited WriteHeader;
     inherited WriteHeader;
   finally
   finally
-    RecordSize := PDbfHdr(Header).RecordSize;
-    HeaderSize := PDbfHdr(Header).FullHdrSize;
+    RecordSize := PDbfHdr(Header)^.RecordSize;
+    HeaderSize := PDbfHdr(Header)^.FullHdrSize;
 
 
     // write full header to disk (dbf+fields)
     // write full header to disk (dbf+fields)
     WriteHeader;
     WriteHeader;
@@ -738,14 +745,11 @@ end;
 function TDbfFile.HasBlob: Boolean;
 function TDbfFile.HasBlob: Boolean;
 var
 var
   I: Integer;
   I: Integer;
-  HasBlob: Boolean;
 begin
 begin
-  HasBlob := false;
+  Result := false;
   for I := 0 to FFieldDefs.Count-1 do
   for I := 0 to FFieldDefs.Count-1 do
-  begin
-    if FFieldDefs.Items[I].IsBlob then HasBlob := true;
-  end;
-  Result := HasBlob;
+    if FFieldDefs.Items[I].IsBlob then 
+      Result := true;
 end;
 end;
 
 
 function TDbfFile.GetMemoExt: string;
 function TDbfFile.GetMemoExt: string;
@@ -761,7 +765,7 @@ begin
   // make recordcount zero
   // make recordcount zero
   RecordCount := 0;
   RecordCount := 0;
   // update recordcount
   // update recordcount
-  PDbfHdr(Header).RecordCount := RecordCount;
+  PDbfHdr(Header)^.RecordCount := RecordCount;
   // update disk header
   // update disk header
   WriteHeader;
   WriteHeader;
   // update indexes
   // update indexes
@@ -780,9 +784,9 @@ begin
   //FillHeader(0);
   //FillHeader(0);
   lDataHdr := PDbfHdr(Header);
   lDataHdr := PDbfHdr(Header);
   GetLocalTime(SystemTime);
   GetLocalTime(SystemTime);
-  lDataHdr.Year := SystemTime.wYear - 1900;
-  lDataHdr.Month := SystemTime.wMonth;
-  lDataHdr.Day := SystemTime.wDay;
+  lDataHdr^.Year := SystemTime.wYear - 1900;
+  lDataHdr^.Month := SystemTime.wMonth;
+  lDataHdr^.Day := SystemTime.wDay;
 //  lDataHdr.RecordCount := RecordCount;
 //  lDataHdr.RecordCount := RecordCount;
   inherited WriteHeader;
   inherited WriteHeader;
 
 
@@ -822,7 +826,7 @@ begin
   FLockField := nil;
   FLockField := nil;
   FNullField := nil;
   FNullField := nil;
   FAutoIncPresent := false;
   FAutoIncPresent := false;
-  lColumnCount := (PDbfHdr(Header).FullHdrSize - lHeaderSize) div lFieldSize;
+  lColumnCount := (PDbfHdr(Header)^.FullHdrSize - lHeaderSize) div lFieldSize;
   lFieldOffset := 1;
   lFieldOffset := 1;
   lAutoInc := 0;
   lAutoInc := 0;
   I := 1;
   I := 1;
@@ -849,7 +853,7 @@ begin
         lSize := lFieldDescIII.FieldSize;
         lSize := lFieldDescIII.FieldSize;
         lPrec := lFieldDescIII.FieldPrecision;
         lPrec := lFieldDescIII.FieldPrecision;
         lNativeFieldType := lFieldDescIII.FieldType;
         lNativeFieldType := lFieldDescIII.FieldType;
-        lCanHoldNull := (FDbfVersion = xFoxPro) and
+        lCanHoldNull := (FDbfVersion = xFoxPro) and 
           ((lFieldDescIII.FoxProFlags and $2) <> 0) and
           ((lFieldDescIII.FoxProFlags and $2) <> 0) and
           (lFieldName <> '_NULLFLAGS');
           (lFieldName <> '_NULLFLAGS');
       end;
       end;
@@ -926,7 +930,7 @@ begin
 
 
     // dBase 7 -> read field properties, test if enough space, maybe no header
     // dBase 7 -> read field properties, test if enough space, maybe no header
     if (FDbfVersion = xBaseVII) and (lPropHdrOffset + Sizeof(lFieldPropsHdr) <
     if (FDbfVersion = xBaseVII) and (lPropHdrOffset + Sizeof(lFieldPropsHdr) <
-            PDbfHdr(Header).FullHdrSize) then
+            PDbfHdr(Header)^.FullHdrSize) then
     begin
     begin
       // read in field properties header
       // read in field properties header
       ReadBlock(@lFieldPropsHdr, SizeOf(lFieldPropsHdr), lPropHdrOffset);
       ReadBlock(@lFieldPropsHdr, SizeOf(lFieldPropsHdr), lPropHdrOffset);
@@ -976,20 +980,20 @@ begin
     end;
     end;
 
 
   finally
   finally
-    HeaderSize := PDbfHdr(Header).FullHdrSize;
-    RecordSize := PDbfHdr(Header).RecordSize;
+    HeaderSize := PDbfHdr(Header)^.FullHdrSize;
+    RecordSize := PDbfHdr(Header)^.RecordSize;
   end;
   end;
 end;
 end;
 
 
 function TDbfFile.GetLanguageId: Integer;
 function TDbfFile.GetLanguageId: Integer;
 begin
 begin
-  Result := PDbfHdr(Header).Language;
+  Result := PDbfHdr(Header)^.Language;
 end;
 end;
 
 
 function TDbfFile.GetLanguageStr: String;
 function TDbfFile.GetLanguageStr: String;
 begin
 begin
   if FDbfVersion >= xBaseVII then
   if FDbfVersion >= xBaseVII then
-    Result := PAfterHdrVII(PChar(Header) + SizeOf(rDbfHdr)).LanguageDriverName;
+    Result := PAfterHdrVII(PChar(Header) + SizeOf(rDbfHdr))^.LanguageDriverName;
 end;
 end;
 
 
 {
 {
@@ -1065,6 +1069,54 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TDbfFile.Rename(DestFileName: string; NewIndexFileNames: TStrings; DeleteFiles: boolean);
+var
+  lIndexFileNames: TStrings;
+  lIndexFile: TIndexFile;
+  NewBaseName: string;
+  I: integer;
+begin
+  // get memory for index file list
+  lIndexFileNames := TStringList.Create;
+  try 
+    // save index filenames
+    for I := 0 to FIndexFiles.Count - 1 do
+    begin
+      lIndexFile := TIndexFile(IndexFiles[I]);
+      lIndexFileNames.Add(lIndexFile.FileName);
+      // prepare changing the dbf file name, needs changes in index files
+      lIndexFile.PrepareRename(NewIndexFileNames[I]);
+    end;
+
+    // close file
+    Close;
+
+    if DeleteFiles then
+    begin
+      SysUtils.DeleteFile(DestFileName);
+      SysUtils.DeleteFile(ChangeFileExt(DestFileName, GetMemoExt));
+    end else begin
+      I := 0;
+      FindNextName(DestFileName, NewBaseName, I);
+      SysUtils.RenameFile(DestFileName, NewBaseName);
+      SysUtils.RenameFile(ChangeFileExt(DestFileName, GetMemoExt), 
+        ChangeFileExt(NewBaseName, GetMemoExt));
+    end;
+    // delete old index files
+    for I := 0 to NewIndexFileNames.Count - 1 do
+      SysUtils.DeleteFile(NewIndexFileNames.Strings[I]);
+    // rename the new dbf files
+    SysUtils.RenameFile(FileName, DestFileName);
+    SysUtils.RenameFile(ChangeFileExt(FileName, GetMemoExt), 
+      ChangeFileExt(DestFileName, GetMemoExt));
+    // rename new index files
+    for I := 0 to NewIndexFileNames.Count - 1 do
+      SysUtils.RenameFile(lIndexFileNames.Strings[I], NewIndexFileNames.Strings[I]);
+  finally
+    lIndexFileNames.Free;
+  end;  
+end;
+
 type
 type
   TRestructFieldInfo = record
   TRestructFieldInfo = record
     SourceOffset: Integer;
     SourceOffset: Integer;
@@ -1072,6 +1124,10 @@ type
     Size: Integer;
     Size: Integer;
   end;
   end;
 
 
+  { assume nobody has more than 8192 fields, otherwise possibly range check error }
+  PRestructFieldInfo = ^TRestructFieldInfoArray;
+  TRestructFieldInfoArray = array[0..8191] of TRestructFieldInfo;
+
 procedure TDbfFile.RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
 procedure TDbfFile.RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
 var
 var
   DestDbfFile: TDbfFile;
   DestDbfFile: TDbfFile;
@@ -1079,12 +1135,12 @@ var
   TempIndexFile: TIndexFile;
   TempIndexFile: TIndexFile;
   DestFieldDefs: TDbfFieldDefs;
   DestFieldDefs: TDbfFieldDefs;
   TempDstDef, TempSrcDef: TDbfFieldDef;
   TempDstDef, TempSrcDef: TDbfFieldDef;
-  OldIndexFiles, NewIndexFiles: TStrings;
-  IndexName, NewBaseName, OldBaseName: string;
+  OldIndexFiles: TStrings;
+  IndexName, NewBaseName: string;
   I, lRecNo, lFieldNo, lFieldSize, lBlobRecNo, lWRecNo, srcOffset, dstOffset: Integer;
   I, lRecNo, lFieldNo, lFieldSize, lBlobRecNo, lWRecNo, srcOffset, dstOffset: Integer;
   pBuff, pDestBuff: PChar;
   pBuff, pDestBuff: PChar;
   pBlobRecNoBuff: array[1..11] of Char;
   pBlobRecNoBuff: array[1..11] of Char;
-  RestructFieldInfo: array of TRestructFieldInfo;
+  RestructFieldInfo: PRestructFieldInfo;
   BlobStream: TMemoryStream;
   BlobStream: TMemoryStream;
 begin
 begin
   // nothing to do?
   // nothing to do?
@@ -1097,7 +1153,6 @@ begin
   // make up some temporary filenames
   // make up some temporary filenames
   lRecNo := 0;
   lRecNo := 0;
   FindNextName(FileName, NewBaseName, lRecNo);
   FindNextName(FileName, NewBaseName, lRecNo);
-  FindNextName(FileName, OldBaseName, lRecNo);
 
 
   // select final field definition list
   // select final field definition list
   if DbfFieldDefs = nil then
   if DbfFieldDefs = nil then
@@ -1132,7 +1187,7 @@ begin
     DestDbfFile.FinishCreate(DestFieldDefs, 512);
     DestDbfFile.FinishCreate(DestFieldDefs, 512);
 
 
   // adjust size and offsets of fields
   // adjust size and offsets of fields
-  SetLength(RestructFieldInfo, DestFieldDefs.Count);
+  GetMem(RestructFieldInfo, sizeof(TRestructFieldInfo)*DestFieldDefs.Count);
   for lFieldNo := 0 to DestFieldDefs.Count - 1 do
   for lFieldNo := 0 to DestFieldDefs.Count - 1 do
   begin
   begin
     TempDstDef := DestFieldDefs.Items[lFieldNo];
     TempDstDef := DestFieldDefs.Items[lFieldNo];
@@ -1143,16 +1198,16 @@ begin
       begin
       begin
         // get minimum field length
         // get minimum field length
         lFieldSize := Min(TempSrcDef.Precision, TempDstDef.Precision) +
         lFieldSize := Min(TempSrcDef.Precision, TempDstDef.Precision) +
-          Min(TempSrcDef.Size - TempSrcDef.Precision,
+          Min(TempSrcDef.Size - TempSrcDef.Precision, 
             TempDstDef.Size - TempDstDef.Precision);
             TempDstDef.Size - TempDstDef.Precision);
         // if one has dec separator, but other not, we lose one digit
         // if one has dec separator, but other not, we lose one digit
-        if (TempDstDef.Precision > 0) xor
+        if (TempDstDef.Precision > 0) xor 
           ((TempSrcDef.NativeFieldType in ['F', 'N']) and (TempSrcDef.Precision > 0)) then
           ((TempSrcDef.NativeFieldType in ['F', 'N']) and (TempSrcDef.Precision > 0)) then
           Dec(lFieldSize);
           Dec(lFieldSize);
         // should not happen, but check nevertheless (maybe corrupt data)
         // should not happen, but check nevertheless (maybe corrupt data)
         if lFieldSize < 0 then
         if lFieldSize < 0 then
           lFieldSize := 0;
           lFieldSize := 0;
-        srcOffset := TempSrcDef.Size - TempSrcDef.Precision -
+        srcOffset := TempSrcDef.Size - TempSrcDef.Precision - 
           (TempDstDef.Size - TempDstDef.Precision);
           (TempDstDef.Size - TempDstDef.Precision);
         if srcOffset < 0 then
         if srcOffset < 0 then
         begin
         begin
@@ -1194,12 +1249,10 @@ begin
   end;
   end;
   TempIndexDef.Free;
   TempIndexDef.Free;
 
 
-  // get memory for index file list
-  OldIndexFiles := TStringList.Create;
-  NewIndexFiles := TStringList.Create;
   // get memory for record buffers
   // get memory for record buffers
   GetMem(pBuff, RecordSize);
   GetMem(pBuff, RecordSize);
   BlobStream := TMemoryStream.Create;
   BlobStream := TMemoryStream.Create;
+  OldIndexFiles := TStringList.Create;
   // if restructure, we need memory for dest buffer, otherwise use source
   // if restructure, we need memory for dest buffer, otherwise use source
   if DbfFieldDefs = nil then
   if DbfFieldDefs = nil then
     pDestBuff := pBuff
     pDestBuff := pBuff
@@ -1222,7 +1275,11 @@ begin
       begin
       begin
         // if restructure, initialize dest
         // if restructure, initialize dest
         if DbfFieldDefs <> nil then
         if DbfFieldDefs <> nil then
+        begin
           DestDbfFile.InitRecord(pDestBuff);
           DestDbfFile.InitRecord(pDestBuff);
+          // copy deleted mark (the first byte)
+          pDestBuff^ := pBuff^;
+        end;
 
 
         if (DbfFieldDefs <> nil) or (FMemoFile <> nil) then
         if (DbfFieldDefs <> nil) or (FMemoFile <> nil) then
         begin
         begin
@@ -1277,52 +1334,31 @@ begin
 
 
     // save index filenames
     // save index filenames
     for I := 0 to FIndexFiles.Count - 1 do
     for I := 0 to FIndexFiles.Count - 1 do
-    begin
-      OldIndexFiles.Add(TIndexFile(FIndexFiles.Items[I]).FileName);
-      NewIndexFiles.Add(TIndexFile(DestDbfFile.IndexFiles[I]).FileName);
-    end;
+      OldIndexFiles.Add(TIndexFile(IndexFiles[I]).FileName);
 
 
-    // close temp file
-    DestDbfFile.Close;
     // close dbf
     // close dbf
     Close;
     Close;
 
 
     // if restructure -> rename the old dbf files
     // if restructure -> rename the old dbf files
     // if pack only -> delete the old dbf files
     // if pack only -> delete the old dbf files
-    if Pack and (DbfFieldDefs = nil) then
-    begin
-      SysUtils.DeleteFile(FileName);
-      SysUtils.DeleteFile(ChangeFileExt(FileName, GetMemoExt));
-    end else begin
-      SysUtils.RenameFile(FileName,                        OldBaseName);
-      SysUtils.RenameFile(ChangeFileExt(FileName, GetMemoExt), ChangeFileExt(OldBaseName, GetMemoExt));
-    end;
-    // delete old index files
-    for I := 0 to OldIndexFiles.Count - 1 do
-      SysUtils.DeleteFile(OldIndexFiles.Strings[I]);
-    // rename the new dbf files
-    SysUtils.RenameFile(NewBaseName,                        FileName);
-    SysUtils.RenameFile(ChangeFileExt(NewBaseName, GetMemoExt), ChangeFileExt(FileName, GetMemoExt));
-    // rename new index files
-    for I := 0 to OldIndexFiles.Count - 1 do
-      SysUtils.RenameFile(NewIndexFiles.Strings[I], OldIndexFiles.Strings[I]);
-
+    DestDbfFile.Rename(FileName, OldIndexFiles, DbfFieldDefs = nil);
+    
     // we have to reinit fielddefs if restructured
     // we have to reinit fielddefs if restructured
     Open;
     Open;
 
 
     // crop deleted records
     // crop deleted records
     RecordCount := lWRecNo - 1;
     RecordCount := lWRecNo - 1;
     // update date/time stamp, recordcount
     // update date/time stamp, recordcount
-    PDbfHdr(Header).RecordCount := RecordCount;
+    PDbfHdr(Header)^.RecordCount := RecordCount;
     WriteHeader;
     WriteHeader;
   finally
   finally
     // close temporary file
     // close temporary file
     FreeAndNil(DestDbfFile);
     FreeAndNil(DestDbfFile);
     // free mem
     // free mem
-    OldIndexFiles.Free;
-    NewIndexFiles.Free;
+    FreeAndNil(OldIndexFiles);
     FreeMem(pBuff);
     FreeMem(pBuff);
     FreeAndNil(BlobStream);
     FreeAndNil(BlobStream);
+    FreeMem(RestructFieldInfo);
     if DbfFieldDefs <> nil then
     if DbfFieldDefs <> nil then
       FreeMem(pDestBuff);
       FreeMem(pDestBuff);
   end;
   end;
@@ -1446,7 +1482,7 @@ begin
     Result := (PByte(Src)^ and (1 shl (AFieldDef.NullPosition and $7))) <> 0;
     Result := (PByte(Src)^ and (1 shl (AFieldDef.NullPosition and $7))) <> 0;
     exit;
     exit;
   end;
   end;
-
+  
   FieldOffset := AFieldDef.Offset;
   FieldOffset := AFieldDef.Offset;
   FieldSize := AFieldDef.Size;
   FieldSize := AFieldDef.Size;
   Src := PChar(Src) + FieldOffset;
   Src := PChar(Src) + FieldOffset;
@@ -1612,7 +1648,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TDbfFile.UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef;
+procedure TDbfFile.UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; 
   Action: TUpdateNullField);
   Action: TUpdateNullField);
 var
 var
   NullDst: pbyte;
   NullDst: pbyte;
@@ -1819,11 +1855,11 @@ var
 begin
 begin
   // clear buffer (assume all string, fix specific fields later)
   // clear buffer (assume all string, fix specific fields later)
   FillChar(DestBuf^, RecordSize,' ');
   FillChar(DestBuf^, RecordSize,' ');
-
+  
   // set nullflags field so that all fields are null
   // set nullflags field so that all fields are null
   if FNullField <> nil then
   if FNullField <> nil then
     FillChar(PChar(DestBuf+FNullField.Offset)^, FNullField.Size, $FF);
     FillChar(PChar(DestBuf+FNullField.Offset)^, FNullField.Size, $FF);
-
+    
   // check binary and default fields
   // check binary and default fields
   for I := 0 to FFieldDefs.Count-1 do
   for I := 0 to FFieldDefs.Count-1 do
   begin
   begin
@@ -1863,7 +1899,7 @@ begin
       if (TempFieldDef.NativeFieldType = '+') then
       if (TempFieldDef.NativeFieldType = '+') then
       begin
       begin
         // read current auto inc, from header or field, depending on sharing
         // read current auto inc, from header or field, depending on sharing
-        lAutoIncOffset := sizeof(rDbfHdr) + sizeof(rAfterHdrVII) +
+        lAutoIncOffset := sizeof(rDbfHdr) + sizeof(rAfterHdrVII) + 
           FieldDescVII_AutoIncOffset + I * sizeof(rFieldDescVII);
           FieldDescVII_AutoIncOffset + I * sizeof(rFieldDescVII);
         // TODO: big-endianness
         // TODO: big-endianness
         if NeedLocks then
         if NeedLocks then
@@ -1882,7 +1918,7 @@ begin
 
 
     // write modified header (new autoinc values) to file
     // write modified header (new autoinc values) to file
     WriteHeader;
     WriteHeader;
-
+    
     // release lock if locked
     // release lock if locked
     if NeedLocks then
     if NeedLocks then
       UnlockPage(0);
       UnlockPage(0);
@@ -1927,9 +1963,11 @@ procedure TDbfFile.OpenIndex(IndexName, IndexField: string; CreateIndex: Boolean
   //
   //
 const
 const
   // memcr, memop, excr, exopen, rwcr, rwopen, rdonly
   // memcr, memop, excr, exopen, rwcr, rwopen, rdonly
-  IndexOpenMode: array[pfMemoryCreate..pfReadOnly] of TPagedFileMode =
-    (pfMemoryCreate, pfMemoryCreate, pfExclusiveOpen, pfExclusiveOpen, pfReadWriteOpen, pfReadWriteOpen,
-     pfReadOnly);
+  IndexOpenMode: array[boolean, pfMemoryCreate..pfReadOnly] of TPagedFileMode =
+   ((pfMemoryCreate, pfMemoryCreate, pfExclusiveOpen, pfExclusiveOpen, pfReadWriteOpen, pfReadWriteOpen,
+     pfReadOnly),
+    (pfMemoryCreate, pfMemoryCreate, pfExclusiveCreate, pfExclusiveCreate, pfReadWriteCreate, pfReadWriteCreate,
+     pfReadOnly));
 var
 var
   lIndexFile: TIndexFile;
   lIndexFile: TIndexFile;
   lIndexFileName: string;
   lIndexFileName: string;
@@ -1974,7 +2012,7 @@ begin
       // try to open / create the file
       // try to open / create the file
       lIndexFile := TIndexFile.Create(Self);
       lIndexFile := TIndexFile.Create(Self);
       lIndexFile.FileName := lIndexFileName;
       lIndexFile.FileName := lIndexFileName;
-      lIndexFile.Mode := IndexOpenMode[Mode];
+      lIndexFile.Mode := IndexOpenMode[CreateIndex, Mode];
       lIndexFile.AutoCreate := CreateIndex or (Length(IndexField) > 0);
       lIndexFile.AutoCreate := CreateIndex or (Length(IndexField) > 0);
       lIndexFile.CodePage := UseCodePage;
       lIndexFile.CodePage := UseCodePage;
       lIndexFile.OnLocaleError := FOnLocaleError;
       lIndexFile.OnLocaleError := FOnLocaleError;
@@ -2036,7 +2074,7 @@ begin
         end;
         end;
         // if mdx file just created, write changes to dbf header
         // if mdx file just created, write changes to dbf header
         // set MDX flag to true
         // set MDX flag to true
-        PDbfHdr(Header).MDXFlag := 1;
+        PDbfHdr(Header)^.MDXFlag := 1;
         WriteHeader;
         WriteHeader;
       except
       except
         // :-( need to undo 'damage'....
         // :-( need to undo 'damage'....
@@ -2220,7 +2258,7 @@ begin
         // erase file
         // erase file
         Sysutils.DeleteFile(lFileName);
         Sysutils.DeleteFile(lFileName);
         // clear mdx flag
         // clear mdx flag
-        PDbfHdr(Header).MDXFlag := 0;
+        PDbfHdr(Header)^.MDXFlag := 0;
         WriteHeader;
         WriteHeader;
       end;
       end;
     end else begin
     end else begin
@@ -2315,7 +2353,7 @@ begin
   // read current header
   // read current header
   ReadHeader;
   ReadHeader;
   // increase current record count
   // increase current record count
-  Inc(PDbfHdr(Header).RecordCount);
+  Inc(PDbfHdr(Header)^.RecordCount);
   // write header to disk
   // write header to disk
   WriteHeader;
   WriteHeader;
   // done with header
   // done with header
@@ -2349,7 +2387,7 @@ begin
     // rolled back
     // rolled back
     LockPage(0, true);
     LockPage(0, true);
     ReadHeader;
     ReadHeader;
-    Dec(PDbfHdr(Header).RecordCount);
+    Dec(PDbfHdr(Header)^.RecordCount);
     WriteHeader;
     WriteHeader;
     UnlockPage(0);
     UnlockPage(0);
     // roll back indexes too
     // roll back indexes too
@@ -2587,12 +2625,12 @@ begin
 //  Windows.GetUserName(@FUserName[0], FUserNameLen);
 //  Windows.GetUserName(@FUserName[0], FUserNameLen);
   Windows.GetComputerName(PChar(FUserName), FUserNameLen);
   Windows.GetComputerName(PChar(FUserName), FUserNameLen);
   SetLength(FUserName, FUserNameLen);
   SetLength(FUserName, FUserNameLen);
-{$else}
+{$else}  
 {$ifdef FPC}
 {$ifdef FPC}
   FpUname(TempName);
   FpUname(TempName);
   FUserName := TempName.machine;
   FUserName := TempName.machine;
   FUserNameLen := Length(FUserName);
   FUserNameLen := Length(FUserName);
-{$endif}
+{$endif}  
 {$endif}
 {$endif}
 end;
 end;
 
 
@@ -2670,3 +2708,4 @@ finalization
 *)
 *)
 
 
 end.
 end.
+

+ 11 - 10
fcl/db/dbase/dbf_fields.pas

@@ -2,14 +2,14 @@ unit dbf_fields;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   Classes,
   Classes,
   SysUtils,
   SysUtils,
-  Db,
-  Dbf_Common,
-  Dbf_Str;
+  db,
+  dbf_common,
+  dbf_str;
 
 
 type
 type
   PDbfFieldDef = ^TDbfFieldDef;
   PDbfFieldDef = ^TDbfFieldDef;
@@ -49,7 +49,7 @@ type
 
 
     property DbfVersion: TXBaseVersion read GetDbfVersion;
     property DbfVersion: TXBaseVersion read GetDbfVersion;
   public
   public
-    constructor Create(Collection: TCollection); override;
+    constructor Create(ACollection: TCollection); override;
     destructor Destroy; override;
     destructor Destroy; override;
 
 
     procedure Assign(Source: TPersistent); override;
     procedure Assign(Source: TPersistent); override;
@@ -107,9 +107,9 @@ type
 implementation
 implementation
 
 
 uses
 uses
-  Dbf_DbfFile;      // for dbf header structures
+  dbf_dbffile;      // for dbf header structures
 
 
-{$I Dbf_Struct.inc}
+{$I dbf_struct.inc}
 
 
 // I keep changing that fields...
 // I keep changing that fields...
 // Last time has been asked by Venelin Georgiev
 // Last time has been asked by Venelin Georgiev
@@ -185,7 +185,7 @@ end;
 //====================================================================
 //====================================================================
 // DbfFieldDef
 // DbfFieldDef
 //====================================================================
 //====================================================================
-constructor TDbfFieldDef.Create(Collection: TCollection); {virtual}
+constructor TDbfFieldDef.Create(ACollection: TCollection); {virtual}
 begin
 begin
   inherited;
   inherited;
 
 
@@ -370,7 +370,7 @@ begin
         FFieldType := ftBCD
         FFieldType := ftBCD
       else
       else
         FFieldType := ftCurrency;
         FFieldType := ftCurrency;
-    '0' : FFieldType := ftBytes;        { Visual FoxPro ``_NullFlags'' }
+    '0' : FFieldType := ftBytes;	{ Visual FoxPro ``_NullFlags'' }
   else
   else
     FNativeFieldType := #0;
     FNativeFieldType := #0;
     FFieldType := ftUnknown;
     FFieldType := ftUnknown;
@@ -408,7 +408,7 @@ begin
         FNativeFieldType := 'I'
         FNativeFieldType := 'I'
       else
       else
         FNativeFieldType := 'N';
         FNativeFieldType := 'N';
-    ftBCD, ftCurrency:
+    ftBCD, ftCurrency: 
       if DbfVersion = xFoxPro then
       if DbfVersion = xFoxPro then
         FNativeFieldType := 'Y';
         FNativeFieldType := 'Y';
   end;
   end;
@@ -560,3 +560,4 @@ begin
 end;
 end;
 
 
 end.
 end.
+

+ 6 - 5
fcl/db/dbase/dbf_idxcur.pas

@@ -2,15 +2,15 @@ unit dbf_idxcur;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   SysUtils,
   SysUtils,
   Classes,
   Classes,
-  Dbf_Cursor,
-  Dbf_IdxFile,
-  Dbf_PrsDef,
-  Dbf_Common;
+  dbf_cursor,
+  dbf_idxfile,
+  dbf_prsdef,
+  dbf_common;
 
 
 type
 type
 
 
@@ -178,3 +178,4 @@ begin
 end;
 end;
 
 
 end.
 end.
+

File diff suppressed because it is too large
+ 201 - 186
fcl/db/dbase/dbf_idxfile.pas


+ 5 - 4
fcl/db/dbase/dbf_lang.pas

@@ -1,6 +1,6 @@
 unit dbf_lang;
 unit dbf_lang;
 
 
-{$i Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 interface
 interface
 
 
@@ -9,9 +9,9 @@ uses
   Windows;
   Windows;
 {$else}
 {$else}
 {$ifdef KYLIX}
 {$ifdef KYLIX}
-  Libc,
-{$endif}
-  Types, Dbf_Wtil;
+  Libc, 
+{$endif}  
+  Types, dbf_wtil;
 {$endif}
 {$endif}
 
 
 const
 const
@@ -636,3 +636,4 @@ begin
 end;
 end;
 
 
 end.
 end.
+

+ 26 - 26
fcl/db/dbase/dbf_memo.pas

@@ -2,12 +2,12 @@ unit dbf_memo;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   Classes,
   Classes,
-  Dbf_PgFile,
-  Dbf_Common;
+  dbf_pgfile,
+  dbf_common;
 
 
 type
 type
 
 
@@ -95,7 +95,7 @@ type
 implementation
 implementation
 
 
 uses
 uses
-  SysUtils, Dbf_DbfFile;
+  SysUtils, dbf_dbffile;
 
 
 //====================================================================
 //====================================================================
 //=== Memo and binary fields support
 //=== Memo and binary fields support
@@ -168,7 +168,7 @@ begin
 
 
     // determine version
     // determine version
     if FDbfVersion = xBaseIII then
     if FDbfVersion = xBaseIII then
-      PDbtHdr(Header).bVer := 3;
+      PDbtHdr(Header)^.bVer := 3;
     VirtualLocks := false;
     VirtualLocks := false;
 
 
     if FileCreated or (HeaderSize = 0) then
     if FileCreated or (HeaderSize = 0) then
@@ -330,7 +330,7 @@ var
   bytesBefore: Integer;
   bytesBefore: Integer;
   bytesAfter: Integer;
   bytesAfter: Integer;
   totsize: Integer;
   totsize: Integer;
-  read: Integer;
+  readBytes: Integer;
   append: Boolean;
   append: Boolean;
   tmpRecNo: Integer;
   tmpRecNo: Integer;
 begin
 begin
@@ -372,28 +372,28 @@ begin
       totsize := Src.Size + bytesBefore + bytesAfter;
       totsize := Src.Size + bytesBefore + bytesAfter;
       if FDbfVersion <> xFoxPro then
       if FDbfVersion <> xFoxPro then
       begin
       begin
-        PBlockHdr(FBuffer).MemoType := $0008FFFF;
-        PBlockHdr(FBuffer).MemoSize := totsize;
+        PBlockHdr(FBuffer)^.MemoType := $0008FFFF;
+        PBlockHdr(FBuffer)^.MemoSize := totsize;
       end else begin
       end else begin
-        PBlockHdr(FBuffer).MemoType := $01000000;
-        PBlockHdr(FBuffer).MemoSize := SwapInt(Src.Size);
+        PBlockHdr(FBuffer)^.MemoType := $01000000;
+        PBlockHdr(FBuffer)^.MemoSize := SwapInt(Src.Size);
       end;
       end;
     end;
     end;
     repeat
     repeat
       // read bytes, don't overwrite header
       // read bytes, don't overwrite header
-      read := Src.Read(FBuffer[bytesBefore], RecordSize{PDbtHdr(Header).BlockLen}-bytesBefore);
+      readBytes := Src.Read(FBuffer[bytesBefore], RecordSize{PDbtHdr(Header).BlockLen}-bytesBefore);
       // end of input data reached ? check if need to write block terminators
       // end of input data reached ? check if need to write block terminators
-      while (read < RecordSize - bytesBefore) and (bytesAfter > 0) do
+      while (readBytes < RecordSize - bytesBefore) and (bytesAfter > 0) do
       begin
       begin
-        FBuffer[read] := #$1A;
-        Inc(read);
+        FBuffer[readBytes] := #$1A;
+        Inc(readBytes);
         Dec(bytesAfter);
         Dec(bytesAfter);
       end;
       end;
       // have we read anything that is to be written?
       // have we read anything that is to be written?
-      if read > 0 then
+      if readBytes > 0 then
       begin
       begin
         // clear any unused space
         // clear any unused space
-        FillChar(FBuffer[bytesBefore+read], RecordSize-read-bytesBefore, ' ');
+        FillChar(FBuffer[bytesBefore+readBytes], RecordSize-readBytes-bytesBefore, ' ');
         // write to disk
         // write to disk
         WriteRecord(tmpRecNo, @FBuffer[0]);
         WriteRecord(tmpRecNo, @FBuffer[0]);
         Inc(tmpRecNo);
         Inc(tmpRecNo);
@@ -422,31 +422,31 @@ begin
   if FDbfVersion = xBaseIII then
   if FDbfVersion = xBaseIII then
     Result := 512
     Result := 512
   else
   else
-    Result := PDbtHdr(Header).BlockLen;
+    Result := PDbtHdr(Header)^.BlockLen;
 end;
 end;
 
 
 function  TDbaseMemoFile.GetMemoSize: Integer;
 function  TDbaseMemoFile.GetMemoSize: Integer;
 begin
 begin
   // dBase4 memofiles contain small 'header'
   // dBase4 memofiles contain small 'header'
   if PInteger(@FBuffer[0])^ = $0008FFFF then
   if PInteger(@FBuffer[0])^ = $0008FFFF then
-    Result := PBlockHdr(FBuffer).MemoSize-8
+    Result := PBlockHdr(FBuffer)^.MemoSize-8
   else
   else
     Result := -1;
     Result := -1;
 end;
 end;
 
 
 function  TDbaseMemoFile.GetNextFreeBlock: Integer;
 function  TDbaseMemoFile.GetNextFreeBlock: Integer;
 begin
 begin
-  Result := PDbtHdr(Header).NextBlock;
+  Result := PDbtHdr(Header)^.NextBlock;
 end;
 end;
 
 
 procedure TDbaseMemoFile.SetNextFreeBlock(BlockNo: Integer);
 procedure TDbaseMemoFile.SetNextFreeBlock(BlockNo: Integer);
 begin
 begin
-  PDbtHdr(Header).NextBlock := BlockNo;
+  PDbtHdr(Header)^.NextBlock := BlockNo;
 end;
 end;
 
 
 procedure TDbaseMemoFile.SetBlockLen(BlockLen: Integer);
 procedure TDbaseMemoFile.SetBlockLen(BlockLen: Integer);
 begin
 begin
-  PDbtHdr(Header).BlockLen := BlockLen;
+  PDbtHdr(Header)^.BlockLen := BlockLen;
 end;
 end;
 
 
 // ------------------------------------------------------------------
 // ------------------------------------------------------------------
@@ -455,27 +455,27 @@ end;
 
 
 function  TFoxProMemoFile.GetBlockLen: Integer;
 function  TFoxProMemoFile.GetBlockLen: Integer;
 begin
 begin
-  Result := Swap(PFptHdr(Header).BlockLen);
+  Result := Swap(PFptHdr(Header)^.BlockLen);
 end;
 end;
 
 
 function  TFoxProMemoFile.GetMemoSize: Integer;
 function  TFoxProMemoFile.GetMemoSize: Integer;
 begin
 begin
-  Result := SwapInt(PBlockHdr(FBuffer).MemoSize);
+  Result := SwapInt(PBlockHdr(FBuffer)^.MemoSize);
 end;
 end;
 
 
 function  TFoxProMemoFile.GetNextFreeBlock: Integer;
 function  TFoxProMemoFile.GetNextFreeBlock: Integer;
 begin
 begin
-  Result := SwapInt(PFptHdr(Header).NextBlock);
+  Result := SwapInt(PFptHdr(Header)^.NextBlock);
 end;
 end;
 
 
 procedure TFoxProMemoFile.SetNextFreeBlock(BlockNo: Integer);
 procedure TFoxProMemoFile.SetNextFreeBlock(BlockNo: Integer);
 begin
 begin
-  PFptHdr(Header).NextBlock := SwapInt(BlockNo);
+  PFptHdr(Header)^.NextBlock := SwapInt(BlockNo);
 end;
 end;
 
 
 procedure TFoxProMemoFile.SetBlockLen(BlockLen: Integer);
 procedure TFoxProMemoFile.SetBlockLen(BlockLen: Integer);
 begin
 begin
-  PFptHdr(Header).BlockLen := Swap(BlockLen);
+  PFptHdr(Header)^.BlockLen := Swap(BlockLen);
 end;
 end;
 
 
 // ------------------------------------------------------------------
 // ------------------------------------------------------------------

+ 18 - 24
fcl/db/dbase/dbf_parser.pas

@@ -2,7 +2,7 @@ unit dbf_parser;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   SysUtils,
   SysUtils,
@@ -11,14 +11,14 @@ uses
   Libc,
   Libc,
 {$endif}
 {$endif}
 {$ifndef WIN32}
 {$ifndef WIN32}
-  Dbf_Wtil,
+  dbf_wtil,
 {$endif}
 {$endif}
-  Db,
-  Dbf_PrsCore,
-  Dbf_Common,
-  Dbf_Fields,
-  Dbf_PrsDef,
-  Dbf_PrsSupp;
+  db,
+  dbf_prscore,
+  dbf_common,
+  dbf_fields,
+  dbf_prsdef,
+  dbf_prssupp;
 
 
 type
 type
 
 
@@ -191,9 +191,9 @@ procedure Func_NOT(Param: PExpressionRec);
 implementation
 implementation
 
 
 uses
 uses
-  Dbf,
-  Dbf_DbfFile,
-  Dbf_Str
+  dbf,
+  dbf_dbffile,
+  dbf_str
 {$ifdef WIN32}
 {$ifdef WIN32}
   ,Windows
   ,Windows
 {$endif}
 {$endif}
@@ -447,15 +447,8 @@ end;
 
 
 procedure TDateTimeFieldVar.Refresh(Buffer: PChar);
 procedure TDateTimeFieldVar.Refresh(Buffer: PChar);
 begin
 begin
-  if FDbfFile.GetFieldDataFromDef(FieldDef, ftDateTime, Buffer, @FFieldVal) then
-  begin
-{$ifndef SUPPORT_NEW_FIELDDATA}
-    // convert BDE timestamp to normal datetime
-    FFieldVal.DateTime := BDETimeStampToDateTime(FFieldVal.DateTime);
-{$endif}
-  end else begin
+  if not FDbfFile.GetFieldDataFromDef(FieldDef, ftDateTime, Buffer, @FFieldVal) then
     FFieldVal.DateTime := 0.0;
     FFieldVal.DateTime := 0.0;
-  end;
 end;
 end;
 
 
 //--Expression functions-----------------------------------------------------
 //--Expression functions-----------------------------------------------------
@@ -533,7 +526,7 @@ begin
       // convert to string
       // convert to string
       width := GetStrFromInt(Val, Res.MemoryPos^);
       width := GetStrFromInt(Val, Res.MemoryPos^);
       // advance pointer
       // advance pointer
-      Inc(Param.Res.MemoryPos^, width);
+      Inc(Param^.Res.MemoryPos^, width);
     end;
     end;
     // null-terminate
     // null-terminate
     Res.MemoryPos^^ := #0;
     Res.MemoryPos^^ := #0;
@@ -542,7 +535,7 @@ end;
 
 
 procedure FuncIntToStr(Param: PExpressionRec);
 procedure FuncIntToStr(Param: PExpressionRec);
 begin
 begin
-  FuncIntToStr_Gen(Param, PInteger(Param.Args[0])^);
+  FuncIntToStr_Gen(Param, PInteger(Param^.Args[0])^);
 end;
 end;
 
 
 procedure FuncDateToStr(Param: PExpressionRec);
 procedure FuncDateToStr(Param: PExpressionRec);
@@ -552,7 +545,7 @@ begin
   with Param^ do
   with Param^ do
   begin
   begin
     // create in temporary string
     // create in temporary string
-    DateTimeToString(TempStr, 'yyyymmdd', PDateTimeRec(Args[0]).DateTime);
+    DateTimeToString(TempStr, 'yyyymmdd', PDateTimeRec(Args[0])^.DateTime);
     // copy to buffer
     // copy to buffer
     Res.Append(PChar(TempStr), Length(TempStr));
     Res.Append(PChar(TempStr), Length(TempStr));
   end;
   end;
@@ -1707,7 +1700,7 @@ initialization
     Add(TFunction.CreateOper('AND', 'BB', etBoolean, Func_AND, 90));
     Add(TFunction.CreateOper('AND', 'BB', etBoolean, Func_AND, 90));
     Add(TFunction.CreateOper('OR',  'BB', etBoolean, Func_OR, 100));
     Add(TFunction.CreateOper('OR',  'BB', etBoolean, Func_OR, 100));
 
 
-    // functions - name, description, param types, min params, result type, func addr
+    // Functions - name, description, param types, min params, result type, Func addr
     Add(TFunction.Create('STR',       '',      'FII', 1, etString, FuncFloatToStr, ''));
     Add(TFunction.Create('STR',       '',      'FII', 1, etString, FuncFloatToStr, ''));
     Add(TFunction.Create('STR',       '',      'III', 1, etString, FuncIntToStr, ''));
     Add(TFunction.Create('STR',       '',      'III', 1, etString, FuncIntToStr, ''));
     Add(TFunction.Create('DTOS',      '',      'D',   1, etString, FuncDateToStr, ''));
     Add(TFunction.Create('DTOS',      '',      'D',   1, etString, FuncDateToStr, ''));
@@ -1739,7 +1732,7 @@ initialization
     Add(TFunction.CreateOper('>=','SS', etBoolean, FuncStr_GTE, 80));
     Add(TFunction.CreateOper('>=','SS', etBoolean, FuncStr_GTE, 80));
     Add(TFunction.CreateOper('<>','SS', etBoolean, FuncStr_NEQ, 80));
     Add(TFunction.CreateOper('<>','SS', etBoolean, FuncStr_NEQ, 80));
   end;
   end;
-
+    
   with DbfWordsSensNoPartialList do
   with DbfWordsSensNoPartialList do
     Add(TFunction.CreateOper('=', 'SS', etBoolean, FuncStr_EQ , 80));
     Add(TFunction.CreateOper('=', 'SS', etBoolean, FuncStr_EQ , 80));
 
 
@@ -1757,3 +1750,4 @@ finalization
   DbfWordsSensPartialList.Free;
   DbfWordsSensPartialList.Free;
 
 
 end.
 end.
+

+ 4 - 4
fcl/db/dbase/dbf_pgcfile.pas

@@ -4,16 +4,16 @@ unit dbf_pgcfile;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 {$ifdef USE_CACHE}
 {$ifdef USE_CACHE}
 
 
 uses
 uses
   Classes,
   Classes,
   SysUtils,
   SysUtils,
-  Dbf_Common,
-  Dbf_Avl,
-  Dbf_PgFile;
+  dbf_common,
+  dbf_avl,
+  dbf_pgfile;
 
 
 type
 type
 
 

+ 14 - 8
fcl/db/dbase/dbf_pgfile.pas

@@ -2,12 +2,12 @@ unit dbf_pgfile;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   Classes,
   Classes,
   SysUtils,
   SysUtils,
-  Dbf_Common;
+  dbf_common;
 
 
 //const
 //const
 //  MaxHeaders = 256;
 //  MaxHeaders = 256;
@@ -15,7 +15,7 @@ uses
 type
 type
   EPagedFile = Exception;
   EPagedFile = Exception;
 
 
-  TPagedFileMode = (pfNone, pfMemoryCreate, pfMemoryOpen, pfExclusiveCreate,
+  TPagedFileMode = (pfNone, pfMemoryCreate, pfMemoryOpen, pfExclusiveCreate, 
     pfExclusiveOpen, pfReadWriteCreate, pfReadWriteOpen, pfReadOnly);
     pfExclusiveOpen, pfReadWriteCreate, pfReadWriteOpen, pfReadOnly);
 
 
   // access levels:
   // access levels:
@@ -150,11 +150,11 @@ uses
   Windows,
   Windows,
 {$else}
 {$else}
 {$ifdef KYLIX}
 {$ifdef KYLIX}
-  Libc,
+  Libc, 
+{$endif}  
+  Types, dbf_wtil,
 {$endif}
 {$endif}
-  Types, Dbf_Wtil,
-{$endif}
-  Dbf_Str;
+  dbf_str;
 
 
 //====================================================================
 //====================================================================
 // TPagedFile
 // TPagedFile
@@ -207,7 +207,7 @@ procedure TPagedFile.OpenFile;
 var
 var
   fileOpenMode: Word;
   fileOpenMode: Word;
 begin
 begin
-  if FActive then exit;
+  if FActive then exit;  
 
 
   // store user specified mode
   // store user specified mode
   FUserMode := FMode;
   FUserMode := FMode;
@@ -259,6 +259,8 @@ begin
   FNeedLocks := IsSharedAccess;
   FNeedLocks := IsSharedAccess;
 {$endif}
 {$endif}
   FActive := true;
   FActive := true;
+  // allocate memory for bufferahead
+  UpdateBufferSize;
 end;
 end;
 
 
 procedure TPagedFile.CloseFile;
 procedure TPagedFile.CloseFile;
@@ -266,9 +268,12 @@ begin
   if FActive then
   if FActive then
   begin
   begin
     FlushHeader;
     FlushHeader;
+    FlushBuffer;
     // don't free the user's stream
     // don't free the user's stream
     if not (FMode in [pfMemoryOpen, pfMemoryCreate]) then
     if not (FMode in [pfMemoryOpen, pfMemoryCreate]) then
       FreeAndNil(FStream);
       FreeAndNil(FStream);
+    // free bufferahead buffer
+    FreeMemAndNil(FBufferPtr);
 
 
     // mode possibly overridden in case of auto-created file
     // mode possibly overridden in case of auto-created file
     FMode := FUserMode;
     FMode := FUserMode;
@@ -909,3 +914,4 @@ begin
 end;
 end;
 
 
 end.
 end.
+

+ 54 - 53
fcl/db/dbase/dbf_prscore.pas

@@ -8,14 +8,14 @@ unit dbf_prscore;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   SysUtils,
   SysUtils,
   Classes,
   Classes,
-  Dbf_Common,
-  Dbf_PrsSupp,
-  Dbf_PrsDef;
+  dbf_common,
+  dbf_prssupp,
+  dbf_prsdef;
 
 
 {$define ENG_NUMBERS}
 {$define ENG_NUMBERS}
 
 
@@ -194,7 +194,7 @@ begin
         CheckArguments(ArgList[I]);
         CheckArguments(ArgList[I]);
 
 
         // test if correct type
         // test if correct type
-        if (ArgList[I].ExprWord.ResultType <> ExprCharToExprType(ExprWord.TypeSpec[I+1])) then
+        if (ArgList[I]^.ExprWord.ResultType <> ExprCharToExprType(ExprWord.TypeSpec[I+1])) then
           error := 2;
           error := 2;
 
 
         // goto next argument
         // goto next argument
@@ -217,7 +217,7 @@ begin
         // check if not last function
         // check if not last function
         if I < FWordsList.Count - 1 then
         if I < FWordsList.Count - 1 then
         begin
         begin
-          TempExprWord := FWordsList.Items[I+1];
+          TempExprWord := TExprWord(FWordsList.Items[I+1]);
           if FWordsList.Compare(FWordsList.KeyOf(ExprWord), FWordsList.KeyOf(TempExprWord)) = 0 then
           if FWordsList.Compare(FWordsList.KeyOf(ExprWord), FWordsList.KeyOf(TempExprWord)) = 0 then
           begin
           begin
             ExprWord := TempExprWord;
             ExprWord := TempExprWord;
@@ -328,13 +328,13 @@ var
 begin
 begin
   if ARec <> nil then
   if ARec <> nil then
     repeat
     repeat
-      TheNext := ARec.Next;
-      if ARec.Res <> nil then
-        ARec.Res.Free;
+      TheNext := ARec^.Next;
+      if ARec^.Res <> nil then
+        ARec^.Res.Free;
       I := 0;
       I := 0;
-      while ARec.ArgList[I] <> nil do
+      while ARec^.ArgList[I] <> nil do
       begin
       begin
-        FreeMem(ARec.Args[I]);
+        FreeMem(ARec^.Args[I]);
         Inc(I);
         Inc(I);
       end;
       end;
       Dispose(ARec);
       Dispose(ARec);
@@ -374,7 +374,7 @@ begin
     while ExprRec^.ArgList[I] <> nil do
     while ExprRec^.ArgList[I] <> nil do
     begin
     begin
       // save variable type for easy access
       // save variable type for easy access
-      ExprRec^.ArgsType[I] := ExprRec^.ArgList[I].ExprWord.ResultType;
+      ExprRec^.ArgsType[I] := ExprRec^.ArgList[I]^.ExprWord.ResultType;
       // check if we need to copy argument, variables in general do not
       // check if we need to copy argument, variables in general do not
       // need copying, except for fixed len strings which are not
       // need copying, except for fixed len strings which are not
       // null-terminated
       // null-terminated
@@ -408,13 +408,13 @@ begin
       FCurrentRec := ExprRec;
       FCurrentRec := ExprRec;
       FLastRec := ExprRec;
       FLastRec := ExprRec;
     end else begin
     end else begin
-      FLastRec.Next := ExprRec;
+      FLastRec^.Next := ExprRec;
       FLastRec := ExprRec;
       FLastRec := ExprRec;
     end;
     end;
   end;
   end;
 end;
 end;
 
 
-function TCustomExpressionParser.MakeTree(Expr: TExprCollection;
+function TCustomExpressionParser.MakeTree(Expr: TExprCollection; 
   FirstItem, LastItem: Integer): PExpressionRec;
   FirstItem, LastItem: Integer): PExpressionRec;
 
 
 {
 {
@@ -447,7 +447,7 @@ begin
   begin
   begin
     case TExprWord(Expr.Items[I]).ResultType of
     case TExprWord(Expr.Items[I]).ResultType of
       etLeftBracket: Inc(brCount);
       etLeftBracket: Inc(brCount);
-      etRightBracket:
+      etRightBracket: 
         begin
         begin
           Dec(brCount);
           Dec(brCount);
           if brCount < IArg then
           if brCount < IArg then
@@ -478,17 +478,17 @@ begin
   // simple constant, variable or function?
   // simple constant, variable or function?
   if LastItem = FirstItem then
   if LastItem = FirstItem then
   begin
   begin
-    Result.ExprWord := TExprWord(Expr.Items[FirstItem]);
-    Result.Oper := @Result.ExprWord.ExprFunc;
-    if Result.ExprWord.IsVariable then
+    Result^.ExprWord := TExprWord(Expr.Items[FirstItem]);
+    Result^.Oper := Result^.ExprWord.ExprFunc;
+    if Result^.ExprWord.IsVariable then
     begin
     begin
       // copy pointer to variable
       // copy pointer to variable
-      Result.Args[0] := Result.ExprWord.AsPointer;
+      Result^.Args[0] := Result^.ExprWord.AsPointer;
       // is this a fixed length string variable?
       // is this a fixed length string variable?
-      if Result.ExprWord.FixedLen >= 0 then
+      if Result^.ExprWord.FixedLen >= 0 then
       begin
       begin
         // store length as second parameter
         // store length as second parameter
-        Result.Args[1] := PChar(Result.ExprWord.LenAsPointer);
+        Result^.Args[1] := PChar(Result^.ExprWord.LenAsPointer);
       end;
       end;
     end;
     end;
     exit;
     exit;
@@ -517,23 +517,23 @@ begin
   if IEnd >= FirstItem then
   if IEnd >= FirstItem then
   begin
   begin
     // save operator
     // save operator
-    Result.ExprWord := TExprWord(Expr.Items[IEnd]);
-    Result.Oper := Result.ExprWord.ExprFunc;
+    Result^.ExprWord := TExprWord(Expr.Items[IEnd]);
+    Result^.Oper := Result^.ExprWord.ExprFunc;
     // recurse into left part if present
     // recurse into left part if present
     if IEnd > FirstItem then
     if IEnd > FirstItem then
     begin
     begin
-      Result.ArgList[IArg] := MakeTree(Expr, FirstItem, IEnd-1);
+      Result^.ArgList[IArg] := MakeTree(Expr, FirstItem, IEnd-1);
       Inc(IArg);
       Inc(IArg);
     end;
     end;
     // recurse into right part if present
     // recurse into right part if present
     if IEnd < LastItem then
     if IEnd < LastItem then
-      Result.ArgList[IArg] := MakeTree(Expr, IEnd+1, LastItem);
-  end else
-  if TExprWord(Expr.Items[FirstItem]).IsFunction then
+      Result^.ArgList[IArg] := MakeTree(Expr, IEnd+1, LastItem);
+  end else 
+  if TExprWord(Expr.Items[FirstItem]).IsFunction then 
   begin
   begin
     // save function
     // save function
-    Result.ExprWord := TExprWord(Expr.Items[FirstItem]);
-    Result.Oper := Result.ExprWord.ExprFunc;
+    Result^.ExprWord := TExprWord(Expr.Items[FirstItem]);
+    Result^.Oper := Result^.ExprWord.ExprFunc;
     // parse function arguments
     // parse function arguments
     IEnd := FirstItem + 1;
     IEnd := FirstItem + 1;
     IStart := IEnd;
     IStart := IEnd;
@@ -552,7 +552,7 @@ begin
             if brCount = 1 then
             if brCount = 1 then
             begin
             begin
               // argument separation found, build tree of argument expression
               // argument separation found, build tree of argument expression
-              Result.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
+              Result^.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
               Inc(IArg);
               Inc(IArg);
               IStart := IEnd + 1;
               IStart := IEnd + 1;
             end;
             end;
@@ -561,7 +561,7 @@ begin
       end;
       end;
 
 
       // parse last argument
       // parse last argument
-      Result.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
+      Result^.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
     end;
     end;
   end else
   end else
     raise EParserException.Create('Operator/function missing');
     raise EParserException.Create('Operator/function missing');
@@ -972,8 +972,8 @@ begin
     //LAST operand should be boolean -otherwise If(,,) doesn't work
     //LAST operand should be boolean -otherwise If(,,) doesn't work
     while (FLastRec^.Next <> nil) do
     while (FLastRec^.Next <> nil) do
       FLastRec := FLastRec^.Next;
       FLastRec := FLastRec^.Next;
-    if FLastRec.ExprWord <> nil then
-      Result := FLastRec.ExprWord.ResultType;
+    if FLastRec^.ExprWord <> nil then
+      Result := FLastRec^.ExprWord.ResultType;
   end;
   end;
 end;
 end;
 
 
@@ -990,16 +990,16 @@ begin
   pnew := NewExprWord.AsPointer;
   pnew := NewExprWord.AsPointer;
   Rec := FCurrentRec;
   Rec := FCurrentRec;
   repeat
   repeat
-    if (Rec.ExprWord = OldExprWord) then
+    if (Rec^.ExprWord = OldExprWord) then
     begin
     begin
-      Rec.ExprWord := NewExprWord;
-      Rec.Oper := NewExprWord.ExprFunc;
+      Rec^.ExprWord := NewExprWord;
+      Rec^.Oper := NewExprWord.ExprFunc;
     end;
     end;
     if p <> nil then
     if p <> nil then
-      for J := 0 to Rec.ExprWord.MaxFunctionArg - 1 do
-        if Rec.Args[J] = p then
-          Rec.Args[J] := pnew;
-    Rec := Rec.Next;
+      for J := 0 to Rec^.ExprWord.MaxFunctionArg - 1 do
+        if Rec^.Args[J] = p then
+          Rec^.Args[J] := pnew;
+    Rec := Rec^.Next;
   until Rec = nil;
   until Rec = nil;
 end;
 end;
 
 
@@ -1008,20 +1008,20 @@ var
   I: Integer;
   I: Integer;
 begin
 begin
   New(Result);
   New(Result);
-  Result.Oper := nil;
-  Result.AuxData := nil;
+  Result^.Oper := nil;
+  Result^.AuxData := nil;
   for I := 0 to MaxArg - 1 do
   for I := 0 to MaxArg - 1 do
   begin
   begin
-    Result.Args[I] := nil;
-    Result.ArgsPos[I] := nil;
-    Result.ArgsSize[I] := 0;
-    Result.ArgsType[I] := etUnknown;
-    Result.ArgList[I] := nil;
+    Result^.Args[I] := nil;
+    Result^.ArgsPos[I] := nil;
+    Result^.ArgsSize[I] := 0;
+    Result^.ArgsType[I] := etUnknown;
+    Result^.ArgList[I] := nil;
   end;
   end;
-  Result.Res := nil;
-  Result.Next := nil;
-  Result.ExprWord := nil;
-  Result.ResetDest := false;
+  Result^.Res := nil;
+  Result^.Next := nil;
+  Result^.ExprWord := nil;
+  Result^.ResetDest := false;
 end;
 end;
 
 
 procedure TCustomExpressionParser.Evaluate(AnExpression: string);
 procedure TCustomExpressionParser.Evaluate(AnExpression: string);
@@ -1057,7 +1057,7 @@ begin
   begin
   begin
     // if no function specified, then no need to replace!
     // if no function specified, then no need to replace!
     if AFunction <> nil then
     if AFunction <> nil then
-      ReplaceExprWord(FWordsList.Items[I], TExprWord(AFunction));
+      ReplaceExprWord(TExprWord(FWordsList.Items[I]), TExprWord(AFunction));
     FWordsList.AtFree(I);
     FWordsList.AtFree(I);
   end;
   end;
   if AFunction <> nil then
   if AFunction <> nil then
@@ -1077,7 +1077,7 @@ var
 begin
 begin
   if FWordsList.Search(PChar(AExprWord.Name), IOldVar) then
   if FWordsList.Search(PChar(AExprWord.Name), IOldVar) then
   begin
   begin
-    ReplaceExprWord(FWordsList.Items[IOldVar], AExprWord);
+    ReplaceExprWord(TExprWord(FWordsList.Items[IOldVar]), AExprWord);
     FWordsList.AtFree(IOldVar);
     FWordsList.AtFree(IOldVar);
     FWordsList.Add(AExprWord);
     FWordsList.Add(AExprWord);
   end
   end
@@ -1124,3 +1124,4 @@ begin
 end;
 end;
 
 
 end.
 end.
+

+ 8 - 5
fcl/db/dbase/dbf_prsdef.pas

@@ -2,13 +2,13 @@ unit dbf_prsdef;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 uses
 uses
   SysUtils,
   SysUtils,
   Classes,
   Classes,
-  Dbf_Common,
-  Dbf_PrsSupp;
+  dbf_common,
+  dbf_prssupp;
 
 
 const
 const
   MaxArg = 6;
   MaxArg = 6;
@@ -452,12 +452,14 @@ end;
 
 
 function TExprWord.GetIsVariable: Boolean;
 function TExprWord.GetIsVariable: Boolean;
 begin
 begin
+  // delphi wants to call the function pointed to by the variable, use '@'
+  // fpc simply returns pointer to function, no '@' needed
   Result := (@FExprFunc = @_StringVariable)         or
   Result := (@FExprFunc = @_StringVariable)         or
             (@FExprFunc = @_StringConstant)         or
             (@FExprFunc = @_StringConstant)         or
             (@FExprFunc = @_StringVariableFixedLen) or
             (@FExprFunc = @_StringVariableFixedLen) or
             (@FExprFunc = @_FloatVariable)          or
             (@FExprFunc = @_FloatVariable)          or
             (@FExprFunc = @_IntegerVariable)        or
             (@FExprFunc = @_IntegerVariable)        or
-//            (@FExprFunc = @_SmallIntVariable)       or
+//            (FExprFunc = @_SmallIntVariable)       or
 {$ifdef SUPPORT_INT64}
 {$ifdef SUPPORT_INT64}
             (@FExprFunc = @_LargeIntVariable)       or
             (@FExprFunc = @_LargeIntVariable)       or
 {$endif}
 {$endif}
@@ -475,7 +477,7 @@ begin
 // not null-terminated (fixed len)
 // not null-terminated (fixed len)
             (@FExprFunc <> @_FloatVariable)          and
             (@FExprFunc <> @_FloatVariable)          and
             (@FExprFunc <> @_IntegerVariable)        and
             (@FExprFunc <> @_IntegerVariable)        and
-//            (@FExprFunc <> @_SmallIntVariable)       and
+//            (FExprFunc <> @_SmallIntVariable)       and
 {$ifdef SUPPORT_INT64}
 {$ifdef SUPPORT_INT64}
             (@FExprFunc <> @_LargeIntVariable)       and
             (@FExprFunc <> @_LargeIntVariable)       and
 {$endif}
 {$endif}
@@ -1039,3 +1041,4 @@ begin
 end;
 end;
 
 
 end.
 end.
+

+ 2 - 1
fcl/db/dbase/dbf_prssupp.pas

@@ -2,7 +2,7 @@ unit dbf_prssupp;
 
 
 // parse support
 // parse support
 
 
-{$i Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 interface
 interface
 
 
@@ -182,3 +182,4 @@ begin
 end;
 end;
 
 
 end.
 end.
+

+ 8 - 8
fcl/db/dbase/dbf_reg.pas

@@ -22,14 +22,14 @@ unit dbf_reg;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 procedure Register;
 procedure Register;
 
 
 implementation
 implementation
 
 
 {$ifndef FPC}
 {$ifndef FPC}
-{$R Dbf.dcr}
+{$R dbf.dcr}
 {$endif}
 {$endif}
 
 
 uses
 uses
@@ -45,12 +45,12 @@ uses
   Forms,
   Forms,
   Dialogs,
   Dialogs,
 {$endif}
 {$endif}
-  Dbf,
-  Dbf_DbfFile,
-  Dbf_IdxFile,
-  Dbf_Fields,
-  Dbf_Common,
-  Dbf_Str
+  dbf,
+  dbf_dbffile,
+  dbf_idxfile,
+  dbf_fields,
+  dbf_common,
+  dbf_str
 {$ifndef FPC}
 {$ifndef FPC}
   ,ExptIntf
   ,ExptIntf
 {$endif}
 {$endif}

+ 3 - 2
fcl/db/dbase/dbf_str.pas

@@ -2,8 +2,8 @@ unit dbf_str;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
-{$I Dbf_Str.inc}
+{$I dbf_common.inc}
+{$I dbf_str.inc}
 
 
 implementation
 implementation
 
 
@@ -33,3 +33,4 @@ initialization
   STRING_INDEX_NOT_EXIST              := 'Index "%s" does not exist.';
   STRING_INDEX_NOT_EXIST              := 'Index "%s" does not exist.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Exclusive access is required for this operation.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Exclusive access is required for this operation.';
 end.
 end.
+

+ 3 - 2
fcl/db/dbase/dbf_str_es.pas

@@ -2,8 +2,8 @@ unit dbf_str;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
-{$I Dbf_Str.inc}
+{$I dbf_common.inc}
+{$I dbf_str.inc}
 
 
 implementation
 implementation
 
 
@@ -33,3 +33,4 @@ initialization
   STRING_INDEX_NOT_EXIST              := 'Indice "%s" no existe.';
   STRING_INDEX_NOT_EXIST              := 'Indice "%s" no existe.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Acceso Exclusivo requirido para esta operación.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Acceso Exclusivo requirido para esta operación.';
 end.
 end.
+

+ 2 - 1
fcl/db/dbase/dbf_str_fr.pas

@@ -2,7 +2,7 @@ unit dbf_str;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 var
 var
   STRING_FILE_NOT_FOUND: string;
   STRING_FILE_NOT_FOUND: string;
@@ -51,3 +51,4 @@ initialization
   STRING_INDEX_NOT_EXIST              := 'L''index "%s" n''existe pas.';
   STRING_INDEX_NOT_EXIST              := 'L''index "%s" n''existe pas.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Access exclusif requis pour cette opération.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Access exclusif requis pour cette opération.';
 end.
 end.
+

+ 2 - 18
fcl/db/dbase/dbf_str_ita.pas

@@ -2,25 +2,9 @@ unit dbf_str;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
+{$I dbf_common.inc}
+{$I dbf_str.inc}
 
 
-var
-  STRING_FILE_NOT_FOUND: string;
-  STRING_VERSION: string;
-
-  STRING_RECORD_LOCKED: string;
-
-  STRING_INVALID_DBF_FILE: string;
-  STRING_FIELD_TOO_LONG: string;
-  STRING_INVALID_FIELD_COUNT: string;
-
-  STRING_INDEX_BASED_ON_UNKNOWN_FIELD: string;
-  STRING_INDEX_BASED_ON_INVALID_FIELD: string;
-  STRING_INVALID_INDEX_TYPE: string;
-  STRING_CANNOT_OPEN_INDEX: string;
-  STRING_TOO_MANY_INDEXES: string;
-  STRING_INDEX_NOT_EXIST: string;
-  STRING_NEED_EXCLUSIVE_ACCESS: string;
 
 
 implementation
 implementation
 
 

+ 3 - 22
fcl/db/dbase/dbf_str_nl.pas

@@ -2,28 +2,8 @@ unit dbf_str;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
-
-var
-  STRING_FILE_NOT_FOUND: string;
-  STRING_VERSION: string;
-
-  STRING_RECORD_LOCKED: string;
-  STRING_KEY_VIOLATION: string;
-
-  STRING_INVALID_DBF_FILE: string;
-  STRING_FIELD_TOO_LONG: string;
-  STRING_INVALID_FIELD_COUNT: string;
-  STRING_INVALID_FIELD_TYPE: string;
-
-  STRING_INDEX_BASED_ON_UNKNOWN_FIELD: string;
-  STRING_INDEX_BASED_ON_INVALID_FIELD: string;
-  STRING_INDEX_EXPRESSION_TOO_LONG: string;
-  STRING_INVALID_INDEX_TYPE: string;
-  STRING_CANNOT_OPEN_INDEX: string;
-  STRING_TOO_MANY_INDEXES: string;
-  STRING_INDEX_NOT_EXIST: string;
-  STRING_NEED_EXCLUSIVE_ACCESS: string;
+{$I dbf_common.inc}
+{$I dbf_str.inc}
 
 
 implementation
 implementation
 
 
@@ -52,3 +32,4 @@ initialization
   STRING_INDEX_NOT_EXIST              := 'Index "%s" bestaat niet.';
   STRING_INDEX_NOT_EXIST              := 'Index "%s" bestaat niet.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Exclusieve toegang is vereist voor deze actie.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Exclusieve toegang is vereist voor deze actie.';
 end.
 end.
+

+ 3 - 2
fcl/db/dbase/dbf_str_pl.pas

@@ -2,8 +2,8 @@ unit dbf_str;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
-{$I Dbf_Str.inc}
+{$I dbf_common.inc}
+{$I dbf_str.inc}
 
 
 implementation
 implementation
 
 
@@ -33,3 +33,4 @@ initialization
   STRING_INDEX_NOT_EXIST              := 'Brak indeksu "%s".';
   STRING_INDEX_NOT_EXIST              := 'Brak indeksu "%s".';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Operacja wymaga dostêpu w trybie Exclusive.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Operacja wymaga dostêpu w trybie Exclusive.';
 end.
 end.
+

+ 2 - 2
fcl/db/dbase/dbf_str_pt.pas

@@ -4,8 +4,8 @@ unit dbf_str;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
-{$I Dbf_Str.inc}
+{$I dbf_common.inc}
+{$I dbf_str.inc}
 
 
 implementation
 implementation
 
 

+ 3 - 2
fcl/db/dbase/dbf_str_ru.pas

@@ -7,8 +7,8 @@ unit dbf_str_ru;
 
 
 interface
 interface
 
 
-{$I Dbf_Common.inc}
-{$I Dbf_Str.inc}
+{$I dbf_common.inc}
+{$I dbf_str.inc}
 
 
 implementation
 implementation
 
 
@@ -37,3 +37,4 @@ initialization
   STRING_INDEX_NOT_EXIST              := 'Èíäåêñ "%s" íå ñóùåñòâóåò.';
   STRING_INDEX_NOT_EXIST              := 'Èíäåêñ "%s" íå ñóùåñòâóåò.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Íåâîçìîæíî âûïîëíèòü - ñíà÷àëà íóæíî ïîëó÷èòü ìîíîïîëüíûé äîñòóï.';
   STRING_NEED_EXCLUSIVE_ACCESS        := 'Íåâîçìîæíî âûïîëíèòü - ñíà÷àëà íóæíî ïîëó÷èòü ìîíîïîëüíûé äîñòóï.';
 end.
 end.
+

+ 96 - 12
fcl/db/dbase/dbf_wtil.pas

@@ -1,6 +1,6 @@
 unit dbf_wtil;
 unit dbf_wtil;
 
 
-{$i Dbf_Common.inc}
+{$I dbf_common.inc}
 
 
 interface
 interface
 
 
@@ -9,7 +9,7 @@ uses
 {$ifdef FPC}
 {$ifdef FPC}
   BaseUnix,
   BaseUnix,
 {$else}
 {$else}
-  Libc,
+  Libc, 
 {$endif}
 {$endif}
   Types, SysUtils, Classes;
   Types, SysUtils, Classes;
 
 
@@ -202,9 +202,9 @@ const
 *)
 *)
 {$ifdef FPC}
 {$ifdef FPC}
   ERROR_LOCK_VIOLATION = ESysEACCES;
   ERROR_LOCK_VIOLATION = ESysEACCES;
-{$else}
+{$else}  
   ERROR_LOCK_VIOLATION = EACCES;
   ERROR_LOCK_VIOLATION = EACCES;
-{$endif}
+{$endif}  
 
 
 { MBCS and Unicode Translation Flags. }
 { MBCS and Unicode Translation Flags. }
   MB_PRECOMPOSED = 1; { use precomposed chars }
   MB_PRECOMPOSED = 1; { use precomposed chars }
@@ -403,9 +403,9 @@ const
   L_XTND          = SEEK_END;
   L_XTND          = SEEK_END;
 *)
 *)
 
 
-const
 
 
-{$IFDEF FPC}
+{$ifdef FPC}
+const
    F_RDLCK = 0;
    F_RDLCK = 0;
    F_WRLCK = 1;
    F_WRLCK = 1;
    F_UNLCK = 2;
    F_UNLCK = 2;
@@ -424,7 +424,7 @@ const
 
 
    EACCES = ESysEACCES;
    EACCES = ESysEACCES;
    EAGAIN = ESysEAGAIN;
    EAGAIN = ESysEAGAIN;
-{$ENDIF}
+{$endif}
 
 
 function LockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD): BOOL;
 function LockFile(hFile: THandle; dwFileOffsetLow, dwFileOffsetHigh: DWORD; nNumberOfBytesToLockLow, nNumberOfBytesToLockHigh: DWORD): BOOL;
 var
 var
@@ -488,40 +488,124 @@ end;
 
 
 function GetOEMCP: Cardinal;
 function GetOEMCP: Cardinal;
 begin
 begin
+{$ifdef HUNGARIAN}
+  Result := 852;
+{$else}
   Result := $FFFFFFFF;
   Result := $FFFFFFFF;
+{$endif}
 end;
 end;
 
 
 function GetACP: Cardinal;
 function GetACP: Cardinal;
 begin
 begin
+{$ifdef HUNGARIAN}
+  Result := 1250;
+{$else}
   Result := 1252;
   Result := 1252;
+{$endif}
+end;
+
+{$ifdef HUNGARIAN}
+
+procedure OemHunHun(AnsiDst: PChar; cchDstLength: DWORD);
+var
+  Count: DWORD;
+begin
+  if Assigned(AnsiDst) and (cchDstLength<>0) then
+  begin
+    for Count:=0 to Pred(cchDstLength) do
+    begin
+      case AnsiDst^ of
+        #160:      AnsiDst^:= #225; {á}
+        #143,#181: AnsiDst^:= #193; {Á}
+        #130:      AnsiDst^:= #233; {é}
+        #144:      AnsiDst^:= #201; {É}
+        #161:      AnsiDst^:= #237; {í}
+        #141,#214: AnsiDst^:= #205; {Í}
+        #162:      AnsiDst^:= #243; {ó}
+        #149,#224: AnsiDst^:= #211; {Ó}
+        #148:      AnsiDst^:= #246; {ö}
+        #153:      AnsiDst^:= #214; {Ö}
+        #147,#139: AnsiDst^:= #245; {õ}
+        #167,#138: AnsiDst^:= #213; {Õ}
+        #163:      AnsiDst^:= #250; {ú}
+        #151,#233: AnsiDst^:= #218; {Ú}
+        #129:      AnsiDst^:= #252; {ü}
+        #154:      AnsiDst^:= #220; {Ü}
+        #150,#251: AnsiDst^:= #251; {û}
+        #152,#235: AnsiDst^:= #219; {Û}
+      end;
+      Inc(AnsiDst);
+    end;
+  end;
+end;
+
+procedure AnsiHunHun(AnsiDst: PChar; cchDstLength: DWORD);
+var
+  Count: DWORD;
+begin
+  if Assigned(AnsiDst) and (cchDstLength<>0) then
+  begin
+    for Count:=0 to Pred(cchDstLength) do
+    begin
+      case AnsiDst^ of
+        #225:      AnsiDst^:= #160; {á}
+        #193:      AnsiDst^:= #181; {Á}
+        #233:      AnsiDst^:= #130; {é}
+        #201:      AnsiDst^:= #144; {É}
+        #237:      AnsiDst^:= #161; {í}
+        #205:      AnsiDst^:= #214; {Í}
+        #243:      AnsiDst^:= #162; {ó}
+        #211:      AnsiDst^:= #224; {Ó}
+        #246:      AnsiDst^:= #148; {ö}
+        #214:      AnsiDst^:= #153; {Ö}
+        #245:      AnsiDst^:= #139; {õ}
+        #213:      AnsiDst^:= #138; {Õ}
+        #250:      AnsiDst^:= #163; {ú}
+        #218:      AnsiDst^:= #233; {Ú}
+        #252:      AnsiDst^:= #129; {ü}
+        #220:      AnsiDst^:= #154; {Ü}
+        #251:      AnsiDst^:= #251; {û}
+        #219:      AnsiDst^:= #235; {Û}
+      end;
+      Inc(AnsiDst);
+    end;
+  end;
 end;
 end;
 
 
+{$endif}
+
 function OemToChar(lpszSrc: PChar; lpszDst: PChar): BOOL;
 function OemToChar(lpszSrc: PChar; lpszDst: PChar): BOOL;
 begin
 begin
   if lpszDst <> lpszSrc then
   if lpszDst <> lpszSrc then
     StrCopy(lpszDst, lpszSrc);
     StrCopy(lpszDst, lpszSrc);
-  Result := TRUE;
+  Result := true;
 end;
 end;
 
 
 function CharToOem(lpszSrc: PChar; lpszDst: PChar): BOOL;
 function CharToOem(lpszSrc: PChar; lpszDst: PChar): BOOL;
 begin
 begin
   if lpszDst <> lpszSrc then
   if lpszDst <> lpszSrc then
     StrCopy(lpszDst, lpszSrc);
     StrCopy(lpszDst, lpszSrc);
-  Result := TRUE;
+  Result := true;
 end;
 end;
 
 
 function OemToCharBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
 function OemToCharBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
 begin
 begin
   if lpszDst <> lpszSrc then
   if lpszDst <> lpszSrc then
     StrLCopy(lpszDst, lpszSrc, cchDstLength);
     StrLCopy(lpszDst, lpszSrc, cchDstLength);
-  Result := TRUE;
+{$ifdef HUNGARIAN}
+  OemHunHun(lpszDst, cchDstLength);
+{$endif}
+  Result := true;
 end;
 end;
 
 
 function CharToOemBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
 function CharToOemBuff(lpszSrc: PChar; lpszDst: PChar; cchDstLength: DWORD): BOOL;
 begin
 begin
   if lpszDst <> lpszSrc then
   if lpszDst <> lpszSrc then
     StrLCopy(lpszDst, lpszSrc, cchDstLength);
     StrLCopy(lpszDst, lpszSrc, cchDstLength);
-  Result := TRUE;
+{$ifdef HUNGARIAN}
+  AnsiHunHun(lpszDst, cchDstLength);
+{$endif}
+  Result := true;
 end;
 end;
 
 
 function MultiByteToWideChar(CodePage: DWORD; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer;
 function MultiByteToWideChar(CodePage: DWORD; dwFlags: DWORD; const lpMultiByteStr: LPCSTR; cchMultiByte: Integer; lpWideCharStr: LPWSTR; cchWideChar: Integer): Integer;
@@ -563,7 +647,7 @@ begin
   Result := True;
   Result := True;
 end;
 end;
 
 
-function GetUserDefaultLCID: LCID; stdcall;
+function GetUserDefaultLCID: LCID;
 begin
 begin
   Result := LANG_ENGLISH or (SUBLANG_ENGLISH_UK shl 10);
   Result := LANG_ENGLISH or (SUBLANG_ENGLISH_UK shl 10);
 end;
 end;

+ 5 - 5
fcl/db/dbase/tdbf_l.pas

@@ -3,19 +3,19 @@
   the package tdbf_l 0.0.
   the package tdbf_l 0.0.
 }
 }
 
 
-unit tdbf_l;
+unit tdbf_l; 
 
 
 interface
 interface
 
 
 uses
 uses
-  Dbf, Dbf_Reg, LazarusPackageIntf;
+  dbf, dbf_reg, LazarusPackageIntf; 
 
 
 implementation
 implementation
 
 
-procedure Register;
+procedure Register; 
 begin
 begin
-  RegisterUnit('Dbf', @Dbf_Reg.Register);
-end;
+  RegisterUnit('Dbf', @dbf_reg.Register); 
+end; 
 
 
 initialization
 initialization
   RegisterPackage('tdbf_l', @Register)
   RegisterPackage('tdbf_l', @Register)

Some files were not shown because too many files changed in this diff