|
@@ -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.
|
|
|
|
+
|