Menu
▾
▴
tdbf-cvs
|
From: <tw...@us...> - 2013-07-25 08:20:42
|
Revision: 297
http://sourceforge.net/p/tdbf/code/297
Author: twm
Date: 2013-07-25 08:20:38 +0000 (Thu, 25 Jul 2013)
Log Message:
-----------
* Delphi 2007 and XE2 compatibility changes
* Bugfixes
* Now supports LEFT function in indexes
Modified Paths:
--------------
trunk/src/dbf.pas
trunk/src/dbf_avl.pas
trunk/src/dbf_collate.pas
trunk/src/dbf_common.inc
trunk/src/dbf_common.pas
trunk/src/dbf_cursor.pas
trunk/src/dbf_dbffile.pas
trunk/src/dbf_fields.pas
trunk/src/dbf_idxcur.pas
trunk/src/dbf_idxfile.pas
trunk/src/dbf_lang.pas
trunk/src/dbf_memo.pas
trunk/src/dbf_parser.pas
trunk/src/dbf_pgcfile.pas
trunk/src/dbf_pgfile.pas
trunk/src/dbf_prscore.pas
trunk/src/dbf_prsdef.pas
trunk/src/dbf_prssupp.pas
trunk/src/dbf_str_de.pas
trunk/src/dbf_struct.inc
trunk/src/dbf_wtil.pas
trunk/src/getstrfromint.inc
Modified: trunk/src/dbf.pas
===================================================================
--- trunk/src/dbf.pas 2013-07-25 08:17:23 UTC (rev 296)
+++ trunk/src/dbf.pas 2013-07-25 08:20:38 UTC (rev 297)
@@ -21,8 +21,12 @@
// this file in your project:
// dsgnintf.pas in 'C: \Program Files\Borland\Delphi5\Source\Toolsapi\dsgnintf.pas'
+{$ifdef SUPPORT_MAXLISTSIZEDEPRECATED}
+const
+ MaxListSize = MaxInt div 16;
+{$endif}
+
type
-
//====================================================================
pBookmarkData = ^TBookmarkData;
TBookmarkData = record
@@ -34,7 +38,7 @@
BookmarkData: TBookmarkData;
BookmarkFlag: TBookmarkFlag;
SequentialRecNo: Integer;
- DeletedFlag: Char;
+ DeletedFlag: AnsiChar;
end;
//====================================================================
TDbf = class;
@@ -48,7 +52,7 @@
TDbfFileNames = set of TDbfFileName;
//====================================================================
TCompareRecordEvent = procedure(Dbf: TDbf; var Accept: Boolean) of object;
- TTranslateEvent = function(Dbf: TDbf; Src, Dest: PChar; ToOem: Boolean): Integer of object;
+ TTranslateEvent = function(Dbf: TDbf; Src, Dest: PAnsiChar; ToOem: Boolean): Integer of object;
TLanguageWarningEvent = procedure(Dbf: TDbf; var Action: TDbfLanguageAction) of object;
TConvertFieldEvent = procedure(Dbf: TDbf; DstField, SrcField: TField) of object;
TBeforeAutoCreateEvent = procedure(Dbf: TDbf; var DoCreate: Boolean) of object;
@@ -117,10 +121,11 @@
FParser: TDbfParser;
FFieldNames: string;
FValidExpression: Boolean;
+ FKeyTranslation: boolean;
FOnMasterChange: TNotifyEvent;
FOnMasterDisable: TNotifyEvent;
- function GetFieldsVal: PChar;
+ function GetFieldsVal: PAnsiChar;
procedure SetFieldNames(const Value: string);
protected
@@ -134,8 +139,9 @@
destructor Destroy; override;
property FieldNames: string read FFieldNames write SetFieldNames;
+ property KeyTranslation: boolean read FKeyTranslation;
property ValidExpression: Boolean read FValidExpression write FValidExpression;
- property FieldsVal: PChar read GetFieldsVal;
+ property FieldsVal: PAnsiChar read GetFieldsVal;
property Parser: TDbfParser read FParser;
property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange;
@@ -160,8 +166,8 @@
FAbsolutePath: string;
FIndexName: string;
FReadOnly: Boolean;
- FFilterBuffer: PChar;
- FTempBuffer: PChar;
+ FFilterBuffer: TDbfRecordBuffer;
+ FTempBuffer: TDbfRecordBuffer;
FEditingRecNo: Integer;
{$ifdef SUPPORT_VARIANTS}
FLocateRecNo: Integer;
@@ -221,18 +227,18 @@
function ParseIndexName(const AIndexName: string): string;
procedure ParseFilter(const AFilter: string);
function GetDbfFieldDefs: TDbfFieldDefs;
- function ReadCurrentRecord(Buffer: PChar; var Acceptable: Boolean): TGetResult;
- function SearchKeyBuffer(Buffer: PChar; SearchType: TSearchKeyType): Boolean;
- procedure SetRangeBuffer(LowRange: PChar; HighRange: PChar);
+ function ReadCurrentRecord(Buffer: TDbfRecordBuffer; var Acceptable: Boolean): TGetResult;
+ function SearchKeyBuffer(Buffer: PAnsiChar; SearchType: TSearchKeyType): Boolean;
+ procedure SetRangeBuffer(LowRange: PAnsiChar; HighRange: PAnsiChar);
protected
{ abstract methods }
- function AllocRecordBuffer: PChar; override; {virtual abstract}
- procedure ClearCalcFields(Buffer: PChar); override;
- procedure FreeRecordBuffer(var Buffer: PChar); override; {virtual abstract}
- procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract}
- function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override; {virtual abstract}
- function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
+ function AllocRecordBuffer: TDbfRecordBuffer; override; {virtual abstract}
+ procedure ClearCalcFields(Buffer: TDbfRecordBuffer); override;
+ procedure FreeRecordBuffer(var Buffer: TDbfRecordBuffer); override; {virtual abstract}
+ procedure GetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); override; {virtual abstract}
+ function GetBookmarkFlag(Buffer: TDbfRecordBuffer): TBookmarkFlag; override; {virtual abstract}
+ function GetRecord(Buffer: TDbfRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
function GetRecordSize: Word; override; {virtual abstract}
procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override; {virtual abstract}
procedure InternalClose; override; {virtual abstract}
@@ -241,7 +247,7 @@
procedure InternalGotoBookmark(ABookmark: Pointer); override; {virtual abstract}
procedure InternalHandleException; override; {virtual abstract}
procedure InternalInitFieldDefs; override; {virtual abstract}
- procedure InternalInitRecord(Buffer: PChar); override; {virtual abstract}
+ procedure InternalInitRecord(Buffer: TDbfRecordBuffer); override; {virtual abstract}
procedure InternalLast; override; {virtual abstract}
procedure InternalOpen; override; {virtual abstract}
procedure InternalEdit; override; {virtual}
@@ -252,13 +258,13 @@
{$endif}
{$endif}
procedure InternalPost; override; {virtual abstract}
- procedure InternalSetToRecord(Buffer: PChar); override; {virtual abstract}
+ procedure InternalSetToRecord(Buffer: TDbfRecordBuffer); override; {virtual abstract}
procedure InitFieldDefs; override;
function IsCursorOpen: Boolean; override; {virtual abstract}
- procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override; {virtual abstract}
- procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override; {virtual abstract}
+ procedure SetBookmarkFlag(Buffer: TDbfRecordBuffer; Value: TBookmarkFlag); override; {virtual abstract}
+ procedure SetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); override; {virtual abstract}
procedure SetFieldData(Field: TField; Buffer: Pointer);
- {$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract}
+ {$ifdef SUPPORT_OVERLOAD}overload;{$ENDIF} override; {virtual abstract}
{ virtual methods (mostly optionnal) }
function GetDataSource: TDataSource; {$ifndef VER1_0}override;{$endif}
@@ -294,16 +300,16 @@
procedure Resync(Mode: TResyncMode); override;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; {virtual}
{$ifdef SUPPORT_NEW_TRANSLATE}
- function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; override; {virtual}
+ function Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; override; {virtual}
{$else}
- procedure Translate(Src, Dest: PChar; ToOem: Boolean); override; {virtual}
+ procedure Translate(Src, Dest: PAnsiChar; ToOem: Boolean); override; {virtual}
{$endif}
{$ifdef SUPPORT_OVERLOAD}
- function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean;
- {$ifdef SUPPORT_BACKWARD_FIELDDATA} overload; override; {$else} reintroduce; overload; {$endif}
- procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean);
- {$ifdef SUPPORT_BACKWARD_FIELDDATA} overload; override; {$else} reintroduce; overload; {$endif}
+ function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload;
+ {$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif}
+ procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload;
+ {$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif}
{$endif}
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
@@ -333,13 +339,13 @@
procedure SetRange(LowRange: Variant; HighRange: Variant; KeyIsANSI: boolean
{$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif});
{$endif}
- function PrepareKey(Buffer: Pointer; BufferType: TExpressionType): PChar;
- function SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType; KeyIsANSI: boolean
+ function PrepareKey(Buffer: Pointer; BufferType: TExpressionType): TDbfRecordBuffer;
+ function SearchKeyPChar(Key: PAnsiChar; SearchType: TSearchKeyType; KeyIsANSI: boolean
{$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif}): Boolean;
- procedure SetRangePChar(LowRange: PChar; HighRange: PChar; KeyIsANSI: boolean
+ procedure SetRangePChar(LowRange: PAnsiChar; HighRange: PAnsiChar; KeyIsANSI: boolean
{$ifdef SUPPORT_DEFAULT_PARAMS}= false{$endif});
- function GetCurrentBuffer: PChar;
- procedure ExtractKey(KeyBuffer: PChar);
+ function GetCurrentBuffer: TDbfRecordBuffer;
+ procedure ExtractKey(KeyBuffer: PAnsiChar);
procedure UpdateIndexDefs; override;
procedure GetFileNames(Strings: TStrings; Files: TDbfFileNames); {$ifdef SUPPORT_DEFAULT_PARAMS} overload; {$endif}
{$ifdef SUPPORT_DEFAULT_PARAMS}
@@ -365,6 +371,7 @@
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): Boolean; override;
{$endif}
+ function IsSequenced: Boolean; override; // lsp
function IsDeleted: Boolean;
procedure Undelete;
@@ -392,6 +399,11 @@
property DbfFile: TDbfFile read FDbfFile;
property UserStream: TStream read FUserStream write FUserStream;
property DisableResyncOnPost: Boolean read FDisableResyncOnPost write FDisableResyncOnPost;
+ // 10.09.2007
+ property CopyDateTimeAsString: Boolean read FCopyDateTimeAsString write FCopyDateTimeAsString;
+ property InCopyFrom: Boolean read FInCopyFrom write FInCopyFrom;
+ //
+
published
property DateTimeHandling: TDateTimeHandling
read FDateTimeHandling write FDateTimeHandling default dtBDETimeStamp;
@@ -440,10 +452,8 @@
property AfterCancel;
property BeforeDelete;
property AfterDelete;
-{$ifdef SUPPORT_REFRESHEVENTS}
property BeforeRefresh;
property AfterRefresh;
-{$endif}
property BeforeScroll;
property AfterScroll;
property OnCalcFields;
@@ -583,8 +593,8 @@
procedure TDbfBlobStream.Translate(ToOem: Boolean);
var
bytesToDo, numBytes: Integer;
- bufPos: PChar;
- saveChar: Char;
+ bufPos: PAnsiChar;
+ saveChar: AnsiChar;
begin
if (Transliterate) and (Size > 0) then
begin
@@ -667,27 +677,27 @@
FMasterLink.Free;
end;
-function TDbf.AllocRecordBuffer: PChar; {override virtual abstract from TDataset}
+function TDbf.AllocRecordBuffer: TDbfRecordBuffer; {override virtual abstract from TDataset}
begin
GetMem(Result, SizeOf(TDbfRecordHeader)+FDbfFile.RecordSize+CalcFieldsSize+1);
end;
-procedure TDbf.FreeRecordBuffer(var Buffer: PChar); {override virtual abstract from TDataset}
+procedure TDbf.FreeRecordBuffer(var Buffer: TDbfRecordBuffer); {override virtual abstract from TDataset}
begin
FreeMemAndNil(Pointer(Buffer));
end;
-procedure TDbf.GetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
+procedure TDbf.GetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); {override virtual abstract from TDataset}
begin
pBookmarkData(Data)^ := pDbfRecord(Buffer)^.BookmarkData;
end;
-function TDbf.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; {override virtual abstract from TDataset}
+function TDbf.GetBookmarkFlag(Buffer: TDbfRecordBuffer): TBookmarkFlag; {override virtual abstract from TDataset}
begin
Result := pDbfRecord(Buffer)^.BookmarkFlag;
end;
-function TDbf.GetCurrentBuffer: PChar;
+function TDbf.GetCurrentBuffer: TDbfRecordBuffer;
begin
case State of
dsFilter: Result := FFilterBuffer;
@@ -726,7 +736,7 @@
NativeFormat = true;
{$endif}
var
- Src: PChar;
+ Src: TDbfRecordBuffer;
begin
Src := GetCurrentBuffer;
if Src = nil then
@@ -739,7 +749,7 @@
begin
Result := FDbfFile.GetFieldData(Field.FieldNo-1, Field.DataType, Src, Buffer, NativeFormat);
end else begin { weird calculated fields voodoo (from dbtables).... }
- Inc(PChar(Src), Field.Offset + GetRecordSize);
+ Inc(Src, Field.Offset + GetRecordSize); // Was PChar(Src)
Result := Boolean(Src[0]);
if Result and (Buffer <> nil) then
Move(Src[1], Buffer^, Field.DataSize);
@@ -760,7 +770,7 @@
NativeFormat = true;
{$endif}
var
- Dst: PChar;
+ Dst: PAnsiChar;
begin
if (Field.FieldNo >= 0) then
begin
@@ -768,10 +778,12 @@
FDbfFile.SetFieldData(Field.FieldNo - 1, Field.DataType, Buffer, Dst, NativeFormat);
end else begin { ***** fkCalculated, fkLookup ***** }
Dst := @PDbfRecord(CalcBuffer)^.DeletedFlag;
- Inc(PChar(Dst), RecordSize + Field.Offset);
- Boolean(Dst[0]) := Buffer <> nil;
- if Buffer <> nil then
- Move(Buffer^, Dst[1], Field.DataSize)
+ Inc(Dst, RecordSize + Field.Offset); // Was PChar(Dst)
+ if Buffer <> nil then begin
+ Dst[0] := #1;
+ Move(Buffer^, Dst[1], Field.DataSize);
+ end else
+ Dst[0] := #0;
end; { end of ***** fkCalculated, fkLookup ***** }
if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin
DataEvent(deFieldChange, PtrInt(Field));
@@ -784,7 +796,7 @@
if Length(Filter) > 0 then
begin
{$ifndef VER1_0}
- Acceptable := Boolean((FParser.ExtractFromBuffer(GetCurrentBuffer))^);
+ Acceptable := Boolean((FParser.ExtractFromBuffer(PAnsiChar(GetCurrentBuffer)))^);
{$else}
// strange problem
// dbf.pas(716,19) Error: Incompatible types: got "CHAR" expected "BOOLEAN"
@@ -797,7 +809,7 @@
OnFilterRecord(Self, Acceptable);
end;
-function TDbf.ReadCurrentRecord(Buffer: PChar; var Acceptable: Boolean): TGetResult;
+function TDbf.ReadCurrentRecord(Buffer: TDbfRecordBuffer; var Acceptable: Boolean): TGetResult;
var
lPhysicalRecNo: Integer;
pRecord: pDbfRecord;
@@ -815,11 +827,12 @@
end;
end;
-function TDbf.GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
+function TDbf.GetRecord(Buffer: TDbfRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
var
pRecord: pDbfRecord;
acceptable: Boolean;
SaveState: TDataSetState;
+ lPhysicalRecNo: Integer;
// s: string;
begin
if FCursor = nil then
@@ -854,7 +867,16 @@
end;
if (Result = grOK) then
- Result := ReadCurrentRecord(Buffer, acceptable);
+ begin
+ lPhysicalRecNo := FCursor.PhysicalRecNo;
+ if (lPhysicalRecNo = 0) or not FDbfFile.IsRecordPresent(lPhysicalRecNo) then
+ begin
+ Result := grError;
+ end else begin
+ FDbfFile.ReadRecord(lPhysicalRecNo, @pRecord^.DeletedFlag);
+ acceptable := (FShowDeleted or (pRecord^.DeletedFlag <> '*'))
+ end;
+ end;
if (Result = grOK) and acceptable then
begin
@@ -1027,17 +1049,17 @@
TempFieldDef := FDbfFile.FieldDefs.Items[I];
// handle duplicate field names
N := 1;
- BaseName := TempFieldDef.FieldName;
- while FieldDefs.IndexOf(TempFieldDef.FieldName)>=0 do
+ BaseName := string(TempFieldDef.FieldName);
+ while FieldDefs.IndexOf(string(TempFieldDef.FieldName))>=0 do
begin
Inc(N);
- TempFieldDef.FieldName:=BaseName+IntToStr(N);
+ TempFieldDef.FieldName := AnsiString(BaseName + IntToStr(N));
end;
// add field
if TempFieldDef.FieldType in [ftString, ftBCD, ftBytes] then
- FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, TempFieldDef.Size, false)
+ FieldDefs.Add(string(TempFieldDef.FieldName), TempFieldDef.FieldType, TempFieldDef.Size, false)
else
- FieldDefs.Add(TempFieldDef.FieldName, TempFieldDef.FieldType, 0, false);
+ FieldDefs.Add(string(TempFieldDef.FieldName), TempFieldDef.FieldType, 0, false);
if TempFieldDef.FieldType = ftFloat then
FieldDefs[I].Precision := TempFieldDef.Precision;
@@ -1111,7 +1133,7 @@
end;
end;
-procedure TDbf.InternalInitRecord(Buffer: PChar); {override virtual abstract from TDataset}
+procedure TDbf.InternalInitRecord(Buffer: TDbfRecordBuffer); {override virtual abstract from TDataset}
var
pRecord: pDbfRecord;
begin
@@ -1192,8 +1214,15 @@
xBaseVII: FTableLevel := 7;
xFoxPro: FTableLevel := TDBF_TABLELEVEL_FOXPRO;
end;
+ // 11.09.2007 \xC5\xF1\xE4\xE8 0, \xED\xE0\xEF\xF0\xE8\xEC\xE5\xF0 DBaseIII, \xE1\xF3\xE4\xE5\xEC \xF1\xF7\xE8\xF2\xE0\xF2\xFC \xE8\xE7 DbfGlobals
+ if FDbfFile.LanguageID=0 then begin
+ FDbfFile.UseCodePage := DbfGlobals.DefaultCreateCodePage; // GETACPOEM;
+ FDbfFile.FileLangId := DbfGlobals.DefaultCreateLangId; // DbfLangId_RUS_866
+ end;
+ // \xD0\xE5\xE0\xEB\xFC\xED\xFB\xE9 locale \xE8\xE7 \xE7\xE0\xE3\xEE\xEB\xEE\xE2\xEA\xE0 \xF4\xE0\xE9\xEB\xE0
FLanguageID := FDbfFile.LanguageID;
+
// build VCL fielddef list from native DBF FieldDefs
(*
if (FDbfFile.HeaderSize = 0) or (FDbfFile.FieldDefs.Count = 0) then
@@ -1297,7 +1326,7 @@
function TDbf.GetLanguageStr: String;
begin
if FDbfFile <> nil then
- Result := FDbfFile.LanguageStr;
+ Result := string(FDbfFile.LanguageStr);
end;
function TDbf.LockTable(const Wait: Boolean): Boolean;
@@ -1406,7 +1435,7 @@
I: Integer;
TempDef: TDbfFieldDef;
- function FieldTypeStr(const FieldType: char): string;
+ function FieldTypeStr(const FieldType: AnsiChar): string;
begin
if FieldType = #0 then
Result := 'NULL'
@@ -1424,10 +1453,11 @@
begin
// check dbffielddefs for errors
TempDef := ADbfFieldDefs.Items[I];
- if FTableLevel < 7 then
- if not (TempDef.NativeFieldType in ['C', 'F', 'N', 'D', 'L', 'M']) then
+ if FTableLevel < 7 then begin
+ if not CharInSet(TempDef.NativeFieldType, ['C', 'F', 'N', 'D', 'L', 'M']) then
raise EDbfError.CreateFmt(STRING_INVALID_FIELD_TYPE,
[FieldTypeStr(TempDef.NativeFieldType), TempDef.FieldName]);
+ end;
end;
end;
@@ -1458,7 +1488,7 @@
begin
with ADbfFieldDefs.AddFieldDef do
begin
- FieldName := FieldDefs.Items[I].Name;
+ FieldName := AnsiString(FieldDefs.Items[I].Name);
FieldType := FieldDefs.Items[I].DataType;
if FieldDefs.Items[I].Size > 0 then
begin
@@ -1591,9 +1621,9 @@
with lFieldDefs.AddFieldDef do
begin
if Length(lSrcField.Name) > 0 then
- FieldName := lSrcField.Name
+ FieldName := AnsiString(lSrcField.Name)
else
- FieldName := lSrcField.FieldName;
+ FieldName := AnsiString(lSrcField.FieldName);
FieldType := lSrcField.DataType;
Required := lSrcField.Required;
if (1 <= lSrcField.FieldNo)
@@ -1839,7 +1869,7 @@
var
searchFlag: TSearchKeyType;
matchRes: Integer;
- lTempBuffer: array [0..100] of Char;
+ lTempBuffer: array [0..100] of AnsiChar;
acceptable, checkmatch: boolean;
begin
if loPartialKey in Options then
@@ -2016,7 +2046,7 @@
{$ifdef SUPPORT_NEW_TRANSLATE}
-function TDbf.Translate(Src, Dest: PChar; ToOem: Boolean): Integer; {override virtual}
+function TDbf.Translate(Src, Dest: PAnsiChar; ToOem: Boolean): Integer; {override virtual}
var
FromCP, ToCP: Cardinal;
begin
@@ -2050,7 +2080,7 @@
{$else}
-procedure TDbf.Translate(Src, Dest: PChar; ToOem: Boolean); {override virtual}
+procedure TDbf.Translate(Src, Dest: PAnsiChar; ToOem: Boolean); {override virtual}
var
FromCP, ToCP: Cardinal;
begin
@@ -2078,16 +2108,16 @@
{$endif}
-procedure TDbf.ClearCalcFields(Buffer: PChar);
+procedure TDbf.ClearCalcFields(Buffer: TDbfRecordBuffer);
var
- lRealBuffer, lCalcBuffer: PChar;
+ lRealBuffer, lCalcBuffer: PAnsiChar;
begin
lRealBuffer := @pDbfRecord(Buffer)^.DeletedFlag;
lCalcBuffer := lRealBuffer + FDbfFile.RecordSize;
FillChar(lCalcBuffer^, CalcFieldsSize, 0);
end;
-procedure TDbf.InternalSetToRecord(Buffer: PChar); {override virtual abstract from TDataset}
+procedure TDbf.InternalSetToRecord(Buffer: TDbfRecordBuffer); {override virtual abstract from TDataset}
var
pRecord: pDbfRecord;
begin
@@ -2113,12 +2143,12 @@
Result := StoreDefs and (FieldDefs.Count > 0);
end;
-procedure TDbf.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); {override virtual abstract from TDataset}
+procedure TDbf.SetBookmarkFlag(Buffer: TDbfRecordBuffer; Value: TBookmarkFlag); {override virtual abstract from TDataset}
begin
pDbfRecord(Buffer)^.BookmarkFlag := Value;
end;
-procedure TDbf.SetBookmarkData(Buffer: PChar; Data: Pointer); {override virtual abstract from TDataset}
+procedure TDbf.SetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); {override virtual abstract from TDataset}
begin
pDbfRecord(Buffer)^.BookmarkData := pBookmarkData(Data)^;
end;
@@ -2225,7 +2255,7 @@
begin
FParser := TDbfParser.Create(FDbfFile);
// we need truncated, translated (to ANSI) strings
- FParser.StringFieldMode := smAnsiTrim;
+ FParser.RawStringFields := false;
end;
// have a parser now?
if FParser <> nil then
@@ -2609,28 +2639,40 @@
end;
end;
+// IsSequenced controls scrollbar behavior for e.g. TDBGrid. When the number
+// of records is unknown (e.g. when Filtered), this turns the scrollbar into
+// the somewhat awkward 3-state scrollbar rather than the scrollbar with a
+// range that is too wide.
+function TDbf.IsSequenced: Boolean; // lsp
+begin
+ Result := (not Filtered);
+end;
+
function TDbf.IsDeleted: Boolean;
var
- src: PChar;
+ src: PAnsiChar;
begin
- src := GetCurrentBuffer;
+ src := PAnsiChar(GetCurrentBuffer);
IsDeleted := (src=nil) or (src^ = '*')
end;
procedure TDbf.Undelete;
var
- src: PChar;
+ src: TDbfRecordBuffer;
+ srcptr: PAnsiChar;
begin
if State <> dsEdit then
inherited Edit;
// get active buffer
src := GetCurrentBuffer;
- if (src <> nil) and (src^ = '*') then
+ srcptr := PAnsiChar(src);
+ if (srcptr <> nil) and (srcptr^ = '*') then
begin
// notify indexes record is about to be recalled
FDbfFile.RecordRecalled(FCursor.PhysicalRecNo, src);
// recall record
- src^ := ' ';
+ srcptr := PAnsiChar(src);
+ srcptr^ := ' ';
FDbfFile.WriteRecord(FCursor.PhysicalRecNo, src);
end;
end;
@@ -2646,7 +2688,7 @@
Refresh;
end;
-procedure TDbf.SetRangeBuffer(LowRange: PChar; HighRange: PChar);
+procedure TDbf.SetRangeBuffer(LowRange: PAnsiChar; HighRange: PAnsiChar);
begin
if FIndexFile = nil then
exit;
@@ -2661,7 +2703,7 @@
procedure TDbf.SetRange(LowRange: Variant; HighRange: Variant; KeyIsANSI: boolean);
var
- LowBuf, HighBuf: array[0..100] of Char;
+ LowBuf, HighBuf: array[0..100] of AnsiChar;
begin
if (FIndexFile = nil) or VarIsNull(LowRange) or VarIsNull(HighRange) then
exit;
@@ -2676,19 +2718,19 @@
{$endif}
-procedure TDbf.SetRangePChar(LowRange: PChar; HighRange: PChar; KeyIsANSI: boolean);
+procedure TDbf.SetRangePChar(LowRange: PAnsiChar; HighRange: PAnsiChar; KeyIsANSI: boolean);
var
- LowBuf, HighBuf: array [0..100] of Char;
- LowPtr, HighPtr: PChar;
+ LowBuf, HighBuf: array [0..100] of AnsiChar;
+ LowPtr, HighPtr: PAnsiChar;
begin
if FIndexFile = nil then
exit;
- // convert to pchars
+ // convert to PAnsiChars
if KeyIsANSI then
begin
- Translate(LowRange, @LowBuf[0], true);
- Translate(HighRange, @HighBuf[0], true);
+ Translate(PAnsiChar(LowRange), @LowBuf[0], true);
+ Translate(PAnsiChar(HighRange), @HighBuf[0], true);
LowRange := @LowBuf[0];
HighRange := @HighBuf[0];
end;
@@ -2697,7 +2739,7 @@
SetRangeBuffer(LowPtr, HighPtr);
end;
-procedure TDbf.ExtractKey(KeyBuffer: PChar);
+procedure TDbf.ExtractKey(KeyBuffer: PAnsiChar);
begin
if FIndexFile <> nil then
StrCopy(FIndexFile.ExtractKeyFromBuffer(GetCurrentBuffer), KeyBuffer)
@@ -2717,7 +2759,7 @@
function TDbf.SearchKey(Key: Variant; SearchType: TSearchKeyType; KeyIsANSI: boolean): Boolean;
var
- TempBuffer: array [0..100] of Char;
+ TempBuffer: array [0..100] of AnsiChar;
begin
if (FIndexFile = nil) or VarIsNull(Key) then
begin
@@ -2733,7 +2775,7 @@
{$endif}
-function TDbf.PrepareKey(Buffer: Pointer; BufferType: TExpressionType): PChar;
+function TDbf.PrepareKey(Buffer: Pointer; BufferType: TExpressionType): TDbfRecordBuffer;
begin
if FIndexFile = nil then
begin
@@ -2744,9 +2786,9 @@
Result := TIndexCursor(FCursor).IndexFile.PrepareKey(Buffer, BufferType);
end;
-function TDbf.SearchKeyPChar(Key: PChar; SearchType: TSearchKeyType; KeyIsANSI: boolean): Boolean;
+function TDbf.SearchKeyPChar(Key: PAnsiChar; SearchType: TSearchKeyType; KeyIsANSI: boolean): Boolean;
var
- StringBuf: array [0..100] of Char;
+ StringBuf: array [0..100] of AnsiChar;
begin
if FCursor = nil then
begin
@@ -2756,13 +2798,13 @@
if KeyIsANSI then
begin
- Translate(Key, @StringBuf[0], true);
+ Translate(PAnsiChar(Key), @StringBuf[0], true);
Key := @StringBuf[0];
end;
Result := SearchKeyBuffer(TIndexCursor(FCursor).CheckUserKey(Key, @StringBuf[0]), SearchType);
end;
-function TDbf.SearchKeyBuffer(Buffer: PChar; SearchType: TSearchKeyType): Boolean;
+function TDbf.SearchKeyBuffer(Buffer: PAnsiChar; SearchType: TSearchKeyType): Boolean;
var
matchRes: Integer;
begin
@@ -2816,18 +2858,17 @@
procedure TDbf.UpdateRange;
var
- fieldsVal: PChar;
- tempBuffer: array[0..300] of char;
+ fieldsVal: PAnsiChar;
+ tempBuffer: array[0..300] of AnsiChar;
begin
fieldsVal := FMasterLink.FieldsVal;
- if (TDbf(FMasterLink.DataSet).DbfFile.UseCodePage <> FDbfFile.UseCodePage)
- and (FMasterLink.Parser.ResultType = etString) then
+ if FMasterLink.KeyTranslation then
begin
FMasterLink.DataSet.Translate(fieldsVal, @tempBuffer[0], false);
fieldsVal := @tempBuffer[0];
Translate(fieldsVal, fieldsVal, true);
end;
- fieldsVal := TIndexCursor(FCursor).IndexFile.PrepareKey(fieldsVal, FMasterLink.Parser.ResultType);
+ fieldsVal := PAnsiChar(TIndexCursor(FCursor).IndexFile.PrepareKey({$IFDEF SUPPORT_TRECORDBUFFER}TDbfRecordBuffer{$ENDIF}(fieldsVal), FMasterLink.Parser.ResultType));
SetRangeBuffer(fieldsVal, fieldsVal);
end;
@@ -2973,6 +3014,8 @@
FValidExpression := false;
FParser.DbfFile := (DataSet as TDbf).DbfFile;
FParser.ParseExpression(FFieldNames);
+ FKeyTranslation := TDbfFile(FParser.DbfFile).UseCodePage <>
+ FDetailDataSet.DbfFile.UseCodePage;
FValidExpression := true;
end else begin
FParser.ClearExpressions;
@@ -3013,7 +3056,7 @@
end;
end;
-function TDbfMasterLink.GetFieldsVal: PChar;
+function TDbfMasterLink.GetFieldsVal: PAnsiChar;
begin
Result := FParser.ExtractFromBuffer(@pDbfRecord(TDbf(DataSet).ActiveBuffer)^.DeletedFlag);
end;
Modified: trunk/src/dbf_avl.pas
===================================================================
--- trunk/src/dbf_avl.pas 2013-07-25 08:17:23 UTC (rev 296)
+++ trunk/src/dbf_avl.pas 2013-07-25 08:20:38 UTC (rev 297)
@@ -38,7 +38,7 @@
FOnDelete: TAvlTreeEvent;
FHeightChange: Boolean;
- function InternalInsert(X: PNode; var P: PNode): Boolean;
+ procedure InternalInsert(X: PNode; var P: PNode);
procedure InternalDelete(X: TKeyType; var P: PNode);
procedure DeleteNode(X: PNode);
@@ -49,7 +49,7 @@
procedure Clear;
function Find(Key: TKeyType): TExtraData;
- function Insert(Key: TKeyType; Extra: TExtraData): Boolean;
+ procedure Insert(Key: TKeyType; Extra: TExtraData);
procedure Delete(Key: TKeyType);
function Lowest: PData;
@@ -271,7 +271,7 @@
Result := nil;
end;
-function TAvlTree.Insert(Key: TKeyType; Extra: TExtraData): boolean;
+procedure TAvlTree.Insert(Key: TKeyType; Extra: TExtraData);
var
H: PNode;
begin
@@ -286,9 +286,7 @@
Bal := 0;
end;
// insert new node
- Result := InternalInsert(H, FRoot);
- if not Result then
- Dispose(H);
+ InternalInsert(H, FRoot);
// check tree
// assert(CheckTree(FRoot));
end;
@@ -299,19 +297,15 @@
// assert(CheckTree(FRoot));
end;
-function TAvlTree.InternalInsert(X: PNode; var P: PNode): boolean;
+procedure TAvlTree.InternalInsert(X: PNode; var P: PNode);
begin
- if P = nil then
- begin
- P := X;
- Inc(FCount);
- FHeightChange := true;
- Result := true;
- end else begin
+ if P = nil
+ then begin P := X; Inc(FCount); FHeightChange := true end
+ else
if X^.Data.ID < P^.Data.ID then
begin
{ less }
- Result := InternalInsert(X, P^.Left);
+ InternalInsert(X, P^.Left);
if FHeightChange then {Left branch has grown higher}
case P^.Bal of
1: begin P^.Bal := 0; FHeightChange := false end;
@@ -344,7 +338,7 @@
if X^.Data.ID > P^.Data.ID then
begin
{ greater }
- Result := InternalInsert(X, P^.Right);
+ InternalInsert(X, P^.Right);
if FHeightChange then {Right branch has grown higher}
case P^.Bal of
-1: begin P^.Bal := 0; FHeightChange := false end;
@@ -376,9 +370,8 @@
end {greater} else begin
{X already present; do not insert again}
FHeightChange := false;
- Result := false;
end;
- end;
+
// assert(CheckTree(P));
end;{InternalInsert}
Modified: trunk/src/dbf_collate.pas
===================================================================
--- trunk/src/dbf_collate.pas 2013-07-25 08:17:23 UTC (rev 296)
+++ trunk/src/dbf_collate.pas 2013-07-25 08:20:38 UTC (rev 297)
@@ -1,4 +1,4 @@
-unit dbf_collate;
+unit Dbf_Collate;
{$i dbf_common.inc}
@@ -29,7 +29,7 @@
function GetCollationTable( DbfLangId :integer ) :PCollationTable;
-function DbfCompareString( CollationTable :PCollationTable; String1 :PChar; nLength1 :integer; String2 :PChar; nLength2 :integer ) :integer;
+function DbfCompareString( CollationTable :PCollationTable; String1 :PAnsiChar; nLength1 :integer; String2 :PAnsiChar; nLength2 :integer ) :integer;
function RegisterCollation( DbfLangId :integer; CollationTable :PCollationTable; BDEName :TCollationBDEName ) :Boolean;
@@ -64,7 +64,7 @@
end;
end;
-function DbfCompareString( CollationTable :PCollationTable; String1 :PChar; nLength1 :integer; String2 :PChar; nLength2 :integer ) :integer;
+function DbfCompareString( CollationTable :PCollationTable; String1 :PAnsiChar; nLength1 :integer; String2 :PAnsiChar; nLength2 :integer ) :integer;
var
nCnt, nMax, nVal1, nVal2 :integer;
const
@@ -763,8 +763,8 @@
db866ru0 :PCollationTable = @_db866ru0;
-{$ifdef USE_BORLAND_COLLATION_TABLES}
+
// BLLT1DA0 64770
_BLLT1DA0 :TCollationTable = (
@@ -926,9 +926,9 @@
);
BLLT1NO0 :PCollationTable = @_BLLT1NO0;
-{$endif}
+
// DB850US0 Checksum: 43413
_DB850US0 :TCollationTable = (
@@ -954,7 +954,7 @@
-{$ifdef USE_PARADOX_COLLATIONS}
+ {$IFDEF PARADOX_COLLATIONS}
// intl850 43039
@@ -978,7 +978,13 @@
);
intl850 :PCollationTable = @_intl850;
+ {$ENDIF}
+
+
+
+ {$IFDEF PARADOX_COLLATIONS}
+
// SPANISH 20109
_SPANISH :TCollationTable = (
@@ -1001,10 +1007,12 @@
);
SPANISH :PCollationTable = @_SPANISH;
+ {$ENDIF}
+ {$IFDEF PARADOX_COLLATIONS}
// iceland 23936
@@ -1028,10 +1036,12 @@
);
iceland :PCollationTable = @_iceland;
+ {$ENDIF}
+ {$IFDEF PARADOX_COLLATIONS}
// ANSIINTL 58462
@@ -1055,10 +1065,12 @@
);
ANSIINTL :PCollationTable = @_ANSIINTL;
+ {$ENDIF}
+ {$IFDEF PARADOX_COLLATIONS}
// ANSII850 29000
@@ -1082,10 +1094,12 @@
);
ANSII850 :PCollationTable = @_ANSII850;
+ {$ENDIF}
+ {$IFDEF PARADOX_COLLATIONS}
// ANSISPAN 33308
@@ -1109,10 +1123,12 @@
);
ANSISPAN :PCollationTable = @_ANSISPAN;
+ {$ENDIF}
+ {$IFDEF PARADOX_COLLATIONS}
// ANSISWFN 44782
@@ -1136,10 +1152,12 @@
);
ANSISWFN :PCollationTable = @_ANSISWFN;
+ {$ENDIF}
+ {$IFDEF PARADOX_COLLATIONS}
// ANSINOR4 55290
@@ -1163,7 +1181,7 @@
);
ANSINOR4 :PCollationTable = @_ANSINOR4;
-{$endif}
+ {$ENDIF}
@@ -1188,7 +1206,12 @@
096, 097, 098, 099, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111,
112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127
);
+ china :PCollationTable = @_china;
+ korea :PCollationTable = @_china;
+
+ taiwan :PCollationTable = @_china;
+
DB936CN0 :PCollationTable = @_china;
DB949KO0 :PCollationTable = @_china;
@@ -1218,16 +1241,7 @@
247, 248, 249, 250, 251, 195, 196, 176, 177, 178, 179, 180, 181, 182, 197, 198,
199, 200, 201, 202, 203, 204, 205, 206, 207, 208, 209, 210, 252, 253, 254, 255
);
-
-{$ifdef USE_PARADOX_COLLATIONS}
- china :PCollationTable = @_china;
-
- korea :PCollationTable = @_china;
-
- taiwan :PCollationTable = @_china;
-
thai :PCollationTable = @_thai;
-{$endif}
db874th0 :PCollationTable = @_thai;
@@ -1284,8 +1298,8 @@
DBWINES0 :PCollationTable = @_DBWINWE0;
-{$ifdef USE_ACCESS_COLLATIONS}
+
// ACCGEN 19621
_ACCGEN :TCollationTable = (
@@ -1358,9 +1372,9 @@
);
ACCSWFIN :PCollationTable = @_ACCSWFIN;
-{$endif}
+
// FOXDE437 Checksum: 21075
_FOXDE437 :TCollationTable = (
@@ -1486,7 +1500,7 @@
-{$ifdef USE_PARADOX_COLLATIONS}
+ {$IFDEF PARADOX_COLLATIONS}
// czech 30844
@@ -1517,6 +1531,7 @@
czechw :PCollationTable = @_czech;
+ {$ENDIF}
@@ -1546,6 +1561,7 @@
+ {$IFDEF PARADOX_COLLATIONS}
// polish 59020
@@ -1569,10 +1585,12 @@
);
polish :PCollationTable = @_polish;
+ {$ENDIF}
+ {$IFDEF PARADOX_COLLATIONS}
// cyrr 20081
@@ -1596,10 +1614,12 @@
);
cyrr :PCollationTable = @_cyrr;
+ {$ENDIF}
+ {$IFDEF PARADOX_COLLATIONS}
// hun852dc 62898
@@ -1623,7 +1643,7 @@
);
hun852dc :PCollationTable = @_hun852dc;
-{$endif}
+ {$ENDIF}
@@ -1648,6 +1668,7 @@
180, 149, 154, 157, 160, 161, 168, 176, 175, 181, 118, 123, 126, 129, 136, 142,
147, 241, 242, 243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, 255
);
+ grcp437 :PCollationTable = @_grcp437;
db437gr0 :PCollationTable = @_grcp437;
@@ -1676,6 +1697,7 @@
);
dbhebrew :PCollationTable = @_dbhebrew;
+ Hebrew :PCollationTable = @_dbhebrew;
@@ -1700,18 +1722,13 @@
142, 158, 143, 133, 130, 131, 163, 162, 153, 177, 150, 178, 187, 189, 166, 242,
243, 244, 245, 246, 247, 248, 249, 250, 251, 252, 253, 173, 154, 151, 254, 255
);
+ slovene :PCollationTable = @_slovene;
+
db852sl0 :PCollationTable = @_slovene;
-{$ifdef USE_PARADOX_COLLATIONS}
- grcp437 :PCollationTable = @_grcp437;
- hebrew :PCollationTable = @_dbhebrew;
- slovene :PCollationTable = @_slovene;
-{$endif}
-
-
{$IFDEF PARADOX_COLLATIONS}
// turk 8582
@@ -1773,7 +1790,6 @@
- {$IFDEF PARADOX_COLLATIONS}
// cskamenw 40577
@@ -1799,11 +1815,9 @@
cskamen :PCollationTable = @_cskamenw;
- {$ENDIF}
-
{$IFDEF PARADOX_COLLATIONS}
// anpolish 44922
@@ -1890,7 +1904,6 @@
- {$IFDEF PARADOX_COLLATIONS}
// angreek1 39126
@@ -1916,10 +1929,9 @@
ACCGREEK :PCollationTable = @_angreek1;
- {$ENDIF}
- {$IFDEF PARADOX_COLLATIONS}
+
// ansislov 61480
_ansislov :TCollationTable = (
@@ -1942,12 +1954,9 @@
);
ansislov :PCollationTable = @_ansislov;
- {$ENDIF}
- {$IFDEF USE_PARADOX_COLLATIONS}
-
// ANTURK 24004
_ANTURK :TCollationTable = (
@@ -1970,7 +1979,6 @@
);
ANTURK :PCollationTable = @_ANTURK;
- {$ENDIF}
@@ -2048,7 +2056,6 @@
- {$IFDEF USE_ACCESS_COLLATIONS}
// BLROM800 28847
@@ -2072,10 +2079,8 @@
);
BLROM800 :PCollationTable = @_BLROM800;
- {$ENDIF}
- {$IFDEF USE_ORACLE_COLLATIONS}
// ORAWE850 31378
@@ -2099,12 +2104,9 @@
);
ORAWE850 :PCollationTable = @_ORAWE850 ;
- {$ENDIF}
- {$IFDEF USE_SYBASE_COLLATIONS}
-
// SYDC850 46023
_SYDC850 :TCollationTable = (
@@ -2152,10 +2154,8 @@
);
SYDC437 :PCollationTable = @_SYDC437;
- {$ENDIF}
- {$IFDEF USE_DB2_COLLATIONS}
// db2andeu 8683
@@ -2179,8 +2179,6 @@
);
db2andeu :PCollationTable = @_db2andeu;
- {$ENDIF}
-
initialization
InitialiseCollationTables;
Modified: trunk/src/dbf_common.inc
===================================================================
--- trunk/src/dbf_common.inc 2013-07-25 08:17:23 UTC (rev 296)
+++ trunk/src/dbf_common.inc 2013-07-25 08:20:38 UTC (rev 297)
@@ -53,6 +53,9 @@
#ERROR tDbf needs Delphi or C++ Builder 3 minimum.
{$endif}
+// DELPHI_X is defined if the compiler is at least that version of Delphi
+// e.g. DELPHI_5 means, it's Delphi 5 or newer
+
{$ifdef VER100} // Delphi 3
{$define DELPHI_3}
{$endif}
@@ -144,23 +147,122 @@
{$define DELPHI_3}
{$endif}
-{$ifdef VER185} // Delphi 2007
+{$ifdef VER190} // Delphi 2007
{$define DELPHI_2007}
- { Delphi 2007 also defines VER180, so other DELPHI defines already done }
+ {$define DELPHI_2006}
+ {$define DELPHI_2005}
+ {$define DELPHI_8}
+ {$define DELPHI_7}
+ {$define DELPHI_6}
+ {$define DELPHI_5}
+ {$define DELPHI_4}
+ {$define DELPHI_3}
{$endif}
+{$ifdef VER200} // Delphi 2009
+ {$define DELPHI_2009}
+ {$define DELPHI_2007}
+ {$define DELPHI_2006}
+ {$define DELPHI_2005}
+ {$define DELPHI_8}
+ {$define DELPHI_7}
+ {$define DELPHI_6}
+ {$define DELPHI_5}
+ {$define DELPHI_4}
+ {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER210} // Delphi 2010
+ {$define DELPHI_2010}
+ {$define DELPHI_2009}
+ {$define DELPHI_2007}
+ {$define DELPHI_2006}
+ {$define DELPHI_2005}
+ {$define DELPHI_8}
+ {$define DELPHI_7}
+ {$define DELPHI_6}
+ {$define DELPHI_5}
+ {$define DELPHI_4}
+ {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER220} // Delphi XE
+ {$define DELPHI_XE}
+ {$define DELPHI_2010}
+ {$define DELPHI_2009}
+ {$define DELPHI_2007}
+ {$define DELPHI_2006}
+ {$define DELPHI_2005}
+ {$define DELPHI_8}
+ {$define DELPHI_7}
+ {$define DELPHI_6}
+ {$define DELPHI_5}
+ {$define DELPHI_4}
+ {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER230} // Delphi XE2
+ {$define DELPHI_XE2}
+ {$define DELPHI_XE}
+ {$define DELPHI_2010}
+ {$define DELPHI_2009}
+ {$define DELPHI_2007}
+ {$define DELPHI_2006}
+ {$define DELPHI_2005}
+ {$define DELPHI_8}
+ {$define DELPHI_7}
+ {$define DELPHI_6}
+ {$define DELPHI_5}
+ {$define DELPHI_4}
+ {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER240} // Delphi XE3 (not tested)
+ {$define DELPHI_XE3}
+ {$define DELPHI_XE2}
+ {$define DELPHI_XE}
+ {$define DELPHI_2010}
+ {$define DELPHI_2009}
+ {$define DELPHI_2007}
+ {$define DELPHI_2006}
+ {$define DELPHI_2005}
+ {$define DELPHI_8}
+ {$define DELPHI_7}
+ {$define DELPHI_6}
+ {$define DELPHI_5}
+ {$define DELPHI_4}
+ {$define DELPHI_3}
+{$endif}
+
+{$ifdef VER250} // Delphi XE4 (not tested)
+ {$define DELPHI_XE4}
+ {$define DELPHI_XE3}
+ {$define DELPHI_XE2}
+ {$define DELPHI_XE}
+ {$define DELPHI_2010}
+ {$define DELPHI_2009}
+ {$define DELPHI_2007}
+ {$define DELPHI_2006}
+ {$define DELPHI_2005}
+ {$define DELPHI_8}
+ {$define DELPHI_7}
+ {$define DELPHI_6}
+ {$define DELPHI_5}
+ {$define DELPHI_4}
+ {$define DELPHI_3}
+{$endif}
+
//-------------------------------------------------------
//--- Conclude supported features from delphi version ---
//-------------------------------------------------------
{$ifdef DELPHI_3}
-
{$define SUPPORT_VARIANTS}
{$define WINDOWS}
{$define ENDIAN_LITTLE}
+{$endif}
{$ifdef DELPHI_4}
-
{$define SUPPORT_DEFCHANGED}
{$define SUPPORT_DEFAULT_PARAMS}
{$define SUPPORT_OVERLOAD}
@@ -174,24 +276,30 @@
{$define SUPPORT_FIELDTYPES_V4}
{$define SUPPORT_UINT32_CARDINAL}
{$define SUPPORT_MATH_UNIT}
+{$endif}
{$ifdef DELPHI_5}
-
{$define SUPPORT_BACKWARD_FIELDDATA}
{$define SUPPORT_INITDEFSFROMFIELDS}
- {$define SUPPORT_REFRESHEVENTS}
{$define SUPPORT_DEF_DELETE}
{$define SUPPORT_FREEANDNIL}
+{$endif}
{$ifdef DELPHI_6}
-
{$define SUPPORT_PATHDELIM}
{$define SUPPORT_SEPARATE_VARIANTS_UNIT}
+ {$define SUPPORT_INCLTRAILPATHDELIM} // Was missing 20130529
+ {$define SUPPORT_INCLTRAILBACKSLASH} // Was missing 20130529
{$endif}
+
+{$ifdef Delphi_2009}
+ {$define WINAPI_IS_UNICODE}
+ {$define SUPPORT_TRECORDBUFFER}
+ {$define SUPPORT_CHARINSET}
+ {$define SUPPORT_MAXLISTSIZEDEPRECATED}
+ {$define SUPPORT_FORMATSETTINGS}
{$endif}
-{$endif}
-{$endif}
//------------------------------------------------------
//--- Conclude supported features in FreePascal ---
@@ -221,7 +329,6 @@
{$define SUPPORT_MATH_UNIT}
{$define SUPPORT_VARIANTS}
{$define SUPPORT_SEPARATE_VARIANTS_UNIT}
- {$define SUPPORT_REFRESHEVENTS}
// FPC 2.0.x improvements
{$ifdef VER2}
Modified: trunk/src/dbf_common.pas
===================================================================
--- trunk/src/dbf_common.pas 2013-07-25 08:17:23 UTC (rev 296)
+++ trunk/src/dbf_common.pas 2013-07-25 08:20:38 UTC (rev 297)
@@ -6,7 +6,7 @@
uses
SysUtils, Classes, DB
-{$ifndef WINDOWS}
+{$ifndef MSWINDOWS}
, Types, dbf_wtil
{$ifdef KYLIX}
, Libc
@@ -18,18 +18,26 @@
const
TDBF_MAJOR_VERSION = 6;
TDBF_MINOR_VERSION = 9;
- TDBF_SUB_MINOR_VERSION = 2;
+ TDBF_SUB_MINOR_VERSION = 1;
TDBF_TABLELEVEL_FOXPRO = 25;
JulianDateDelta = 1721425; { number of days between 1.1.4714 BC and "0" }
type
- EDbfError = class (EDatabaseError);
- EDbfWriteError = class (EDbfError);
+ EDbfError = class (EDatabaseError)
+ end;
+ EDbfWriteError = class (EDbfError)
+ end;
- TDbfFieldType = char;
+{$ifdef SUPPORT_TRECORDBUFFER}
+ TDbfRecordBuffer = TRecordBuffer;
+{$else}
+ TDbfRecordBuffer = PAnsiChar;
+{$endif}
+ TDbfFieldType = AnsiChar;
+
TXBaseVersion = (xUnknown, xClipper, xBaseIII, xBaseIV, xBaseV, xFoxPro, xBaseVII);
TSearchKeyType = (stEqual, stGreaterEqual, stGreater);
@@ -38,15 +46,27 @@
//-------------------------------------
PDateTime = ^TDateTime;
-{$ifndef FPC_VERSION}
+{$ifdef FPC_VERSION}
+ TDateTimeAlias = type TDateTime;
+ TDateTimeRec = record
+ case TFieldType of
+ ftDate: (Date: Longint);
+ ftTime: (Time: Longint);
+ ftDateTime: (DateTime: TDateTimeAlias);
+ end;
+{$else}
PtrInt = Longint;
{$endif}
PSmallInt = ^SmallInt;
PCardinal = ^Cardinal;
- PDouble = ^Double;
+// PDouble = ^Double;
PString = ^String;
+ PDateTimeRec = ^TDateTimeRec;
+{$ifdef SUPPORT_INT64}
+ PLargeInt = ^Int64;
+{$endif}
{$ifdef DELPHI_3}
dword = cardinal;
{$endif}
@@ -59,11 +79,15 @@
{$endif}
procedure FreeMemAndNil(var P: Pointer);
+{$ifndef SUPPORT_CHARINSET}
+function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean;
+{$endif SUPPORT_CHARINSET}
+
//-------------------------------------
{$ifndef SUPPORT_PATHDELIM}
const
-{$ifdef WINDOWS}
+{$ifdef MSWINDOWS}
PathDelim = '\';
{$else}
PathDelim = '/';
@@ -72,8 +96,13 @@
{$ifndef SUPPORT_INCLTRAILPATHDELIM}
function IncludeTrailingPathDelimiter(const Path: string): string;
-{$endif}
+{$endif SUPPORT_INCLTRAILPATHDELIM}
+{$ifdef SUPPORT_FORMATSETTINGS}
+function TwoDigitYearCenturyWindow: word;
+function DecimalSeparator: char;
+{$endif SUPPORT_FORMATSETTINGS}
+
//-------------------------------------
function GetCompletePath(const Base, Path: string): string;
@@ -81,6 +110,12 @@
function IsFullFilePath(const Path: string): Boolean; // full means not relative
function DateTimeToBDETimeStamp(aDT: TDateTime): double;
function BDETimeStampToDateTime(aBT: double): TDateTime;
+function GetStrFromInt(Val: Integer; const Dst: PAnsiChar): Integer; // Was PChar
+procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PAnsiChar; const PadChar: AnsiChar); // Was Char
+{$ifdef SUPPORT_INT64}
+function GetStrFromInt64(Val: Int64; const Dst: PAnsiChar): Integer; // Was PChar
+procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PAnsiChar; const PadChar: AnsiChar); // Was Char
+{$endif}
procedure FindNextName(BaseName: string; var OutName: string; var Modifier: Integer);
{$ifdef USE_CACHE}
function GetFreeMemory: Integer;
@@ -95,7 +130,7 @@
procedure SwapInt64LE(Value, Result: Pointer); register;
{$endif}
-function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PChar; Length: Integer): Integer;
+function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PAnsiChar; Length: Integer): Integer;
// Returns a pointer to the first occurence of Chr in Str within the first Length characters
// Does not stop at null (#0) terminator!
@@ -111,7 +146,7 @@
implementation
-{$ifdef WINDOWS}
+{$ifdef MSWINDOWS}
uses
Windows;
{$endif}
@@ -137,11 +172,11 @@
function IsFullFilePath(const Path: string): Boolean; // full means not relative
begin
-{$ifdef WINDOWS}
+{$ifdef MSWINDOWS}
Result := Length(Path) > 1;
if Result then
// check for 'x:' or '\\' at start of path
- Result := ((Path[2]=':') and (upcase(Path[1]) in ['A'..'Z']))
+ Result := ((Path[2]=':') and CharInSet(UpCase(Path[1]), ['A'..'Z']))
or ((Path[1]='\') and (Path[2]='\'));
{$else} // Linux
Result := Length(Path) > 0;
@@ -163,6 +198,89 @@
result := lpath;
end;
+// it seems there is no pascal function to convert an integer into a PAnsiChar???
+
+procedure GetStrFromInt_Width(Val: Integer; const Width: Integer; const Dst: PAnsiChar; const PadChar: AnsiChar); // Was Char
+var
+ Temp: array[0..10] of AnsiChar;
+ I, J: Integer;
+ NegSign: boolean;
+begin
+ {$I getstrfromint.inc}
+end;
+
+{$ifdef SUPPORT_INT64}
+
+procedure GetStrFromInt64_Width(Val: Int64; const Width: Integer; const Dst: PAnsiChar; const PadChar: AnsiChar); // Was Char
+var
+ Temp: array[0..19] of AnsiChar;
+ I, J: Integer;
+ NegSign: boolean;
+begin
+ {$I getstrfromint.inc}
+end;
+
+{$endif}
+
+// it seems there is no pascal function to convert an integer into a PAnsiChar???
+// NOTE: in dbf_dbffile.pas there is also a convert routine, but is slightly different
+
+function GetStrFromInt(Val: Integer; const Dst: PAnsiChar): Integer; // Was PChar
+var
+ Temp: array[0..10] of AnsiChar; // Was Char
+ I, J: Integer;
+begin
+ Val := Abs(Val);
+ // we'll have to store characters backwards first
+ I := 0;
+ J := 0;
+ repeat
+ Temp[I] := AnsiChar((Val mod 10) + Ord('0')); // Was Chr
+ Val := Val div 10;
+ Inc(I);
+ until Val = 0;
+
+ // remember number of digits
+ Result := I;
+ // copy value, remember: stored backwards
+ repeat
+ Dst[J] := Temp[I-1];
+ Inc(J);
+ Dec(I);
+ until I = 0;
+ // done!
+end;
+
+{$ifdef SUPPORT_INT64}
+
+function GetStrFromInt64(Val: Int64; const Dst: PAnsiChar): Integer; // Was PChar
+var
+ Temp: array[0..19] of AnsiChar; // Was Char
+ I, J: Integer;
+begin
+ Val := Abs(Val);
+ // we'll have to store characters backwards first
+ I := 0;
+ J := 0;
+ repeat
+ Temp[I] := AnsiChar((Val mod 10) + Ord('0')); // Was Chr
+ Val := Val div 10;
+ Inc(I);
+ until Val = 0;
+
+ // remember number of digits
+ Result := I;
+ // copy value, remember: stored backwards
+ repeat
+ Dst[J] := Temp[I-1];
+ inc(J);
+ dec(I);
+ until I = 0;
+ // done!
+end;
+
+{$endif}
+
function DateTimeToBDETimeStamp(aDT: TDateTime): double;
var
aTS: TTimeStamp;
@@ -203,12 +321,30 @@
FreeMem(Temp);
end;
+{$ifndef SUPPORT_CHARINSET}
+function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean;
+begin
+ Result := (c in charset)
+end;
+{$endif SUPPORT_CHARINSET}
+
//====================================================================
{$ifndef SUPPORT_INCLTRAILPATHDELIM}
-{$ifndef SUPPORT_INCLTRAILBACKSLASH}
+{$ifdef SUPPORT_INCLTRAILBACKSLASH}
function IncludeTrailingPathDelimiter(const Path: string): string;
+begin
+{$ifdef MSWINDOWS}
+ Result := IncludeTrailingBackslash(Path);
+{$else}
+ Result := IncludeTrailingSlash(Path);
+{$endif}
+end;
+
+{$else}
+
+function IncludeTrailingPathDelimiter(const Path: string): string;
var
len: Integer;
begin
@@ -221,20 +357,22 @@
Result := Result + PathDelim;
end;
-{$else}
+{$endif}
+{$endif}
-function IncludeTrailingPathDelimiter(const Path: string): string;
+{$ifdef SUPPORT_FORMATSETTINGS}
+function TwoDigitYearCenturyWindow: word;
begin
-{$ifdef WINDOWS}
- Result := IncludeTrailingBackslash(Path);
-{$else}
- Result := IncludeTrailingSlash(Path);
-{$endif}
+ Result := FormatSettings.TwoDigitYearCenturyWindow;
end;
-{$endif}
-{$endif}
+function DecimalSeparator: char;
+begin
+ Result := FormatSettings.DecimalSeparator;
+end;
+{$endif SUPPORT_FORMATSETTINGS}
+
{$ifdef USE_CACHE}
function GetFreeMemory: Integer;
@@ -355,7 +493,7 @@
{$endif}
-function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PChar; Length: Integer): Integer;
+function TranslateString(FromCP, ToCP: Cardinal; Src, Dest: PAnsiChar; Length: Integer): Integer;
var
WideCharStr: array[0..1023] of WideChar;
wideBytes: Cardinal;
@@ -363,14 +501,24 @@
if Length = -1 then
Length := StrLen(Src);
Result := Length;
-{$ifndef WINCE}
if (FromCP = GetOEMCP) and (ToCP = GetACP) then
+ begin
+ {$IFDEF WINAPI_IS_UNICODE} // Rafal Chlopek (14-03-2010): I've commented DELPHI_2010
+ OemToCharBuffA(Src, Dest, Length) // Was OemToCharBuff with PChar(Dest) cast
+ {$ELSE}
OemToCharBuff(Src, Dest, Length)
+ {$ENDIF}
+ end
else
if (FromCP = GetACP) and (ToCP = GetOEMCP) then
+ begin
+ {$IFDEF WINAPI_IS_UNICODE}
+ CharToOemBuffA(Src, Dest, Length) // Was OemToCharBuff with PChar(Src) cast
+ {$ELSE}
CharToOemBuff(Src, Dest, Length)
+ {$ENDIF}
+ end
else
-{$endif}
if FromCP = ToCP then
begin
if Src <> Dest then
@@ -409,6 +557,8 @@
{$else}
+{$ifdef USE_ASSEMBLER_486_UP}
+
function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;
asm
PUSH EDI
@@ -422,9 +572,32 @@
DEC EAX
@@1: POP EDI
end;
+{$else}
-{$endif}
+// lsp: Pure Pascal implementation for x64 on Delphi XE2 and up
+function MemScan(const Buffer: Pointer; Chr: Byte; Length: Integer): Pointer;
+var
+ p: PByte;
+begin
+ p := Buffer;
+ while ( (Length>0) and (p^ <> Chr) ) do
+ begin
+ Inc(p);
+ Dec(Length);
+ end;
+
+ if Length>0 then
+ Result := p
+ else
+ Result := nil;
+end;
+
+{$ENDIF USE_ASSEMBLER_486_UP}
+
+{$endif FPC}
+
+
{$ifdef DELPHI_3}
{$ifndef DELPHI_4}
Modified: trunk/src/dbf_cursor.pas
===================================================================
--- trunk/src/dbf_cursor.pas 2013-07-25 08:17:23 UTC (rev 296)
+++ trunk/src/dbf_cursor.pas 2013-07-25 08:20:38 UTC (rev 297)
@@ -21,8 +21,8 @@
function GetPhysicalRecNo: Integer; virtual; abstract;
function GetSequentialRecNo: Integer; virtual; abstract;
function GetSequentialRecordCount: Integer; virtual; abstract;
- procedure SetPhysicalRecNo(RecNo: Integer); virtual; abstract;
- procedure SetSequentialRecNo(RecNo: Integer); virtual; abstract;
+ procedure SetPhysicalRecNo(Recno: Integer); virtual; abstract;
+ procedure SetSequentialRecNo(Recno: Integer); virtual; abstract;
public
constructor Create(pFile: TPagedFile);
Modified: trunk/src/dbf_dbffile.pas
===================================================================
--- trunk/src/dbf_dbffile.pas 2013-07-25 08:17:23 UTC (rev 296)
+++ trunk/src/dbf_dbffile.pas 2013-07-25 08:20:38 UTC (rev 297)
@@ -48,8 +48,8 @@
FIndexNames: TStringList;
FIndexFiles: TList;
FDbfVersion: TXBaseVersion;
- FPrevBuffer: PChar;
- FDefaultBuffer: PChar;
+ FPrevBuffer: TDbfRecordBuffer;
+ FDefaultBuffer: TDbfRecordBuffer;
FRecordBufferSize: Integer;
FLockUserLen: DWORD;
FFileCodePage: Cardinal;
@@ -70,13 +70,13 @@
function GetMemoExt: string;
function GetLanguageId: Integer;
- function GetLanguageStr: string;
+ function GetLanguageStr: AnsiString;
protected
procedure ConstructFieldDefs;
procedure InitDefaultBuffer;
procedure UpdateNullField(Buffer: Pointer; AFieldDef: TDbfFieldDef; Action: TUpdateNullField);
- procedure WriteLockInfo(Buffer: PChar);
+ procedure WriteLockInfo(Buffer: TDbfRecordBuffer);
public
constructor Create;
@@ -97,25 +97,25 @@
procedure CloseIndex(AIndexName: string);
procedure RepageIndex(AIndexFile: string);
procedure CompactIndex(AIndexFile: string);
- function Insert(Buffer: PChar): integer;
+ function Insert(Buffer: TDbfRecordBuffer): integer;
procedure WriteHeader; override;
- procedure ApplyAutoIncToBuffer(DestBuf: PChar); // dBase7 support. Writeback last next-autoinc value
+ procedure ApplyAutoIncToBuffer(DestBuf: TDbfRecordBuffer); // dBase7 support. Writeback last next-autoinc value
procedure FastPackTable;
procedure RestructureTable(DbfFieldDefs: TDbfFieldDefs; Pack: Boolean);
procedure Rename(DestFileName: string; NewIndexFileNames: TStrings; DeleteFiles: boolean);
- function GetFieldInfo(FieldName: string): TDbfFieldDef;
+ function GetFieldInfo(FieldName: AnsiString): TDbfFieldDef;
function GetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer;
NativeFormat: boolean): Boolean;
function GetFieldDataFromDef(AFieldDef: TDbfFieldDef; DataType: TFieldType;
Src, Dst: Pointer; NativeFormat: boolean): Boolean;
procedure SetFieldData(Column: Integer; DataType: TFieldType; Src,Dst: Pointer; NativeFormat: boolean);
- procedure InitRecord(DestBuf: PChar);
+ procedure InitRecord(DestBuf: PAnsiChar);
procedure PackIndex(lIndexFile: TIndexFile; AIndexName: string);
procedure RegenerateIndexes;
- procedure LockRecord(RecNo: Integer; Buffer: PChar);
- procedure UnlockRecord(RecNo: Integer; Buffer: PChar);
- procedure RecordDeleted(RecNo: Integer; Buffer: PChar);
- procedure RecordRecalled(RecNo: Integer; Buffer: PChar);
+ procedure LockRecord(RecNo: Integer; Buffer: TDbfRecordBuffer);
+ procedure UnlockRecord(RecNo: Integer; Buffer: TDbfRecordBuffer);
+ procedure RecordDeleted(RecNo: Integer; Buffer: TDbfRecordBuffer);
+ procedure RecordRecalled(RecNo: Integer; Buffer: TDbfRecordBuffer);
property MemoFile: TMemoFile read FMemoFile;
property FieldDefs: TDbfFieldDefs read FFieldDefs;
@@ -123,12 +123,12 @@
property IndexFiles: TList read FIndexFiles;
property MdxFile: TIndexFile read FMdxFile;
property LanguageId: Integer read GetLanguageId;
- property LanguageStr: string read GetLanguageStr;
+ property LanguageStr: AnsiString read GetLanguageStr;
property FileCodePage: Cardinal read FFileCodePage;
property UseCodePage: Cardinal read FUseCodePage write FUseCodePage;
property FileLangId: Byte read FFileLangId write FFileLangId;
property DbfVersion: TXBaseVersion read FDbfVersion write FDbfVersion;
- property PrevBuffer: PChar read FPrevBuffer;
+ property PrevBuffer: TDbfRecordBuffer read FPrevBuffer;
property ForceClose: Boolean read FForceClose;
property CopyDateTimeAsString: Boolean read FCopyDateTimeAsString write FCopyDateTimeAsString;
property DateTimeHandling: TDateTimeHandling read FDateTimeHandling write FDateTimeHandling;
@@ -206,32 +206,33 @@
{$I dbf_struct.inc}
+
//====================================================================
// International separator
// thanks to Bruno Depero from Italy
// and Andreas W\xF6llenstein from Denmark
//====================================================================
-function DbfStrToFloat(const Src: PChar; const Size: Integer): Extended;
+function DbfStrToFloat(const Src: PAnsiChar; const Size: Integer): Extended; // Was PChar
var
- iPos: PChar;
+ iPos: PAnsiChar;
eValue: extended;
- endChar: Char;
+ endChar: AnsiChar;
begin
// temp null-term string
- endChar := (Src + Size)^;
- (Src + Size)^ := #0;
+ endChar := (PAnsiChar(Src) + Size)^;
+ (PAnsiChar(Src) + Size)^ := #0;
// we only have to convert if decimal separator different
if DecimalSeparator <> sDBF_DEC_SEP then
begin
// search dec sep
- iPos := StrScan(Src, sDBF_DEC_SEP);
+ iPos := StrScan(PAnsiChar(Src), AnsiChar(sDBF_DEC_SEP));
// replace
if iPos <> nil then
- iPos^ := DecimalSeparator;
+ iPos^ := AnsiChar(DecimalSeparator);
end else
iPos := nil;
// convert to double
- if TextToFloat(Src, eValue {$ifndef VER1_0}, fvExtended{$endif}) then
+ if TextToFloat(PAnsiChar(Src), eValue {$ifndef VER1_0}, fvExtended{$endif}) then
Result := eValue
else
Result := 0;
@@ -239,17 +240,33 @@
if iPos <> nil then
iPos^ := sDBF_DEC_SEP;
// restore Char of null-term
- (Src + Size)^ := endChar;
+ (PAnsiChar(Src) + Size)^ := endChar;
end;
-procedure FloatToDbfStr(const Val: Extended; const Size, Precision: Integer; const Dest: PChar);
-var
- Buffer: array [0..24] of Char;
+//-------------------------------------------------------------------------------
+// Rev. 2010-02-23 : Rafal Chlopek - shorter conversion
+//-------------------------------------------------------------------------------
+procedure FloatToDbfStr(const Val: Extended; const Size, Precision: Integer; const Dest: PAnsiChar);
+var B : PAnsiChar;
+ s : AnsiString;
+ resLen: Integer;
+{var
+ Buffer: array [0..24] of AnsiChar;
resLen: Integer;
- iPos: PChar;
+ iPos: PAnsiChar;}
begin
+ s := AnsiString(Format('%*.*f', [Size, Precision, Val]));
+ resLen := Length(s);
+ B := PAnsiChar(s);
+
+ // fill destination with spaces
+ FillChar(Dest^, Size, ' ');
+ // now copy right-aligned to destination
+ Move(B^, Dest[Size-resLen], resLen);
+
+ (*
// convert to temporary buffer
- resLen := FloatToText(@Buffer[0], Val, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, Size, Precision);
+ resLen := FloatToText(PWideChar(@Buffer[0]), Val, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, Size, Precision);
// prevent overflow in destination buffer
if resLen > Size then
resLen := Size;
@@ -258,31 +275,35 @@
// we only have to convert if decimal separator different
if DecimalSeparator <> sDBF_DEC_SEP then
begin
- iPos := StrScan(@Buffer[0], DecimalSeparator);
+ iPos := StrScan(@Buffer[0], AnsiChar(DecimalSeparator));
if iPos <> nil then
iPos^ := sDBF_DEC_SEP;
end;
// fill destination with spaces
FillChar(Dest^, Size, ' ');
// now copy right-aligned to destination
- Move(Buffer[0], Dest[Size-resLen], resLen);
+ Move(Buffer[0], Dest[Size-resLen], resLen); *)
end;
-function GetIntFromStrLength(Src: Pointer; Size: Integer; Default: Integer): Integer;
-var
- endChar: Char;
- Code: Integer;
+//-------------------------------------------------------------------------------
+// Rev. 2010-02-23 : Rafal Chlopek - shorter conversion
+//-------------------------------------------------------------------------------
+function GetIntFromStrLength(Src: PAnsiChar; Size: Integer; Default: Integer): Integer; // Was Pointer
+{var endChar: AnsiChar;
+ Code: Integer;}
begin
- // save Char at pos term. null
- endChar := (PChar(Src) + Size)^;
- (PChar(Src) + Size)^ := #0;
+ Result := StrToIntDef(Copy(String(Src), 1, Size), Default); // SHORT WAY, PAnsiChar cast no longer needed
+
+ {// save Char at pos term. null
+ endChar := (PAnsiChar(Src) + Size)^; // NIGHTMARE WAY :-)
+ (PAnsiChar(Src) + Size)^ := #0;
// convert
- Val(PChar(Src), Result, Code);
+ Val(String(PAnsiChar(Src)), Result, Code);
// check success
if Code <> 0 then
Result := Default;
// restore prev. ending Char
- (PChar(Src) + Size)^ := endChar;
+ (PAnsiChar(Src) + Size)^ := endChar; }
end;
//=============================...
[truncated message content] |
|
From: <tw...@us...> - 2013-07-26 15:22:27
|
Revision: 303
http://sourceforge.net/p/tdbf/code/303
Author: twm
Date: 2013-07-26 15:22:24 +0000 (Fri, 26 Jul 2013)
Log Message:
-----------
compatibility to Delphi XE3 and XE4 (compiles now for both, but is completely untested)
Modified Paths:
--------------
trunk/src/dbf.pas
trunk/src/dbf_common.inc
trunk/src/dbf_common.pas
trunk/src/dbf_idxfile.pas
Modified: trunk/src/dbf.pas
===================================================================
--- trunk/src/dbf.pas 2013-07-25 09:14:54 UTC (rev 302)
+++ trunk/src/dbf.pas 2013-07-26 15:22:24 UTC (rev 303)
@@ -238,7 +238,7 @@
procedure FreeRecordBuffer(var Buffer: TDbfRecordBuffer); override; {virtual abstract}
procedure GetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); override; {virtual abstract}
function GetBookmarkFlag(Buffer: TDbfRecordBuffer): TBookmarkFlag; override; {virtual abstract}
- function GetRecord(Buffer: TDbfRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
+ function GetRecord(Buffer: TDbfRecBuf; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override; {virtual abstract}
function GetRecordSize: Word; override; {virtual abstract}
procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override; {virtual abstract}
procedure InternalClose; override; {virtual abstract}
@@ -481,13 +481,16 @@
{$else}
{$ifdef KYLIX}
Libc,
-{$endif}
+{$endif}
Types,
dbf_wtil,
{$endif}
{$ifdef SUPPORT_SEPARATE_VARIANTS_UNIT}
Variants,
{$endif}
+{$ifdef SUPPORT_ANSISTRINGS_UNIT}
+ AnsiStrings,
+{$ENDIF}
dbf_idxcur,
dbf_memo,
dbf_str;
@@ -499,6 +502,18 @@
SCircularDataLink = 'Circular datalinks are not allowed';
{$endif}
+{$ifdef SUPPORT_ANSISTRINGS_UNIT}
+function StrLen(Str: PAnsiChar): integer; inline;
+begin
+ Result := AnsiStrings.StrLen(Str);
+end;
+
+function StrCopy(Dest, Source: PAnsiChar): PAnsiChar;
+begin
+ Result := AnsiStrings.StrCopy(Dest, Source)
+end;
+{$endif}
+
function TableLevelToDbfVersion(TableLevel: integer): TXBaseVersion;
begin
case TableLevel of
@@ -700,15 +715,15 @@
function TDbf.GetCurrentBuffer: TDbfRecordBuffer;
begin
case State of
- dsFilter: Result := FFilterBuffer;
- dsCalcFields: Result := CalcBuffer;
+ dsFilter: Result := TDbfRecordBuffer(FFilterBuffer);
+ dsCalcFields: Result := TDbfRecordBuffer(CalcBuffer);
// dsSetKey: Result := FKeyBuffer; // TO BE Implemented
else
if IsEmpty then
begin
Result := nil;
end else begin
- Result := ActiveBuffer;
+ Result := TDbfRecordBuffer(ActiveBuffer);
end;
end;
if Result <> nil then
@@ -827,7 +842,7 @@
end;
end;
-function TDbf.GetRecord(Buffer: TDbfRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
+function TDbf.GetRecord(Buffer: TDbfRecBuf; GetMode: TGetMode; DoCheck: Boolean): TGetResult; {override virtual abstract from TDataset}
var
pRecord: pDbfRecord;
acceptable: Boolean;
@@ -883,11 +898,11 @@
pRecord^.BookmarkData.PhysicalRecNo := FCursor.PhysicalRecNo;
pRecord^.BookmarkFlag := bfCurrent;
pRecord^.SequentialRecNo := FCursor.SequentialRecNo;
- GetCalcFields(Buffer);
+ GetCalcFields(TDbfRecBuf(Buffer));
if Filtered or FFindRecordFilter then
begin
- FFilterBuffer := Buffer;
+ FFilterBuffer := TDbfRecordBuffer(Buffer);
SaveState := SetTempState(dsFilter);
DoFilterRecord(acceptable);
RestoreState(SaveState);
@@ -961,7 +976,7 @@
FBlobStreams^[I].Free;
FreeMemAndNil(Pointer(FBlobStreams));
end;
- FreeRecordBuffer(FTempBuffer);
+ FreeRecordBuffer(TdbfRecordBuffer(FTempBuffer));
// disconnect field objects
BindFields(false);
// Destroy field object (if not persistent)
@@ -1819,7 +1834,7 @@
Result := false;
bVarIsArray := false;
lstKeys := TList.Create;
- FFilterBuffer := TempBuffer;
+ FFilterBuffer := TDbfRecordBuffer(TempBuffer);
SaveState := SetTempState(dsFilter);
try
GetFieldList(lstKeys, KeyFields);
@@ -1884,7 +1899,7 @@
checkmatch := false;
repeat
- if ReadCurrentRecord(TempBuffer, acceptable) = grError then
+ if ReadCurrentRecord(TDbfRecordBuffer(TempBuffer), acceptable) = grError then
begin
Result := false;
exit;
@@ -1903,7 +1918,7 @@
Result := matchRes = 0;
end;
- FFilterBuffer := TempBuffer;
+ FFilterBuffer := TDbfRecordBuffer(TempBuffer);
end;
function TDbf.LocateRecord(const KeyFields: String; const KeyValues: Variant;
@@ -2208,9 +2223,9 @@
if FCursor <> nil then
begin
if State = dsCalcFields then
- pBuffer := CalcBuffer
+ pBuffer := TDbfRecordBuffer(CalcBuffer)
else
- pBuffer := ActiveBuffer;
+ pBuffer := TDbfRecordBuffer(ActiveBuffer);
Result := pDbfRecord(pBuffer)^.SequentialRecNo;
end else
Result := 0;
@@ -2599,9 +2614,9 @@
if (FCursor <> nil) and (State <> dsInsert) then
begin
if State = dsCalcFields then
- pBuffer := CalcBuffer
+ pBuffer := TDbfRecordBuffer(CalcBuffer)
else
- pBuffer := ActiveBuffer;
+ pBuffer := TDbfRecordBuffer(ActiveBuffer);
Result := pDbfRecord(pBuffer)^.BookmarkData.PhysicalRecNo;
end else
Result := -1;
Modified: trunk/src/dbf_common.inc
===================================================================
--- trunk/src/dbf_common.inc 2013-07-25 09:14:54 UTC (rev 302)
+++ trunk/src/dbf_common.inc 2013-07-26 15:22:24 UTC (rev 303)
@@ -301,6 +301,15 @@
{$define SUPPORT_FORMATSETTINGS}
{$endif}
+{$ifdef DELPHI_XE3}
+ {$define FLOATREC_DIGITS_IS_BYTE}
+{$endif}
+
+{$ifdef DELPHI_XE4}
+ {$define SUPPORT_TRECBUF}
+ {$define SUPPORT_ANSISTRINGS_UNIT}
+{$endif}
+
//------------------------------------------------------
//--- Conclude supported features in FreePascal ---
//------------------------------------------------------
Modified: trunk/src/dbf_common.pas
===================================================================
--- trunk/src/dbf_common.pas 2013-07-25 09:14:54 UTC (rev 302)
+++ trunk/src/dbf_common.pas 2013-07-26 15:22:24 UTC (rev 303)
@@ -36,6 +36,19 @@
TDbfRecordBuffer = PAnsiChar;
{$endif}
+{$ifdef SUPPORT_TRECBUF}
+type
+ TDbfRecBuf = DB.TRecBuf;
+const
+ DBfRecBufNil = 0;
+{$else}
+type
+ TDbfRecBuf = TDbfRecordBuffer;
+const
+ DBfRecBufNil = nil;
+{$endif}
+
+type
TDbfFieldType = AnsiChar;
TXBaseVersion = (xUnknown, xClipper, xBaseIII, xBaseIV, xBaseV, xFoxPro, xBaseVII);
Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas 2013-07-25 09:14:54 UTC (rev 302)
+++ trunk/src/dbf_idxfile.pas 2013-07-26 15:22:24 UTC (rev 303)
@@ -2863,6 +2863,14 @@
end;
function TIndexFile.PrepareKey(Buffer: TDbfRecordBuffer; ResultType: TExpressionType): TDbfRecordBuffer;
+const
+{$ifdef FLOATREC_DIGITS_IS_BYTE}
+ ZERO_CHAR = Ord('0');
+ NULL_TERMINATOR = 0;
+{$else}
+ ZERO_CHAR = '0';
+ NULL_TERMINATOR = #0;
+{$endif}
var
FloatRec: TFloatRec;
I, IntSrc, NumDecimals: Integer;
@@ -2937,10 +2945,10 @@
begin
FloatRec.Exponent := NumDecimals;
// MDX-BCD does not count ending zeroes as `data' space length
- while (NumDecimals > 0) and (FloatRec.Digits[NumDecimals-1] = '0') do
+ while (NumDecimals > 0) and (FloatRec.Digits[NumDecimals-1] = ZERO_CHAR) do
Dec(NumDecimals);
// null-terminate string
- FloatRec.Digits[NumDecimals] := #0;
+ FloatRec.Digits[NumDecimals] := NULL_TERMINATOR;
end;
end;
@@ -2959,7 +2967,7 @@
while I < NumDecimals do
begin
// only one byte left?
- if FloatRec.Digits[I+1] = #0 then
+ if FloatRec.Digits[I+1] = ZERO_CHAR then
BCDdigit := 0
else
BCDdigit := Byte(FloatRec.Digits[I+1]) - Byte('0');
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2013-07-27 13:10:40
|
Revision: 305
http://sourceforge.net/p/tdbf/code/305
Author: twm
Date: 2013-07-27 13:10:38 +0000 (Sat, 27 Jul 2013)
Log Message:
-----------
* NativeInt declaration for compilers that don't have it
* Pointer-Typecasts (for Delphi 6 and probably others)
Modified Paths:
--------------
trunk/src/dbf_common.pas
trunk/src/dbf_idxfile.pas
Modified: trunk/src/dbf_common.pas
===================================================================
--- trunk/src/dbf_common.pas 2013-07-27 13:06:07 UTC (rev 304)
+++ trunk/src/dbf_common.pas 2013-07-27 13:10:38 UTC (rev 305)
@@ -30,6 +30,11 @@
EDbfWriteError = class (EDbfError)
end;
+{$ifndef SUPPORT_NATIVEINT}
+type
+ NativeInt = integer;
+{$endif}
+
{$ifdef SUPPORT_TRECORDBUFFER}
TDbfRecordBuffer = TRecordBuffer;
{$else}
Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas 2013-07-27 13:06:07 UTC (rev 304)
+++ trunk/src/dbf_idxfile.pas 2013-07-27 13:10:38 UTC (rev 305)
@@ -2891,13 +2891,13 @@
etInteger:
begin
FUserNumeric := PInteger(Result)^;
- Result := @FUserNumeric;
+ Result := TDbfRecordBuffer(@FUserNumeric);
end;
{$ifdef SUPPORT_INT64}
etLargeInt:
begin
FUserNumeric := PLargeInt(Result)^;
- Result := @FUserNumeric;
+ Result := TDbfRecordBuffer(@FUserNumeric);
end;
{$endif}
end;
@@ -2978,7 +2978,7 @@
end;
// set result pointer to BCD
- Result := @FUserBCD[0];
+ Result := TDbfRecordBuffer(@FUserBCD[0]);
end;
end;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2013-07-30 10:16:58
|
Revision: 314
http://sourceforge.net/p/tdbf/code/314
Author: twm
Date: 2013-07-30 10:16:53 +0000 (Tue, 30 Jul 2013)
Log Message:
-----------
Bugfix: Overloaded the wrong Get/SetFieldData method in XE3/XE4
Modified Paths:
--------------
trunk/src/dbf.pas
trunk/src/dbf_common.inc
trunk/src/dbf_common.pas
Modified: trunk/src/dbf.pas
===================================================================
--- trunk/src/dbf.pas 2013-07-27 16:33:14 UTC (rev 313)
+++ trunk/src/dbf.pas 2013-07-30 10:16:53 UTC (rev 314)
@@ -263,7 +263,7 @@
function IsCursorOpen: Boolean; override; {virtual abstract}
procedure SetBookmarkFlag(Buffer: TDbfRecordBuffer; Value: TBookmarkFlag); override; {virtual abstract}
procedure SetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); override; {virtual abstract}
- procedure SetFieldData(Field: TField; Buffer: Pointer);
+ procedure SetFieldData(Field: TField; Buffer: TDbfValueBuffer);
{$ifdef SUPPORT_OVERLOAD}overload;{$ENDIF} override; {virtual abstract}
{ virtual methods (mostly optionnal) }
@@ -294,7 +294,7 @@
destructor Destroy; override;
{ abstract methods }
- function GetFieldData(Field: TField; Buffer: Pointer): Boolean;
+ function GetFieldData(Field: TField; Buffer: TDbfValueBuffer): Boolean;
{$ifdef SUPPORT_OVERLOAD} overload; {$endif} override; {virtual abstract}
{ virtual methods (mostly optionnal) }
procedure Resync(Mode: TResyncMode); override;
@@ -306,9 +306,9 @@
{$endif}
{$ifdef SUPPORT_OVERLOAD}
- function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload;
+ function GetFieldData(Field: TField; Buffer: TDbfValueBuffer; NativeFormat: Boolean): Boolean; overload;
{$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif}
- procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload;
+ procedure SetFieldData(Field: TField; Buffer: TDbfValueBuffer; NativeFormat: Boolean); overload;
{$ifdef SUPPORT_BACKWARD_FIELDDATA} override; {$endif}
{$endif}
@@ -729,14 +729,14 @@
// ftBCD:
// ftDateTime is more difficult though
-function TDbf.GetFieldData(Field: TField; Buffer: Pointer): Boolean; {override virtual abstract from TDataset}
+function TDbf.GetFieldData(Field: TField; Buffer: TDbfValueBuffer): Boolean; {override virtual abstract from TDataset}
{$ifdef SUPPORT_OVERLOAD}
begin
{ calling through 'old' delphi 3 interface, use compatible/'native' format }
Result := GetFieldData(Field, Buffer, true);
end;
-function TDbf.GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; {overload; override;}
+function TDbf.GetFieldData(Field: TField; Buffer: TDbfValueBuffer; NativeFormat: Boolean): Boolean; {overload; override;}
{$else}
const
{ no overload => delphi 3 => use compatible/'native' format }
@@ -758,19 +758,24 @@
end else begin { weird calculated fields voodoo (from dbtables).... }
Inc(Src, Field.Offset + GetRecordSize); // Was PChar(Src)
Result := Boolean(Src[0]);
- if Result and (Buffer <> nil) then
+ if Result and (Buffer <> nil) then begin
+{$ifdef SUPPORT_TVALUEBUFFER}
+ Move(Src[1], Buffer[0], Field.DataSize);
+{$else}
Move(Src[1], Buffer^, Field.DataSize);
+{$endif}
+ end;
end;
end;
-procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer); {override virtual abstract from TDataset}
+procedure TDbf.SetFieldData(Field: TField; Buffer: TDbfValueBuffer); {override virtual abstract from TDataset}
{$ifdef SUPPORT_OVERLOAD}
begin
{ calling through 'old' delphi 3 interface, use compatible/'native' format }
SetFieldData(Field, Buffer, true);
end;
-procedure TDbf.SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); {overload; override;}
+procedure TDbf.SetFieldData(Field: TField; Buffer: TDbfValueBuffer; NativeFormat: Boolean); {overload; override;}
{$else}
const
{ no overload => delphi 3 => use compatible/'native' format }
@@ -788,7 +793,11 @@
Inc(Dst, RecordSize + Field.Offset); // Was PChar(Dst)
if Buffer <> nil then begin
Dst[0] := #1;
+{$ifdef SUPPORT_TVALUEBUFFER}
+ Move(Buffer[0], Dst[1], Field.DataSize);
+{$else}
Move(Buffer^, Dst[1], Field.DataSize);
+{$endif}
end else
Dst[0] := #0;
end; { end of ***** fkCalculated, fkLookup ***** }
Modified: trunk/src/dbf_common.inc
===================================================================
--- trunk/src/dbf_common.inc 2013-07-27 16:33:14 UTC (rev 313)
+++ trunk/src/dbf_common.inc 2013-07-30 10:16:53 UTC (rev 314)
@@ -315,6 +315,7 @@
{$ifdef DELPHI_XE3}
{$define FLOATREC_DIGITS_IS_BYTE}
+ {$define SUPPORT_TVALUEBUFFER}
{$endif}
{$ifdef DELPHI_XE4}
Modified: trunk/src/dbf_common.pas
===================================================================
--- trunk/src/dbf_common.pas 2013-07-27 16:33:14 UTC (rev 313)
+++ trunk/src/dbf_common.pas 2013-07-30 10:16:53 UTC (rev 314)
@@ -41,6 +41,12 @@
TDbfRecordBuffer = PAnsiChar;
{$endif}
+{$ifdef SUPPORT_TVALUEBUFFER}
+ TDbfValueBuffer = TValueBuffer;
+{$else}
+ TDbfValueBuffer = pointer;
+{$endif}
+
{$ifdef SUPPORT_TRECBUF}
type
TDbfRecBuf = DB.TRecBuf;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2013-08-07 13:09:38
|
Revision: 315
http://sourceforge.net/p/tdbf/code/315
Author: twm
Date: 2013-08-07 13:09:35 +0000 (Wed, 07 Aug 2013)
Log Message:
-----------
* Bugfix: Delphi 2007 is VER185, not VER190
* new cond. defines SUPPORT_TWODIGITYEARCENTURYWINDOW and SUPPORT_FORMATSETTINGSTYPE
* TwoDigitYearCenturyWindow is now a function for all compiler versions, but references different variables
* DecimalSeparator is now a function for all compiler version but references either SysUtils.DecimalSeparator or FormatSettings.DecimalSeparator
* Bugfix: FloatToDbfStr did not work correctly if DecimalSeparator <> '.'
* If the overloaded versions of TextToFloat and FloatToText which take a TFormatSettings parameter exist, they are used, otherwise the old method of changing the decimal separator is used.
Modified Paths:
--------------
trunk/src/dbf_common.inc
trunk/src/dbf_common.pas
trunk/src/dbf_dbffile.pas
Modified: trunk/src/dbf_common.inc
===================================================================
--- trunk/src/dbf_common.inc 2013-07-30 10:16:53 UTC (rev 314)
+++ trunk/src/dbf_common.inc 2013-08-07 13:09:35 UTC (rev 315)
@@ -148,7 +148,7 @@
{$define DELPHI_3}
{$endif}
-{$ifdef VER190} // Delphi 2007
+{$ifdef VER185} // Delphi 2007 Win32
{$define DELPHI_2007}
{$define DELPHI_2006}
{$define DELPHI_2005}
@@ -284,6 +284,7 @@
{$define SUPPORT_INITDEFSFROMFIELDS}
{$define SUPPORT_DEF_DELETE}
{$define SUPPORT_FREEANDNIL}
+ {$define SUPPORT_TWODIGITYEARCENTURYWINDOW}
{$endif}
{$ifdef DELPHI_6}
@@ -302,6 +303,16 @@
{$define SUPPORT_NATIVEINT}
{$endif}
+{$ifdef Delphi_2007}
+ (* This define tells the code that it can use TFormatSettings
+ and pass it to SysUtils.FloatToText.
+ (This is not the FormatSettings Variable in SysUtils, which was
+ introduced with Delphi XE.)
+ It was possibly supported in earlier versions than Delphi 2007.
+ If you are sure, please correct this. *)
+ {$define SUPPORT_FORMATSETTINGSTYPE}
+{$endif}
+
{$ifdef Delphi_2009}
{$define WINAPI_IS_UNICODE}
{$define SUPPORT_TRECORDBUFFER}
Modified: trunk/src/dbf_common.pas
===================================================================
--- trunk/src/dbf_common.pas 2013-07-30 10:16:53 UTC (rev 314)
+++ trunk/src/dbf_common.pas 2013-08-07 13:09:35 UTC (rev 315)
@@ -397,19 +397,29 @@
{$endif}
{$endif}
-{$ifdef SUPPORT_FORMATSETTINGS}
function TwoDigitYearCenturyWindow: word;
begin
+{$ifdef SUPPORT_FORMATSETTINGS}
Result := FormatSettings.TwoDigitYearCenturyWindow;
+{$else SUPPORT_FORMATSETTINGS}
+ {$ifdef SUPPORT_TWODIGITYEARCENTURYWINDOW}
+ Result := SysUtils.TwoDigitYearCenturyWindow;
+ {$else SUPPORT_TWODIGITYEARCENTURYWINDOW}
+ // Delphi 3 standard-behavior no change possible
+ Result := 0;
+ {$endif SUPPORT_TWODIGITYEARCENTURYWINDOW}
+{$endif SUPPORT_FORMATSETTINGS}
end;
function DecimalSeparator: char;
begin
+{$ifdef SUPPORT_FORMATSETTINGS}
Result := FormatSettings.DecimalSeparator;
+{$else SUPPORT_FORMATSETTINGS}
+ Result := SysUtils.DecimalSeparator;
+{$endif SUPPORT_FORMATSETTINGS}
end;
-{$endif SUPPORT_FORMATSETTINGS}
-
{$ifdef USE_CACHE}
function GetFreeMemory: Integer;
Modified: trunk/src/dbf_dbffile.pas
===================================================================
--- trunk/src/dbf_dbffile.pas 2013-07-30 10:16:53 UTC (rev 314)
+++ trunk/src/dbf_dbffile.pas 2013-08-07 13:09:35 UTC (rev 315)
@@ -220,8 +220,36 @@
// thanks to Bruno Depero from Italy
// and Andreas W\xF6llenstein from Denmark
//====================================================================
+
+{$ifdef SUPPORT_FORMATSETTINGSTYPE}
+// if we have the overloaded FloatToText versions that take a TFormatSettings parameter,
+// we use them with this variable (initialized in the inialization section).
+// Otherwise the code is more complex.
+var
+ FORMAT_SETTIGS_DECIMAL_POINT: TFormatSettings;
+{$endif SUPPORT_FORMATSETTINGSTYPE}
+
+
+{$ifdef SUPPORT_FORMATSETTINGSTYPE}
function DbfStrToFloat(const Src: PAnsiChar; const Size: Integer): Extended; // Was PChar
var
+ eValue: extended;
+ endChar: AnsiChar;
+begin
+ // temp null-term string
+ endChar := (PAnsiChar(Src) + Size)^;
+ (PAnsiChar(Src) + Size)^ := #0;
+ // convert to double
+ if TextToFloat(PAnsiChar(Src), eValue, fvExtended, FORMAT_SETTIGS_DECIMAL_POINT) then
+ Result := eValue
+ else
+ Result := 0;
+ // restore Char of null-term
+ (PAnsiChar(Src) + Size)^ := endChar;
+end;
+{$else SUPPORT_FORMATSETTINGSTYPE}
+function DbfStrToFloat(const Src: PAnsiChar; const Size: Integer): Extended; // Was PChar
+var
iPos: PAnsiChar;
eValue: extended;
endChar: AnsiChar;
@@ -250,29 +278,33 @@
// restore Char of null-term
(PAnsiChar(Src) + Size)^ := endChar;
end;
+{$endif SUPPORT_FORMATSETTINGS}
-//-------------------------------------------------------------------------------
-// Rev. 2010-02-23 : Rafal Chlopek - shorter conversion
-//-------------------------------------------------------------------------------
+{$ifdef SUPPORT_FORMATSETTINGSTYPE}
procedure FloatToDbfStr(const Val: Extended; const Size, Precision: Integer; const Dest: PAnsiChar);
-var B : PAnsiChar;
- s : AnsiString;
- resLen: Integer;
-{var
- Buffer: array [0..24] of AnsiChar;
+var
+ Buffer: array[0..63] of char;
+ B : PAnsiChar;
+ s : AnsiString;
resLen: Integer;
- iPos: PAnsiChar;}
begin
- s := AnsiString(Format('%*.*f', [Size, Precision, Val]));
- resLen := Length(s);
+ resLen := FloatToText(@Buffer, Val, fvExtended, ffFixed, Size, Precision, FORMAT_SETTIGS_DECIMAL_POINT);
+ SetString(s, PChar(@Buffer), resLen);
B := PAnsiChar(s);
// fill destination with spaces
FillChar(Dest^, Size, ' ');
// now copy right-aligned to destination
Move(B^, Dest[Size-resLen], resLen);
-
- (*
+end;
+{$else SUPPORT_FORMATSETTINGSTYPE}
+procedure FloatToDbfStr(const Val: Extended; const Size, Precision: Integer; const Dest: PAnsiChar);
+var
+ Buffer: array[0..63] of char;
+ B : PAnsiChar;
+ s : AnsiString;
+ resLen: Integer;
+begin
// convert to temporary buffer
resLen := FloatToText(PWideChar(@Buffer[0]), Val, {$ifndef FPC_VERSION}fvExtended,{$endif} ffFixed, Size, Precision);
// prevent overflow in destination buffer
@@ -290,8 +322,9 @@
// fill destination with spaces
FillChar(Dest^, Size, ' ');
// now copy right-aligned to destination
- Move(Buffer[0], Dest[Size-resLen], resLen); *)
+ Move(Buffer[0], Dest[Size-resLen], resLen);
end;
+{$endif SUPPORT_FORMATSETTINGS}
//-------------------------------------------------------------------------------
// Rev. 2010-02-23 : Rafal Chlopek - shorter conversion
@@ -1464,13 +1497,8 @@
{$endif}
procedure CorrectYear(var wYear: Integer);
- var wD, wM, wY, CenturyBase: Word;
-
-{$ifndef DELPHI_5}
- // Delphi 3 standard-behavior no change possible
- const TwoDigitYearCenturyWindow= 0;
-{$endif}
-
+ var
+ wD, wM, wY, CenturyBase: Word;
begin
if wYear >= 100 then
Exit;
@@ -2804,7 +2832,21 @@
Result := FCodePages.IndexOf(Pointer(ACodePage)) >= 0;
end;
+function GetUserDefaultLocaleSettings: TFormatSettings;
+begin
+{$IFDEF RTL220_UP}
+ Result := TFormatSettings.Create(GetUserDefaultLCID);
+{$ELSE}
+ GetLocaleFormatSettings(GetUserDefaultLCID, Result);
+{$ENDIF}
+end;
+
initialization
+{$ifdef SUPPORT_FORMATSETTINGSTYPE}
+ FORMAT_SETTIGS_DECIMAL_POINT := GetUserDefaultLocaleSettings;
+ FORMAT_SETTIGS_DECIMAL_POINT.DecimalSeparator := '.';
+ FORMAT_SETTIGS_DECIMAL_POINT.ThousandSeparator := #0;
+{$endif SUPPORT_FORMATSETTINGSTYPE}
finalization
FreeAndNil(DbfGlobals);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2013-08-16 14:51:51
|
Revision: 317
http://sourceforge.net/p/tdbf/code/317
Author: twm
Date: 2013-08-16 14:51:48 +0000 (Fri, 16 Aug 2013)
Log Message:
-----------
* Bugfix: Pointers in dbf_ansistrings were not initialized correctly resulting in corrupted stack and access violations
* dbf_prscore now uses the dbf*-string functions
* pass Result directly to dbfTextToFloatFmt
Modified Paths:
--------------
trunk/src/dbf_ansistrings.pas
trunk/src/dbf_dbffile.pas
trunk/src/dbf_prscore.pas
Modified: trunk/src/dbf_ansistrings.pas
===================================================================
--- trunk/src/dbf_ansistrings.pas 2013-08-15 15:59:07 UTC (rev 316)
+++ trunk/src/dbf_ansistrings.pas 2013-08-16 14:51:48 UTC (rev 317)
@@ -8,23 +8,23 @@
SysUtils;
type
- TdbfStrLen = function(Str: PAnsiChar): integer;
- TdbfStrCopy = function(Dest, Source: PAnsiChar): PAnsiChar;
+ TdbfStrLen = function(const Str: PAnsiChar): Cardinal;
+ TdbfStrCopy = function(Dest: PAnsiChar; const Source: PAnsiChar): PAnsiChar;
TdbfStrLCopy = function(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar;
TdbfFloatToText = function(BufferArg: PAnsiChar; const Value; ValueType: TFloatValue;
Format: TFloatFormat; Precision, Digits: Integer): Integer;
TdbfFloatToTextFmt = function(BufferArg: PAnsiChar; const Value; ValueType: TFloatValue;
- Format: TFloatFormat; Precision, Digits: Integer; FormatSettings: TFormatSettings): Integer;
+ Format: TFloatFormat; Precision, Digits: Integer; const FormatSettings: TFormatSettings): Integer;
TdbfStrUpper = function(Str: PAnsiChar): PAnsiChar;
TdbfStrLower = function(Str: PAnsiChar): PAnsiChar;
- TdbfStrIComp = function(S1, S2: PAnsiChar): Integer;
- TdbfStrLIComp = function(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer;
+ TdbfStrIComp = function(const S1, S2: PAnsiChar): Integer;
+ TdbfStrLIComp = function(const S1, S2: PAnsiChar; MaxLen: Cardinal): Integer;
TdbfStrPos = function(Str, SubStr: PAnsiChar): PAnsiChar;
- TdbfStrLComp = function(S1, S2: PAnsiChar; MaxLen: Cardinal): Integer;
+ TdbfStrLComp = function(const S1, S2: PAnsiChar; MaxLen: Cardinal): Integer;
TdbfStrComp = function(S1, S2: PAnsiChar): Integer;
TdbfStrScan = function(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar;
- TdbfTextToFloatFmt = function(Buffer: PAnsiChar; var Value; ValueType: TFloatValue; FormatSettings: TFormatSettings): Boolean;
TdbfTextToFloat = function(Buffer: PAnsiChar; var Value; ValueType: TFloatValue): Boolean;
+ TdbfTextToFloatFmt = function(Buffer: PAnsiChar; var Value; ValueType: TFloatValue; const FormatSettings: TFormatSettings): Boolean;
TdbfStrPLCopy = function(Dest: PAnsiChar; const Source: AnsiString; MaxLen: Cardinal): PAnsiChar;
var
@@ -56,43 +56,43 @@
procedure Init;
begin
- dbfStrLen := @AnsiStrings.StrLen;
- dbfStrCopy := @AnsiStrings.StrCopy;
- dbfStrLCopy := @AnsiStrings.StrLCopy;
- dbfFloatToText := @AnsiStrings.FloatToText;
- dbfFloatToTextFmt := @AnsiStrings.FloatToText;
-// dbfStrUpper := @AnsiStrings.StrUpper;
-// dbfStrLower := @AnsiStrings.StrLower;
- dbfStrIComp := @AnsiStrings.StrIComp;
-// dbfStrLIComp := @AnsiStrings.StrLIComp;
-// dbfStrPos := @AnsiStrings.StrPos;
- dbfStrLComp := @AnsiStrings.StrLComp;
-// dbfStrComp := @AnsiStrings.StrComp;
- dbfStrScan := @AnsiStrings.StrScan;
- dbfTextToFloatFmt := @AnsiStrings.TextToFloat;
- dbfTextToFloat := @AnsiStrings.TextToFloat;
- dbfStrPLCopy := @AnsiStrings.StrPLCopy;
+ dbfStrLen := AnsiStrings.StrLen;
+ dbfStrCopy := AnsiStrings.StrCopy;
+ dbfStrLCopy := AnsiStrings.StrLCopy;
+ dbfFloatToText := AnsiStrings.FloatToText;
+ dbfFloatToTextFmt := AnsiStrings.FloatToText;
+// dbfStrUpper := AnsiStrings.StrUpper;
+// dbfStrLower := AnsiStrings.StrLower;
+ dbfStrIComp := AnsiStrings.StrIComp;
+// dbfStrLIComp := AnsiStrings.StrLIComp;
+// dbfStrPos := AnsiStrings.StrPos;
+ dbfStrLComp := AnsiStrings.StrLComp;
+// dbfStrComp := AnsiStrings.StrComp;
+ dbfStrScan := AnsiStrings.StrScan;
+ dbfTextToFloatFmt := AnsiStrings.TextToFloat;
+ dbfTextToFloat := AnsiStrings.TextToFloat;
+ dbfStrPLCopy := AnsiStrings.StrPLCopy;
end;
{$ELSE}
procedure Init;
begin
- dbfStrLen := @SysUtils.StrLen;
- dbfStrCopy := @SysUtils.StrCopy;
- dbfStrLCopy := @SysUtils.StrLCopy;
- dbfFloatToText := @SysUtils.FloatToText;
- dbfFloatToTextFmt := @SysUtils.FloatToText;
-// dbfStrUpper := @SysUtils.StrUpper;
-// dbfStrLower := @SysUtils.StrLower;
- dbfStrIComp := @SysUtils.StrIComp;
-// dbfStrLIComp := @SysUtils.StrLIComp;
-// dbfStrPos := @SysUtils.StrPos;
- dbfStrLComp := @SysUtils.StrLComp;
-// dbfStrComp := @SysUtils.StrComp;
- dbfStrScan := @SysUtils.StrScan;
- dbfTextToFloatFmt := @SysUtils.TextToFloat;
- dbfTextToFloat := @SysUtils.TextToFloat;
- dbfStrPLCopy := @SysUtils.StrPLCopy;
+ dbfStrLen := SysUtils.StrLen;
+ dbfStrCopy := SysUtils.StrCopy;
+ dbfStrLCopy := SysUtils.StrLCopy;
+ dbfFloatToText := SysUtils.FloatToText;
+ dbfFloatToTextFmt := SysUtils.FloatToText;
+// dbfStrUpper := SysUtils.StrUpper;
+// dbfStrLower := SysUtils.StrLower;
+ dbfStrIComp := SysUtils.StrIComp;
+// dbfStrLIComp := SysUtils.StrLIComp;
+// dbfStrPos := SysUtils.StrPos;
+ dbfStrLComp := SysUtils.StrLComp;
+// dbfStrComp := SysUtils.StrComp;
+ dbfStrScan := SysUtils.StrScan;
+ dbfTextToFloatFmt := SysUtils.TextToFloat;
+ dbfTextToFloat := SysUtils.TextToFloat;
+ dbfStrPLCopy := SysUtils.StrPLCopy;
end;
{$ENDIF}
Modified: trunk/src/dbf_dbffile.pas
===================================================================
--- trunk/src/dbf_dbffile.pas 2013-08-15 15:59:07 UTC (rev 316)
+++ trunk/src/dbf_dbffile.pas 2013-08-16 14:51:48 UTC (rev 317)
@@ -226,16 +226,13 @@
{$ifdef SUPPORT_FORMATSETTINGSTYPE}
function DbfStrToFloat(const Src: PAnsiChar; const Size: Integer): Extended; // Was PChar
var
- eValue: extended;
endChar: AnsiChar;
begin
// temp null-term string
endChar := (PAnsiChar(Src) + Size)^;
(PAnsiChar(Src) + Size)^ := #0;
// convert to double
- if dbfTextToFloatFmt(PAnsiChar(Src), eValue, fvExtended, FORMAT_SETTINGS_DECIMAL_POINT) then
- Result := eValue
- else
+ if not dbfTextToFloatFmt(PAnsiChar(Src), Result, fvExtended, FORMAT_SETTINGS_DECIMAL_POINT) then
Result := 0;
// restore Char of null-term
(PAnsiChar(Src) + Size)^ := endChar;
Modified: trunk/src/dbf_prscore.pas
===================================================================
--- trunk/src/dbf_prscore.pas 2013-08-15 15:59:07 UTC (rev 316)
+++ trunk/src/dbf_prscore.pas 2013-08-16 14:51:48 UTC (rev 317)
@@ -1414,7 +1414,7 @@
Arg0 := (Param^.Res.MemoryPos)^;
Dec(Arg0, Len);
// make uppercase
- AnsiStrUpper(Arg0);
+ dbfStrUpper(Arg0);
end;
procedure FuncLowercase(Param: PExpressionRec);
@@ -1431,7 +1431,7 @@
Arg0 := (Param^.Res.MemoryPos)^;
Dec(Arg0, Len);
// make lowercase
- AnsiStrLower(Arg0);
+ dbfStrLower(Arg0);
end;
procedure FuncAdd_F_FF(Param: PExpressionRec);
@@ -1632,7 +1632,7 @@
procedure FuncStrI_EQ(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrIComp(Param^.Args[0], Param^.Args[1]) = 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrIComp(Param^.Args[0], Param^.Args[1]) = 0); // Was Char
end;
procedure FuncStrIP_EQ(Param: PExpressionRec);
@@ -1646,8 +1646,8 @@
begin
if Param^.Args[1][arg1len-1] = '*' then
begin
- str0 := AnsiStrUpper(Param^.Args[0]);
- str1 := AnsiStrUpper(Param^.Args[1]+1);
+ str0 := dbfStrUpper(Param^.Args[0]);
+ str1 := dbfStrUpper(Param^.Args[1]+1);
setlength(str1, arg1len-2);
match := Pos(str1, str0)>0; // Was AnsiPos(str0, str1) = 0
end else begin
@@ -1655,7 +1655,7 @@
// at least length without asterisk
match := arg0len >= arg1len - 1;
if match then
- match := AnsiStrLIComp(Param^.Args[0]+(arg0len-arg1len+1), Param^.Args[1]+1, arg1len-1) = 0;
+ match := dbfStrLIComp(Param^.Args[0]+(arg0len-arg1len+1), Param^.Args[1]+1, arg1len-1) = 0;
end;
end else
if Param^.Args[1][arg1len-1] = '*' then
@@ -1663,36 +1663,36 @@
arg0len := dbfStrLen(Param^.Args[0]);
match := arg0len >= arg1len - 1;
if match then
- match := AnsiStrLIComp(Param^.Args[0], Param^.Args[1], arg1len-1) = 0;
+ match := dbfStrLIComp(Param^.Args[0], Param^.Args[1], arg1len-1) = 0;
end else begin
- match := AnsiStrIComp(Param^.Args[0], Param^.Args[1]) = 0;
+ match := dbfStrIComp(Param^.Args[0], Param^.Args[1]) = 0;
end;
Param^.Res.MemoryPos^^ := AnsiChar(match); // Was Char
end;
procedure FuncStrI_NEQ(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrIComp(Param^.Args[0], Param^.Args[1]) <> 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrIComp(Param^.Args[0], Param^.Args[1]) <> 0); // Was Char
end;
procedure FuncStrI_LT(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrIComp(Param^.Args[0], Param^.Args[1]) < 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrIComp(Param^.Args[0], Param^.Args[1]) < 0); // Was Char
end;
procedure FuncStrI_GT(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrIComp(Param^.Args[0], Param^.Args[1]) > 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrIComp(Param^.Args[0], Param^.Args[1]) > 0); // Was Char
end;
procedure FuncStrI_LTE(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrIComp(Param^.Args[0], Param^.Args[1]) <= 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrIComp(Param^.Args[0], Param^.Args[1]) <= 0); // Was Char
end;
procedure FuncStrI_GTE(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrIComp(Param^.Args[0], Param^.Args[1]) >= 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrIComp(Param^.Args[0], Param^.Args[1]) >= 0); // Was Char
end;
procedure FuncStrP_EQ(Param: PExpressionRec);
@@ -1706,14 +1706,14 @@
if Param^.Args[1][arg1len-1] = '*' then
begin
Param^.Args[1][arg1len-1] := #0;
- match := AnsiStrPos(Param^.Args[0], Param^.Args[1]+1) <> nil;
+ match := dbfStrPos(Param^.Args[0], Param^.Args[1]+1) <> nil;
Param^.Args[1][arg1len-1] := '*';
end else begin
arg0len := dbfStrLen(Param^.Args[0]);
// at least length without asterisk
match := arg0len >= arg1len - 1;
if match then
- match := AnsiStrLComp(Param^.Args[0]+(arg0len-arg1len+1), Param^.Args[1]+1, arg1len-1) = 0;
+ match := dbfStrLComp(Param^.Args[0]+(arg0len-arg1len+1), Param^.Args[1]+1, arg1len-1) = 0;
end;
end else
if Param^.Args[1][arg1len-1] = '*' then
@@ -1721,36 +1721,36 @@
arg0len := dbfStrLen(Param^.Args[0]);
match := arg0len >= arg1len - 1;
if match then
- match := AnsiStrLComp(Param^.Args[0], Param^.Args[1], arg1len-1) = 0;
+ match := dbfStrLComp(Param^.Args[0], Param^.Args[1], arg1len-1) = 0;
end else begin
- match := AnsiStrComp(Param^.Args[0], Param^.Args[1]) = 0;
+ match := dbfStrComp(Param^.Args[0], Param^.Args[1]) = 0;
end;
Param^.Res.MemoryPos^^ := AnsiChar(match); // Was Char
end;
procedure FuncStr_EQ(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrComp(Param^.Args[0], Param^.Args[1]) = 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrComp(Param^.Args[0], Param^.Args[1]) = 0); // Was Char
end;
procedure FuncStr_NEQ(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrComp(Param^.Args[0], Param^.Args[1]) <> 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrComp(Param^.Args[0], Param^.Args[1]) <> 0); // Was Char
end;
procedure FuncStr_LT(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrComp(Param^.Args[0], Param^.Args[1]) < 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrComp(Param^.Args[0], Param^.Args[1]) < 0); // Was Char
end;
procedure FuncStr_GT(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrComp(Param^.Args[0], Param^.Args[1]) > 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrComp(Param^.Args[0], Param^.Args[1]) > 0); // Was Char
end;
procedure FuncStr_LTE(Param: PExpressionRec);
begin
- Param^.Res.MemoryPos^^ := AnsiChar(AnsiStrComp(Param^.Args[0], Param^.Args[1]) <= 0); // Was Char
+ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrComp(Param^.Args[0], Param^.Args[1]) <= 0); // Was Char
end;
procedure FuncStr_GTE(Param: PExpressionRec);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2014-07-13 19:07:20
|
Revision: 327
http://sourceforge.net/p/tdbf/code/327
Author: twm
Date: 2014-07-13 19:07:16 +0000 (Sun, 13 Jul 2014)
Log Message:
-----------
if a string constant is using quotes (' or "), it can escape these by doubling them
Modified Paths:
--------------
trunk/src/dbf_prscore.pas
trunk/src/dbf_prsdef.pas
Modified: trunk/src/dbf_prscore.pas
===================================================================
--- trunk/src/dbf_prscore.pas 2014-07-13 18:43:03 UTC (rev 326)
+++ trunk/src/dbf_prscore.pas 2014-07-13 19:07:16 UTC (rev 327)
@@ -837,17 +837,33 @@
else if AnExpr[I2] = FDecimalSeparator then
ReadConstant(AnExpr, false)
else
+ // String constants can be delimited by ' or "
+ // but need not be - see below
+ // To use a delimiter inside the string, double it up to escape it
case AnExpr[I2] of
'''', '"':
begin
isConstant := true;
constChar := AnExpr[I2];
Inc(I2);
- while (I2 <= Len) and (AnExpr[I2] <> constChar) do
- Inc(I2);
- if I2 <= Len then
- Inc(I2);
+ while (I2 <= Len) do begin
+ // Regular character?
+ if (AnExpr[I2] <> constChar) then
+ Inc(I2)
+ else begin
+ // we do have a const, now check for escaped consts
+ if (I2 + 1 <= Len) and
+ (AnExpr[I2 + 1] = constChar) then begin
+ Inc(I2,2) //skip past, deal with duplicates later
+ end else begin
+ // at the trailing delimiter
+ Inc(I2); //move past delimiter
+ break;
+ end;
+ end;
+ end;
end;
+ // However string constants can also appear without delimiters
'a'..'z', 'A'..'Z', '_':
begin
while (I2 <= Len) and CharInSet(AnExpr[I2], ['a'..'z', 'A'..'Z', '_', '0'..'9']) do
@@ -934,9 +950,10 @@
W[1] := '$';
W := IntToStr(StrToInt(W));
end;
- if (W[1] = '''') or (W[1] = '"') then
- TempWord := TStringConstant.Create(W)
- else begin
+ if (W[1] = '''') or (W[1] = '"') then begin
+ // StringConstant will handle any escaped quotes
+ TempWord := TStringConstant.Create(W);
+ end else begin
DecSep := Pos(FDecimalSeparator, W);
if (DecSep > 0) then
begin
Modified: trunk/src/dbf_prsdef.pas
===================================================================
--- trunk/src/dbf_prsdef.pas 2014-07-13 18:43:03 UTC (rev 326)
+++ trunk/src/dbf_prsdef.pas 2014-07-13 19:07:16 UTC (rev 327)
@@ -191,6 +191,8 @@
private
FValue: AnsiString; // Was string
public
+ // Allow undelimited, delimited by single quotes, delimited by double quotes
+ // If delimited, allow escaping inside string with double delimiters
constructor Create(AValue: string);
function AsPointer: PAnsiChar; override; // Was PChar
@@ -607,14 +609,25 @@
constructor TStringConstant.Create(AValue: string);
var
firstChar, lastChar: Char;
+ s: string;
+ Len: integer;
begin
inherited Create(AValue, etString, _StringConstant);
+ // fixme:
+ // This is potentially dangerous if AValue contains multi byte characters it is
+ // possible that it starts with ' or " and ends in a character whose second
+ // (or later) byte is byte(') or byte("). I have no idea if such characters exist
+ // Isn't there an Unquote function for doing this, anyway?
+ // --- 2014-07-13 twm
+ Len := Length(AValue);
firstChar := AValue[1];
- lastChar := AValue[Length(AValue)];
- if (firstChar = lastChar) and ((firstChar = '''') or (firstChar = '"')) then
- FValue := AnsiString(Copy(AValue, 2, Length(AValue) - 2)) // AnsiString cast added
- else
+ lastChar := AValue[Len];
+ if (firstChar = lastChar) and ((firstChar = '''') or (firstChar = '"')) then begin
+ s := Copy(AValue, 2, Len - 2);
+ s := StringReplace(s, firstChar + firstChar, firstChar, [rfReplaceAll, rfIgnoreCase]);
+ FValue := AnsiString(s);
+ end else
FValue := AnsiString(AValue); // AnsiString cast added
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2015-05-23 09:45:52
|
Revision: 460
http://sourceforge.net/p/tdbf/code/460
Author: twm
Date: 2015-05-23 09:45:50 +0000 (Sat, 23 May 2015)
Log Message:
-----------
oops, forgot these two changes for the following to actually compile and work:
if cond. define TDBF_IGNORE_INVALID_INDICES is given, ignore invalid index files so we can still open dbf files even if the index files are broken (patch by DS)
Modified Paths:
--------------
trunk/src/dbf_common.pas
trunk/src/dbf_parser.pas
Modified: trunk/src/dbf_common.pas
===================================================================
--- trunk/src/dbf_common.pas 2015-05-23 09:41:46 UTC (rev 459)
+++ trunk/src/dbf_common.pas 2015-05-23 09:45:50 UTC (rev 460)
@@ -27,6 +27,8 @@
type
EDbfError = class (EDatabaseError)
end;
+ EDbfErrorInvalidIndex = class(EDbfError)
+ end;
EDbfWriteError = class (EDbfError)
end;
Modified: trunk/src/dbf_parser.pas
===================================================================
--- trunk/src/dbf_parser.pas 2015-05-23 09:41:46 UTC (rev 459)
+++ trunk/src/dbf_parser.pas 2015-05-23 09:45:50 UTC (rev 460)
@@ -478,7 +478,7 @@
// is this variable a fieldname?
FieldInfo := GetVariableInfo(AnsiString(VarName));
if FieldInfo = nil then
- raise EDbfError.CreateFmt(STRING_INDEX_BASED_ON_UNKNOWN_FIELD, [VarName]);
+ raise EDbfErrorInvalidIndex.CreateFmt(STRING_INDEX_BASED_ON_UNKNOWN_FIELD, [VarName]);
// define field in parser
case FieldInfo.FieldType of
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2015-09-01 12:53:43
|
Revision: 528
http://sourceforge.net/p/tdbf/code/528
Author: paulenandrew
Date: 2015-09-01 12:53:40 +0000 (Tue, 01 Sep 2015)
Log Message:
-----------
fix parser IsNull flag uninitialized
Modified Paths:
--------------
trunk/src/dbf_parser.pas
trunk/src/dbf_prscore.pas
Modified: trunk/src/dbf_parser.pas
===================================================================
--- trunk/src/dbf_parser.pas 2015-08-31 20:19:29 UTC (rev 527)
+++ trunk/src/dbf_parser.pas 2015-09-01 12:53:40 UTC (rev 528)
@@ -675,8 +675,8 @@
Result := PAnsiChar(ExpResult);
IsNull := False;
if LastRec <> nil then
- if LastRec.IsNullPtr <> nil then
- IsNull := LastRec.IsNullPtr^;
+ if LastRec^.IsNullPtr <> nil then
+ IsNull := LastRec^.IsNullPtr^;
end else begin
// simple field, get field result
Result := TFieldVar(FFieldVarList.Objects[0]).FieldVal;
Modified: trunk/src/dbf_prscore.pas
===================================================================
--- trunk/src/dbf_prscore.pas 2015-08-31 20:19:29 UTC (rev 527)
+++ trunk/src/dbf_prscore.pas 2015-09-01 12:53:40 UTC (rev 528)
@@ -1288,6 +1288,7 @@
Result^.ExprWord := nil;
Result^.ResetDest := false;
Result^.ExpressionContext := @FExpressionContext;
+ Result^.IsNull := False;
Result^.IsNullPtr := nil;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2015-09-01 14:48:00
|
Revision: 533
http://sourceforge.net/p/tdbf/code/533
Author: paulenandrew
Date: 2015-09-01 14:47:57 +0000 (Tue, 01 Sep 2015)
Log Message:
-----------
consistently use EDbfErrorInvalidIndex when parsing index expression, required for twm's TDBF_IGNORE_INVALID_INDICES conditional define
Modified Paths:
--------------
trunk/src/dbf_idxfile.pas
trunk/src/dbf_parser.pas
trunk/src/dbf_prscore.pas
trunk/src/dbf_prsdef.pas
Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas 2015-09-01 14:14:57 UTC (rev 532)
+++ trunk/src/dbf_idxfile.pas 2015-09-01 14:47:57 UTC (rev 533)
@@ -88,6 +88,7 @@
function IsIndex: Boolean; override;
procedure ValidateExpression(AExpression: string); override;
+ function ExceptionClass: TExceptionClass; override;
public
constructor Create(ADbfFile: Pointer); override;
property ResultLen: Integer read FResultLen;
@@ -1808,9 +1809,14 @@
// check if expression not too long
if FResultLen > MaxIndexKeyLen then
- raise EDbfError.CreateFmt(STRING_INDEX_EXPRESSION_TOO_LONG, [AExpression, FResultLen]);
+ raise ExceptionClass.CreateFmt(STRING_INDEX_EXPRESSION_TOO_LONG, [AExpression, FResultLen]);
end;
+function TDbfIndexParser.ExceptionClass: TExceptionClass;
+begin
+ Result := EDbfErrorInvalidIndex;
+end;
+
function TDbfIndexParser.GetKeyType: Char;
var
lDbfFieldDef: TDbfFieldDef;
@@ -1820,7 +1826,7 @@
etInteger, etLargeInt, etFloat: Result := 'N';
etDateTime: Result := 'D';
else
- raise EParserException.Create(STRING_INVALID_INDEX_TYPE);
+ raise EDbfError.Create(STRING_INVALID_INDEX_TYPE);
end;
lDbfFieldDef:= DbfFieldDef;
if Assigned(lDbfFieldDef) then
Modified: trunk/src/dbf_parser.pas
===================================================================
--- trunk/src/dbf_parser.pas 2015-09-01 14:14:57 UTC (rev 532)
+++ trunk/src/dbf_parser.pas 2015-09-01 14:47:57 UTC (rev 533)
@@ -539,7 +539,7 @@
// is this variable a fieldname?
FieldInfo := GetVariableInfo(VarName);
if FieldInfo = nil then
- raise EDbfErrorInvalidIndex.CreateFmt(STRING_INDEX_BASED_ON_UNKNOWN_FIELD, [VarName]);
+ raise ExceptionClass.CreateFmt(STRING_INDEX_BASED_ON_UNKNOWN_FIELD, [VarName]);
// define field in parser
FillChar(VariableFieldInfo, SizeOf(VariableFieldInfo), 0);
@@ -588,7 +588,7 @@
TempFieldVar.ExprWord := DefineDateTimeVariable(VarName, TempFieldVar.FieldVal, TempFieldVar.IsNullPtr, @VariableFieldInfo);
end;
else
- raise EParserException.CreateFmt(STRING_INDEX_BASED_ON_INVALID_FIELD, [VarName]);
+ raise ExceptionClass.CreateFmt(STRING_INDEX_BASED_ON_INVALID_FIELD, [VarName]);
end;
// add to our own list
Modified: trunk/src/dbf_prscore.pas
===================================================================
--- trunk/src/dbf_prscore.pas 2015-09-01 14:14:57 UTC (rev 532)
+++ trunk/src/dbf_prscore.pas 2015-09-01 14:47:57 UTC (rev 533)
@@ -80,6 +80,7 @@
function GetResultType: TExpressionType; virtual;
function IsIndex: Boolean; virtual;
procedure OptimizeExpr(var ExprRec: PExpressionRec); virtual;
+ function ExceptionClass: TExceptionClass; virtual;
property CurrentRec: PExpressionRec read FCurrentRec write FCurrentRec;
property LastRec: PExpressionRec read FLastRec write FLastRec;
@@ -472,10 +473,10 @@
// fatal error?
case error of
- 1: raise EParserException.Create('Function or operand has too few arguments');
- 2: raise EParserException.Create('Argument type mismatch');
- 3: raise EParserException.Create('Function or operand has too many arguments');
- 4: raise EParserException.Create('No function with this name, remove brackets for variable');
+ 1: raise ExceptionClass.Create('Function or operand has too few arguments');
+ 2: raise ExceptionClass.Create('Argument type mismatch');
+ 3: raise ExceptionClass.Create('Function or operand has too many arguments');
+ 4: raise ExceptionClass.Create('No function with this name, remove brackets for variable');
end;
end;
@@ -675,7 +676,7 @@
while I < LastItem do
begin
if (TExprWord(Expr.Items[I]).ResultType = etLeftBracket) and (TExprWord(Expr.Items[I + 1]).ResultType = etRightBracket) then
- raise EParserError.Create('Empty parentheses');
+ raise ExceptionClass.Create('Empty parentheses');
Inc(I);
end;
@@ -810,7 +811,7 @@
Result^.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
end;
end else
- raise EParserException.Create('Operator/function missing');
+ raise ExceptionClass.Create('Operator/function missing');
end;
procedure TCustomExpressionParser.ParseString(AnExpression: string; DestCollection: TExprCollection);
@@ -1018,7 +1019,7 @@
begin
DestCollection.Add(FWordsList.Items[I])
end else begin
- raise EParserException.Create('Unknown variable '''+W+''' found.');
+ raise ExceptionClass.Create('Unknown variable '''+W+''' found.');
end;
end;
until I2 > Len;
@@ -1028,7 +1029,7 @@
var
I, J, K, L: Integer;
begin
- AnExprList.Check;
+ AnExprList.Check(ExceptionClass);
with AnExprList do
begin
I := 0;
@@ -1112,18 +1113,18 @@
{-----MISC CHECKS-----}
if (TExprWord(Items[I]).IsVariable) and ((I < Count - 1) and
(TExprWord(Items[I + 1]).IsVariable)) then
- raise EParserException.Create('Missing operator between '''+TExprWord(Items[I]).Name+''' and '''+TExprWord(Items[I]).Name+'''');
+ raise ExceptionClass.Create('Missing operator between '''+TExprWord(Items[I]).Name+''' and '''+TExprWord(Items[I]).Name+'''');
if (TExprWord(Items[I]).ResultType = etLeftBracket) and (I >= Count - 1) then
- raise EParserException.Create('Missing closing bracket');
+ raise ExceptionClass.Create('Missing closing bracket');
if (TExprWord(Items[I]).ResultType = etRightBracket) and ((I < Count - 1) and
(TExprWord(Items[I + 1]).ResultType = etLeftBracket)) then
- raise EParserException.Create('Missing operator between )(');
+ raise ExceptionClass.Create('Missing operator between )(');
if (TExprWord(Items[I]).ResultType = etRightBracket) and ((I < Count - 1) and
(TExprWord(Items[I + 1]).IsVariable)) then
- raise EParserException.Create('Missing operator between ) and constant/variable');
+ raise ExceptionClass.Create('Missing operator between ) and constant/variable');
if (TExprWord(Items[I]).ResultType = etLeftBracket) and ((I > 0) and
(TExprWord(Items[I - 1]).IsVariable)) then
- raise EParserException.Create('Missing operator between constant/variable and (');
+ raise ExceptionClass.Create('Missing operator between constant/variable and (');
{-----CHECK ON INTPOWER------}
if (TExprWord(Items[I]).Name = '^') and ((I < Count - 1) and
@@ -1279,6 +1280,11 @@
RemoveConstants(ExprRec);
end;
+function TCustomExpressionParser.ExceptionClass: TExceptionClass;
+begin
+ Result := EParserError;
+end;
+
function TCustomExpressionParser.MakeRec: PExpressionRec;
var
I: Integer;
Modified: trunk/src/dbf_prsdef.pas
===================================================================
--- trunk/src/dbf_prsdef.pas 2015-09-01 14:14:57 UTC (rev 532)
+++ trunk/src/dbf_prsdef.pas 2015-09-01 14:47:57 UTC (rev 533)
@@ -88,7 +88,7 @@
TExprCollection = class(TNoOwnerCollection)
public
- procedure Check;
+ procedure Check(ExceptionClass: TExceptionClass);
procedure EraseExtraBrackets;
end;
@@ -994,7 +994,7 @@
{ TExprCollection }
-procedure TExprCollection.Check;
+procedure TExprCollection.Check(ExceptionClass: TExceptionClass);
var
brCount, I: Integer;
begin
@@ -1007,7 +1007,7 @@
end;
end;
if brCount <> 0 then
- raise EParserException.Create('Unequal brackets');
+ raise ExceptionClass.Create('Unequal brackets');
end;
procedure TExprCollection.EraseExtraBrackets;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2015-09-18 20:03:30
|
Revision: 559
http://sourceforge.net/p/tdbf/code/559
Author: paulenandrew
Date: 2015-09-18 20:03:27 +0000 (Fri, 18 Sep 2015)
Log Message:
-----------
fix compiler warning messages in Free Pascal related to unused units
Modified Paths:
--------------
trunk/src/dbf_avl.pas
trunk/src/dbf_prscore.pas
trunk/src/dbf_prsdef.pas
trunk/src/dbf_prssupp.pas
Modified: trunk/src/dbf_avl.pas
===================================================================
--- trunk/src/dbf_avl.pas 2015-09-18 19:58:08 UTC (rev 558)
+++ trunk/src/dbf_avl.pas 2015-09-18 20:03:27 UTC (rev 559)
@@ -4,9 +4,6 @@
{$I dbf_common.inc}
-uses
- dbf_common;
-
type
TBal = -1..1;
Modified: trunk/src/dbf_prscore.pas
===================================================================
--- trunk/src/dbf_prscore.pas 2015-09-18 19:58:08 UTC (rev 558)
+++ trunk/src/dbf_prscore.pas 2015-09-18 20:03:27 UTC (rev 559)
@@ -27,7 +27,9 @@
uses
SysUtils,
Classes,
+ {$ifndef FPC_VERSION}
Db,
+ {$endif}
Math,
dbf_Common,
dbf_prssupp,
Modified: trunk/src/dbf_prsdef.pas
===================================================================
--- trunk/src/dbf_prsdef.pas 2015-09-18 19:58:08 UTC (rev 558)
+++ trunk/src/dbf_prsdef.pas 2015-09-18 20:03:27 UTC (rev 559)
@@ -12,7 +12,9 @@
{$endif}
SysUtils,
Classes,
- db,
+{$ifndef FPC_VERSION}
+ Db,
+{$endif}
dbf_common,
dbf_prssupp;
Modified: trunk/src/dbf_prssupp.pas
===================================================================
--- trunk/src/dbf_prssupp.pas 2015-09-18 19:58:08 UTC (rev 558)
+++ trunk/src/dbf_prssupp.pas 2015-09-18 20:03:27 UTC (rev 559)
@@ -71,8 +71,7 @@
uses
SysUtils,
- dbf_AnsiStrings,
- dbf_common;
+ dbf_AnsiStrings;
destructor TOCollection.Destroy;
begin
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2015-09-21 11:27:29
|
Revision: 560
http://sourceforge.net/p/tdbf/code/560
Author: paulenandrew
Date: 2015-09-21 11:27:27 +0000 (Mon, 21 Sep 2015)
Log Message:
-----------
fix compiler warning messages in Free Pascal related to unused parameters
Modified Paths:
--------------
trunk/src/dbf_memo.pas
Added Paths:
-----------
trunk/src/dbf.dcu
trunk/src/dbf_AnsiStrings.dcu
trunk/src/dbf_avl.dcu
trunk/src/dbf_collate.dcu
trunk/src/dbf_common.dcu
trunk/src/dbf_cursor.dcu
trunk/src/dbf_dbffile.dcu
trunk/src/dbf_fields.dcu
trunk/src/dbf_idxcur.dcu
trunk/src/dbf_idxfile.dcu
trunk/src/dbf_lang.dcu
trunk/src/dbf_memo.dcu
trunk/src/dbf_parser.dcu
trunk/src/dbf_pgfile.dcu
trunk/src/dbf_prscore.dcu
trunk/src/dbf_prsdef.dcu
trunk/src/dbf_prssupp.dcu
trunk/src/dbf_str.dcu
trunk/src/dbf_wtil.dcu
Added: trunk/src/dbf.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf.dcu
===================================================================
--- trunk/src/dbf.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_AnsiStrings.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_AnsiStrings.dcu
===================================================================
--- trunk/src/dbf_AnsiStrings.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_AnsiStrings.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_AnsiStrings.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_avl.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_avl.dcu
===================================================================
--- trunk/src/dbf_avl.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_avl.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_avl.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_collate.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_collate.dcu
===================================================================
--- trunk/src/dbf_collate.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_collate.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_collate.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_common.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_common.dcu
===================================================================
--- trunk/src/dbf_common.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_common.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_common.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_cursor.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_cursor.dcu
===================================================================
--- trunk/src/dbf_cursor.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_cursor.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_cursor.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_dbffile.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_dbffile.dcu
===================================================================
--- trunk/src/dbf_dbffile.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_dbffile.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_dbffile.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_fields.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_fields.dcu
===================================================================
--- trunk/src/dbf_fields.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_fields.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_fields.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_idxcur.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_idxcur.dcu
===================================================================
--- trunk/src/dbf_idxcur.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_idxcur.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_idxcur.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_idxfile.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_idxfile.dcu
===================================================================
--- trunk/src/dbf_idxfile.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_idxfile.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_idxfile.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_lang.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_lang.dcu
===================================================================
--- trunk/src/dbf_lang.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_lang.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_lang.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_memo.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_memo.dcu
===================================================================
--- trunk/src/dbf_memo.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_memo.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_memo.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Modified: trunk/src/dbf_memo.pas
===================================================================
--- trunk/src/dbf_memo.pas 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_memo.pas 2015-09-21 11:27:27 UTC (rev 560)
@@ -76,8 +76,8 @@
function GetBlockLen: Integer; override;
function GetMemoSize: Integer; override;
function GetNextFreeBlock: Integer; override;
- procedure SetNextFreeBlock(BlockNo: Integer); override;
- procedure SetBlockLen(BlockLen: Integer); override;
+ procedure SetNextFreeBlock({%H-}BlockNo: Integer); override;
+ procedure SetBlockLen({%H-}BlockLen: Integer); override;
public
constructor Create(ADbfFile: pointer);
@@ -85,8 +85,8 @@
procedure CloseFile; override;
procedure OpenFile; override;
- function ReadRecord(IntRecNum: Integer; Buffer: Pointer): Integer; override;
- procedure WriteRecord(IntRecNum: Integer; Buffer: Pointer); override;
+ function ReadRecord({%H-}IntRecNum: Integer; {%H-}Buffer: Pointer): Integer; override;
+ procedure WriteRecord({%H-}IntRecNum: Integer; {%H-}Buffer: Pointer); override;
end;
PInteger = ^Integer;
Added: trunk/src/dbf_parser.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_parser.dcu
===================================================================
--- trunk/src/dbf_parser.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_parser.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_parser.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_pgfile.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_pgfile.dcu
===================================================================
--- trunk/src/dbf_pgfile.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_pgfile.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_pgfile.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_prscore.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_prscore.dcu
===================================================================
--- trunk/src/dbf_prscore.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_prscore.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_prscore.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_prsdef.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_prsdef.dcu
===================================================================
--- trunk/src/dbf_prsdef.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_prsdef.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_prsdef.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_prssupp.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_prssupp.dcu
===================================================================
--- trunk/src/dbf_prssupp.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_prssupp.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_prssupp.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_str.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_str.dcu
===================================================================
--- trunk/src/dbf_str.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_str.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_str.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
Added: trunk/src/dbf_wtil.dcu
===================================================================
(Binary files differ)
Index: trunk/src/dbf_wtil.dcu
===================================================================
--- trunk/src/dbf_wtil.dcu 2015-09-18 20:03:27 UTC (rev 559)
+++ trunk/src/dbf_wtil.dcu 2015-09-21 11:27:27 UTC (rev 560)
Property changes on: trunk/src/dbf_wtil.dcu
___________________________________________________________________
Added: svn:mime-type
## -0,0 +1 ##
+application/octet-stream
\ No newline at end of property
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2015-09-21 11:29:41
|
Revision: 561
http://sourceforge.net/p/tdbf/code/561
Author: paulenandrew
Date: 2015-09-21 11:29:39 +0000 (Mon, 21 Sep 2015)
Log Message:
-----------
rollback! fix compiler warning messages in Free Pascal related to unused parameters
Removed Paths:
-------------
trunk/src/dbf.dcu
trunk/src/dbf_AnsiStrings.dcu
trunk/src/dbf_avl.dcu
trunk/src/dbf_collate.dcu
trunk/src/dbf_common.dcu
trunk/src/dbf_cursor.dcu
trunk/src/dbf_dbffile.dcu
trunk/src/dbf_fields.dcu
trunk/src/dbf_idxcur.dcu
trunk/src/dbf_idxfile.dcu
trunk/src/dbf_lang.dcu
trunk/src/dbf_memo.dcu
trunk/src/dbf_parser.dcu
trunk/src/dbf_pgfile.dcu
trunk/src/dbf_prscore.dcu
trunk/src/dbf_prsdef.dcu
trunk/src/dbf_prssupp.dcu
trunk/src/dbf_str.dcu
trunk/src/dbf_wtil.dcu
Deleted: trunk/src/dbf.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_AnsiStrings.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_avl.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_collate.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_common.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_cursor.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_dbffile.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_fields.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_idxcur.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_idxfile.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_lang.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_memo.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_parser.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_pgfile.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_prscore.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_prsdef.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_prssupp.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_str.dcu
===================================================================
(Binary files differ)
Deleted: trunk/src/dbf_wtil.dcu
===================================================================
(Binary files differ)
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2015-09-21 11:36:27
|
Revision: 562
http://sourceforge.net/p/tdbf/code/562
Author: paulenandrew
Date: 2015-09-21 11:36:25 +0000 (Mon, 21 Sep 2015)
Log Message:
-----------
rename dbf_AnsiStrings to dbf_ansistrings to match file name and for consistency with other units
Modified Paths:
--------------
trunk/src/dbf.pas
trunk/src/dbf_ansistrings.pas
trunk/src/dbf_common.pas
trunk/src/dbf_dbffile.pas
trunk/src/dbf_idxcur.pas
trunk/src/dbf_idxfile.pas
trunk/src/dbf_prscore.pas
trunk/src/dbf_prsdef.pas
trunk/src/dbf_prssupp.pas
trunk/src/dbf_wtil.pas
Modified: trunk/src/dbf.pas
===================================================================
--- trunk/src/dbf.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -540,7 +540,7 @@
{$ifdef SUPPORT_SEPARATE_VARIANTS_UNIT}
Variants,
{$endif}
- dbf_AnsiStrings,
+ dbf_ansistrings,
dbf_idxcur,
dbf_memo,
dbf_str;
Modified: trunk/src/dbf_ansistrings.pas
===================================================================
--- trunk/src/dbf_ansistrings.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf_ansistrings.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -1,4 +1,4 @@
-unit dbf_AnsiStrings;
+unit dbf_ansistrings;
{$I dbf_common.inc}
Modified: trunk/src/dbf_common.pas
===================================================================
--- trunk/src/dbf_common.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf_common.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -180,11 +180,11 @@
{$ifdef WINDOWS}
uses
- dbf_AnsiStrings,
+ dbf_ansistrings,
Windows;
{$else}
uses
- dbf_AnsiStrings;
+ dbf_ansistrings;
{$endif}
//====================================================================
Modified: trunk/src/dbf_dbffile.pas
===================================================================
--- trunk/src/dbf_dbffile.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf_dbffile.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -217,7 +217,7 @@
{$IFDEF DELPHI_XE2}
System.Types,
{$ENDIF}
- dbf_AnsiStrings,
+ dbf_ansistrings,
dbf_str, dbf_lang, dbf_prssupp, dbf_prsdef;
const
Modified: trunk/src/dbf_idxcur.pas
===================================================================
--- trunk/src/dbf_idxcur.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf_idxcur.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -56,7 +56,7 @@
implementation
uses
- dbf_AnsiStrings;
+ dbf_ansistrings;
//==========================================================
//============ TIndexCursor
Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf_idxfile.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -442,7 +442,7 @@
implementation
uses
- dbf_AnsiStrings,
+ dbf_ansistrings,
dbf_dbffile,
dbf_fields,
dbf_str,
Modified: trunk/src/dbf_prscore.pas
===================================================================
--- trunk/src/dbf_prscore.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf_prscore.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -276,7 +276,7 @@
implementation
uses
- dbf_AnsiStrings;
+ dbf_ansistrings;
procedure LinkVariable(ExprRec: PExpressionRec);
begin
Modified: trunk/src/dbf_prsdef.pas
===================================================================
--- trunk/src/dbf_prsdef.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf_prsdef.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -417,7 +417,7 @@
implementation
uses
- dbf_AnsiStrings
+ dbf_ansistrings
{$IFDEF DELPHI_XE2}
, System.Types
{$ENDIF}
Modified: trunk/src/dbf_prssupp.pas
===================================================================
--- trunk/src/dbf_prssupp.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf_prssupp.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -71,7 +71,7 @@
uses
SysUtils,
- dbf_AnsiStrings;
+ dbf_ansistrings;
destructor TOCollection.Destroy;
begin
Modified: trunk/src/dbf_wtil.pas
===================================================================
--- trunk/src/dbf_wtil.pas 2015-09-21 11:29:39 UTC (rev 561)
+++ trunk/src/dbf_wtil.pas 2015-09-21 11:36:25 UTC (rev 562)
@@ -11,7 +11,7 @@
{$else}
Libc,
{$endif}
- dbf_AnsiStrings,
+ dbf_ansistrings,
Types, SysUtils, Classes;
const
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <lpl...@us...> - 2015-11-09 17:17:07
|
Revision: 627
http://sourceforge.net/p/tdbf/code/627
Author: lploeger
Date: 2015-11-09 17:17:04 +0000 (Mon, 09 Nov 2015)
Log Message:
-----------
Reverted r578 (partially)
Do not use descending index in LocateRecord() to make the index transparent to the user
Revision Links:
--------------
http://sourceforge.net/p/tdbf/code/578
Modified Paths:
--------------
trunk/src/dbf.pas
trunk/src/dbf_idxfile.pas
Modified: trunk/src/dbf.pas
===================================================================
--- trunk/src/dbf.pas 2015-11-09 17:12:31 UTC (rev 626)
+++ trunk/src/dbf.pas 2015-11-09 17:17:04 UTC (rev 627)
@@ -2345,7 +2345,7 @@
end;
end;
end;
- if (lCursor <> nil) then
+ if (lCursor <> nil) and (not TIndexCursor(lCursor).IndexFile.IsDescending) then
begin
FCursor := lCursor;
Result := LocateRecordIndex(KeyFields, KeyValues, Options);
Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas 2015-11-09 17:12:31 UTC (rev 626)
+++ trunk/src/dbf_idxfile.pas 2015-11-09 17:17:04 UTC (rev 627)
@@ -3893,19 +3893,6 @@
if done = 2 then
TempPage := TempPage.LowerPage;
until done = 0;
-
- // For a descending index we actually might have found an item smaller than the key.
- // In that case, return the preceding item.
- if not AInsert and FIsDescending then
- begin
- if (TempPage.EntryNo>TempPage.LowIndex) and (Result<>0)then
- begin
- TempPage.EntryNo := TempPage.EntryNo-1;
- Result := -TempPage.MatchKey;
- end
- else
- Result := -Result;
- end;
end;
function TIndexFile.MatchKey(UserKey: PAnsiChar): Integer;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2018-12-26 12:30:48
|
Revision: 676
http://sourceforge.net/p/tdbf/code/676
Author: twm
Date: 2018-12-26 12:30:47 +0000 (Wed, 26 Dec 2018)
Log Message:
-----------
new cond. define InternalAddRecord_Wants_TRecordBuffer, used to determine the parameter type fo TDbf.InternalAddRecord (Pointer or TRecordBuffer). This apparently changed in Delphi XE while the TRecordBuffer type was already introduced in Delphi 2009. Fixes bug #96 for Delphi 2009 and 2010.
Modified Paths:
--------------
trunk/src/dbf.pas
trunk/src/dbf_common.inc
Modified: trunk/src/dbf.pas
===================================================================
--- trunk/src/dbf.pas 2018-12-26 12:28:41 UTC (rev 675)
+++ trunk/src/dbf.pas 2018-12-26 12:30:47 UTC (rev 676)
@@ -256,7 +256,7 @@
function GetBookmarkFlag(Buffer: TDbfRecordBuffer): TBookmarkFlag; override; {virtual abstract}
function GetRecord(Buffer: TDbfRecBuf; GetMode: TGetMode; {%H-}DoCheck: Boolean): TGetResult; override; {virtual abstract}
function GetRecordSize: Word; override; {virtual abstract}
- procedure InternalAddRecord(Buffer: {$ifdef SUPPORT_TRECORDBUFFER}TDbfRecordBuffer{$else}Pointer{$endif}; {%H-}Append: Boolean); override; {virtual abstract}
+ procedure InternalAddRecord(Buffer: {$ifdef InternalAddRecord_Wants_TRecordBuffer}TDbfRecordBuffer{$else}Pointer{$endif}; {%H-}Append: Boolean); override; {virtual abstract}
procedure InternalClose; override; {virtual abstract}
procedure InternalDelete; override; {virtual abstract}
procedure InternalFirst; override; {virtual abstract}
Modified: trunk/src/dbf_common.inc
===================================================================
--- trunk/src/dbf_common.inc 2018-12-26 12:28:41 UTC (rev 675)
+++ trunk/src/dbf_common.inc 2018-12-26 12:30:47 UTC (rev 676)
@@ -504,6 +504,7 @@
{$endif}
{$ifdef Delphi_XE}
+ {$define InternalAddRecord_Wants_TRecordBuffer}
{$define SUPPORT_FORMATSETTINGS}
{$define SUPPORT_FORMATSETTINGS_CREATE}
{$endif}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <tw...@us...> - 2020-08-24 19:34:52
|
Revision: 689
http://sourceforge.net/p/tdbf/code/689
Author: twm
Date: 2020-08-24 19:34:49 +0000 (Mon, 24 Aug 2020)
Log Message:
-----------
fixed compile errors in Delphi 7
Modified Paths:
--------------
trunk/src/dbf_idxfile.pas
trunk/src/dbf_prscore.pas
trunk/src/dbf_prsdef.pas
trunk/src/dbf_prssupp.pas
Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas 2020-08-24 19:33:05 UTC (rev 688)
+++ trunk/src/dbf_idxfile.pas 2020-08-24 19:34:49 UTC (rev 689)
@@ -3322,7 +3322,7 @@
if PIndexHdr(FIndexHeader)^.KeyType = 'D' then
begin
FUserNumeric:= PDouble(Buffer)^ + 2415019; {Julian date}
- Result:= @FUserNumeric;
+ Result:= TDbfRecordBuffer(@FUserNumeric);
end;
end;
Modified: trunk/src/dbf_prscore.pas
===================================================================
--- trunk/src/dbf_prscore.pas 2020-08-24 19:33:05 UTC (rev 688)
+++ trunk/src/dbf_prscore.pas 2020-08-24 19:34:49 UTC (rev 689)
@@ -2375,7 +2375,7 @@
end;
etFloat:
begin
- ResSource := @Buffer;
+ ResSource := @Buffer[0];
ResLength := 20;
Precision := 4;
FloatValue := PDouble(Arg)^;
@@ -2405,7 +2405,7 @@
etInteger,
etLargeInt:
begin
- ResSource := @Buffer;
+ ResSource := @Buffer[0];
ResLength := 11;
if not ArgIsNull then
Len:= IntToStrWidth(PInteger(Arg)^, ResLength, ResSource, Pad, ' ');
@@ -2416,7 +2416,7 @@
begin
ResLength := 8;
if ArgIsNull then
- ResSource := @Buffer
+ ResSource := @Buffer[0]
else
begin
StringValue := AnsiString(FormatDateTime('YYYYMMDD', PDateTime(Arg)^));
Modified: trunk/src/dbf_prsdef.pas
===================================================================
--- trunk/src/dbf_prsdef.pas 2020-08-24 19:33:05 UTC (rev 688)
+++ trunk/src/dbf_prsdef.pas 2020-08-24 19:34:49 UTC (rev 689)
@@ -55,7 +55,7 @@
procedure AssureSpace(ASize: Integer);
procedure Resize(NewSize: Integer; Exact: Boolean);
procedure Rewind;
- procedure Append(Source: PAnsiChar; Length: Integer); // Was PChar
+ procedure Append(Source: Pointer; Length: Integer); // Was PChar
procedure AppendInteger(Source: Integer);
property Memory: PPAnsiChar read FMemory; // Was: PPChar
@@ -1206,7 +1206,7 @@
FMemoryPos^ := FMemory^ + pos;
end;
-procedure TDynamicType.Append(Source: PAnsiChar; Length: Integer); // Was PChar
+procedure TDynamicType.Append(Source: Pointer; Length: Integer); // Was PChar
begin
// make room for string plus null-terminator
AssureSpace(Length+4);
Modified: trunk/src/dbf_prssupp.pas
===================================================================
--- trunk/src/dbf_prssupp.pas 2020-08-24 19:33:05 UTC (rev 688)
+++ trunk/src/dbf_prssupp.pas 2020-08-24 19:34:49 UTC (rev 689)
@@ -245,7 +245,7 @@
FloatReset(FloatResult);
if FloatRec.Negative then
FloatPutChar(FloatResult, DBF_NEGATIVESIGN);
- DigitCount := dbfStrLen(@FloatRec.Digits);
+ DigitCount := dbfStrLen(@FloatRec.Digits[0]);
if Exponent <= 0 then
begin
DigitMin := Exponent;
@@ -319,7 +319,7 @@
Precision: Integer;
begin
DecimalToDbfStrFormat(FloatResult, FloatRec, Format, FieldPrec);
- Precision:= Integer(dbfStrLen(@FloatRec.Digits));
+ Precision:= Integer(dbfStrLen(@FloatRec.Digits[0]));
if FloatResult.Len > FloatResult.FieldSize then
begin
Precision:= Precision - (FloatResult.Len - FloatResult.FieldSize);
@@ -516,7 +516,7 @@
{$ifdef SUPPORT_FORMATSETTINGSTYPE}
Result := dbfTextToFloatFmt(@Buffer, FloatValue, fvExtended, DbfFormatSettings);
{$else}
- Result := dbfTextToFloat(@Buffer, FloatValue, fvExtended);
+ Result := dbfTextToFloat(@Buffer[0], FloatValue, fvExtended);
{$endif}
end;
if not Result then
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2020-10-04 19:40:59
|
Revision: 704
http://sourceforge.net/p/tdbf/code/704
Author: paulenandrew
Date: 2020-10-04 19:40:57 +0000 (Sun, 04 Oct 2020)
Log Message:
-----------
Clean up commented out code
Code removed by comments has become distracting because of a lot of churn. The code can still be found in the file history.
Modified Paths:
--------------
trunk/src/dbf_dbffile.pas
trunk/src/dbf_idxfile.pas
trunk/src/dbf_memo.pas
trunk/src/dbf_pgfile.pas
Modified: trunk/src/dbf_dbffile.pas
===================================================================
--- trunk/src/dbf_dbffile.pas 2020-10-01 20:27:26 UTC (rev 703)
+++ trunk/src/dbf_dbffile.pas 2020-10-04 19:40:57 UTC (rev 704)
@@ -349,7 +349,6 @@
begin
FFileCodePage := 1255;
end else begin
-// FFileCodePage := GetIntFromStrLength(LangStr+2, 3, 0);
StrToInt32Width(Integer(FFileCodePage), LangStr+2, 3, 0);
if (Ord(LangStr[5]) >= Ord('0')) and (Ord(LangStr[5]) <= Ord('9')) then
FFileCodePage := FFileCodePage * 10 + Ord(LangStr[5]) {%H-}- Ord('0');
@@ -801,23 +800,17 @@
if (HeaderSize=0) then
exit;
- //FillHeader(0);
lDataHdr := PDbfHdr(Header);
GetLocalTime(SystemTime{%H-});
lDataHdr^.Year := SystemTime.wYear - 1900;
lDataHdr^.Month := SystemTime.wMonth;
lDataHdr^.Day := SystemTime.wDay;
-// lDataHdr.RecordCount := RecordCount;
inherited WriteHeader;
-
- // write EOF terminator
-//if RecordCount = 0 then
-// WriteEOFTerminator;
end;
procedure TDbfFile.ConstructFieldDefs;
var
- {lColumnCount,}lHeaderSize,lFieldSize: Integer;
+ lHeaderSize,lFieldSize: Integer;
lPropHdrOffset, lFieldOffset: Integer;
lFieldDescIII: rFieldDescIII;
lFieldDescVII: rFieldDescVII;
@@ -1309,10 +1302,6 @@
try
DestDbfFile.BatchStart;
try
-//{$ifdef USE_CACHE}
-// BufferAhead := true;
-// DestDbfFile.BufferAhead := true;
-//{$endif}
lWRecNo := 1;
last := RecordCount;
if Pack then
@@ -1397,16 +1386,6 @@
// write record
DestDbfFile.WriteRecord(lWRecNo, pDestBuff);
- // update indexes
-// for I := 0 to DestDbfFile.IndexFiles.Count - 1 do
-// begin
-// lIndexFile := TIndexFile(DestDbfFile.IndexFiles.Items[I]);
-// if lIndexFile.UniqueMode = iuUnique then
-// lUniqueMode := iuDistinct
-// else
-// lUniqueMode := lIndexFile.UniqueMode;
-// lIndexFile.Insert(lWRecNo, pDestBuff, lUniqueMode);
-// end;
// go to next record
Inc(lWRecNo);
@@ -1415,10 +1394,6 @@
DoProgress(lRecNo, last, STRING_PROGRESS_PACKINGRECORDS);
end;
-//{$ifdef USE_CACHE}
-// BufferAhead := false;
-// DestDbfFile.BufferAhead := false;
-//{$endif}
BufferAhead := false;
// save index filenames
@@ -1502,7 +1477,6 @@
Src, Dst: Pointer; NativeFormat: boolean): Boolean;
var
FieldOffset, FieldSize: Integer;
-// s: string;
ldd, ldm, ldy, lth, ltm, lts: Integer;
date: TDateTime;
timeStamp: TTimeStamp;
@@ -1666,8 +1640,6 @@
end;
if asciiContents then
begin
- // SetString(s, PChar(Src) + FieldOffset, FieldSize );
- // s := {TrimStr(s)} TrimRight(s);
// truncate spaces at end by shortening fieldsize
while (FieldSize > 0) and (((PAnsiChar(Src) + FieldSize - 1)^ = ' ') or ((PAnsiChar(Src) + FieldSize - 1)^ = #0)) do
dec(FieldSize);
@@ -1694,7 +1666,6 @@
end;
ftSmallInt:
begin
-// PSmallInt(Dst)^ := GetIntFromStrLength(Src, FieldSize, 0);
IntValue := 0;
Result := StrToInt32Width(IntValue, Src, FieldSize, 0);
if Result then
@@ -1704,15 +1675,12 @@
end;
{$ifdef SUPPORT_INT64}
ftLargeInt:
-// PLargeInt(Dst)^ := GetInt64FromStrLength(Src, FieldSize, 0);
Result := StrToIntWidth(PInt64(Dst)^, Src, FieldSize, 0);
{$endif}
ftInteger:
-// PInteger(Dst)^ := GetIntFromStrLength(Src, FieldSize, 0);
Result := StrToInt32Width(PInteger(Dst)^, Src, FieldSize, 0);
ftFloat, ftCurrency:
begin
-// PDouble(Dst)^ := DbfStrToFloat(Src, FieldSize);
FloatValue := 0;
Result := StrToFloatWidth(FloatValue, Src, FieldSize, 0);
if Result then
@@ -1721,9 +1689,6 @@
ftDate, ftDateTime:
begin
// get year, month, day
-// ldy := GetIntFromStrLength(PAnsiChar(Src) + 0, 4, 1);
-// ldm := GetIntFromStrLength(PAnsiChar(Src) + 4, 2, 1);
-// ldd := GetIntFromStrLength(PAnsiChar(Src) + 6, 2, 1);
ldy := 0;
StrToInt32Width(ldy, PAnsiChar(Src) + 0, 4, 1);
ldm := 0;
@@ -1971,19 +1936,14 @@
PAnsiChar(Dst)^ := 'F';
end;
ftSmallInt:
-// GetStrFromInt_Width(PSmallInt(Src)^, FieldSize, PAnsiChar(Dst), #32);
IntToStrWidth(PSmallInt(Src)^, FieldSize, PAnsiChar(Dst), True, #32);
{$ifdef SUPPORT_INT64}
ftLargeInt:
-// GetStrFromInt64_Width(PLargeInt(Src)^, FieldSize, PAnsiChar(Dst), #32);
IntToStrWidth(PInt64(Src)^, FieldSize, PAnsiChar(Dst), True, #32);
{$endif}
ftFloat, ftCurrency:
-// FloatToDbfStr(PDouble(Src)^, FieldSize, FieldPrec, PAnsiChar(Dst));
FloatToStrWidth(PDouble(Src)^, FieldSize, FieldPrec, PAnsiChar(Dst), True);
ftInteger:
-// GetStrFromInt_Width(PInteger(Src)^, FieldSize, PAnsiChar(Dst),
-// IsBlobFieldToPadChar[TempFieldDef.IsBlob]);
IntToStrWidth(PInteger(Src)^, FieldSize, PAnsiChar(Dst), True, IsBlobFieldToPadChar[TempFieldDef.IsBlob]);
ftDate, ftDateTime:
begin
@@ -1991,9 +1951,6 @@
// decode
DecodeDate(date, year, month, day);
// format is yyyymmdd
-// GetStrFromInt_Width(year, 4, PAnsiChar(Dst), '0');
-// GetStrFromInt_Width(month, 2, PAnsiChar(Dst)+4, '0');
-// GetStrFromInt_Width(day, 2, PAnsiChar(Dst)+6, '0');
IntToStrWidth(year, 4, PAnsiChar(Dst), True, DBF_ZERO);
IntToStrWidth(month, 2, PAnsiChar(Dst)+4, True, DBF_ZERO);
IntToStrWidth(day, 2, PAnsiChar(Dst)+6, True, DBF_ZERO);
@@ -2002,9 +1959,6 @@
begin
DecodeTime(date, hour, minute, sec, msec);
// format is hhmmss
-// GetStrFromInt_Width(hour, 2, PAnsiChar(Dst)+8, '0');
-// GetStrFromInt_Width(minute, 2, PAnsiChar(Dst)+10, '0');
-// GetStrFromInt_Width(sec, 2, PAnsiChar(Dst)+12, '0');
IntToStrWidth(hour, 2, PAnsiChar(Dst)+8, True, DBF_ZERO);
IntToStrWidth(minute, 2, PAnsiChar(Dst)+10, True, DBF_ZERO);
IntToStrWidth(sec, 2, PAnsiChar(Dst)+12, True, DBF_ZERO);
@@ -2075,13 +2029,6 @@
begin
if FAutoIncPresent then
begin
- // if shared, reread header to find new autoinc values
-// if NeedLocks then
-// begin
- // lock header so nobody else can use this value
-// LockPage(0, true);
-// end;
-
// find autoinc fields
for I := 0 to FFieldDefs.Count-1 do
begin
@@ -2109,10 +2056,6 @@
// write modified header (new autoinc values) to file
WriteHeader;
-
- // release lock if locked
-// if NeedLocks then
-// UnlockPage(0);
end;
end;
@@ -2615,11 +2558,9 @@
// the written index records and the
// change to the header have to be
// rolled back
-// LockPage(0, true);
ReadHeader;
Dec(PDbfHdr(Header)^.RecordCount);
WriteHeader;
-// UnlockPage(0);
// roll back indexes too
RollbackIndexesAndRaise(FIndexFiles.Count, ecWriteDbf);
end else
@@ -2900,7 +2841,6 @@
{$IFDEF WINAPI_IS_UNICODE}
TempCodePageList.Add(Pointer(StrToIntDef(string(CodePageString), -1))); // Avoid conversion to AnsiString
{$ELSE}
-//TempCodePageList.Add(Pointer(GetIntFromStrLength(CodePageString, dbfStrLen(CodePageString), -1)));
IntValue := 0;
if StrToInt32Width(IntValue, CodePageString, dbfStrLen(CodePageString), -1) then
TempCodePageList.Add({%H-}Pointer(IntValue));
Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas 2020-10-01 20:27:26 UTC (rev 703)
+++ trunk/src/dbf_idxfile.pas 2020-10-04 19:40:57 UTC (rev 704)
@@ -187,7 +187,6 @@
property IndexFile: TIndexFile read FIndexFile;
property UpperPage: TIndexPage read FUpperPage write SetUpperPage;
property LowerPage: TIndexPage read FLowerPage;
-// property LowerPageNo: Integer read GetLowerPageNo; // never used
property PageBuffer: Pointer read FPageBuffer;
property PageNo: Integer read FPageNo write SetPageNo;
property Weight: TSequentialRecNo read FWeight;
@@ -336,7 +335,6 @@
function GetDbfLanguageId: Byte;
function GetKeyLen: Integer;
function GetKeyType: AnsiChar;
-// function GetIndexCount Integer;
function GetExpression: string;
function GetPhysicalRecNo: Integer;
function GetSequentialRecNo: TSequentialRecNo;
@@ -425,7 +423,6 @@
property UpdateMode: TIndexUpdateMode read FUpdateMode write SetUpdateMode;
property IndexName: string read FIndexName write SetIndexName;
property Expression: string read GetExpression;
-// property Count: Integer read GetIndexCount;
property ForceClose: Boolean read FForceClose;
property ForceReadOnly: Boolean read FForceReadOnly;
@@ -559,7 +556,6 @@
sKeyType : Word; // 16..17 00h: DB4: C/N; DB3: C
// 01h: DB4: D ; DB3: N/D
KeyRecLen : Word; // 18..19 Length of key entry in page
-// Version : Word; // 20..21
Version : Byte; // 20
Dummy1 : Byte; // 21
Dummy2 : Byte; // 22
@@ -724,8 +720,6 @@
destructor TIndexPage.Destroy;
begin
- // no locks anymore?
-//assert(FLockCount = 0);
if (FLowerPage<>nil) then
LowerPage.Free;
WritePage;
@@ -735,7 +729,7 @@
procedure TIndexPage.Clear;
begin
- FillChar(PAnsiChar(FPageBuffer)^, FIndexFile.RecordSize, 0); // Was PChar
+ FillChar(PAnsiChar(FPageBuffer)^, FIndexFile.RecordSize, 0);
FreeAndNil(FLowerPage);
FUpperPage := nil;
FPageNo := -1;
@@ -747,7 +741,6 @@
FHighPage := 0;
FLowIndex := 0;
FHighIndex := -1;
-//FLockCount := 0;
end;
procedure TIndexPage.GetNewPage;
@@ -1111,10 +1104,7 @@
// get data of last entry on this page
paKeyData := GetKeyDataFromEntry(splitRight - 1);
- // reinsert ourself into parent
-// FUpperPage.RecurInsert(0, paKeyData, FPageNo);
- // we can do this via a localinsert now: we know there is at least one entry
- // free in this page and higher up
+ // we know there is at least one entry free in this page and higher up
FUpperPage.LocalInsert(0, paKeyData, FPageNo);
// new page is right page, so update parent to point to new right page
@@ -1261,8 +1251,6 @@
begin
// save changes
WritePage;
- // no locks
-// assert(FLockCount = 0);
// goto new page
FPageNo := NewPageNo;
@@ -1429,10 +1417,6 @@
function TMdxPage.GetLowerPageNo: Integer;
// *) assumes LowerPage <> nil
begin
-// if LowerPage = nil then
-// Result := 0
-// else
-// Result := SwapIntLE(PMdxEntry(Entry)^.RecBlockNo);
Result := Integer(SwapIntLE(DWORD(PMdxEntry(Entry)^.RecBlockNo)));
end;
@@ -1443,7 +1427,6 @@
function TMdxPage.GetNumEntries: Integer;
begin
-//Result := SwapWordLE(PMdxPage(PageBuffer)^.NumEntries);
Result:= Integer(SwapIntLE(DWORD(PMdxPage(PageBuffer)^.NumEntries)));
if (Result < 0) or (Result > SwapWordLE(PIndexHdr(FIndexFile.FIndexHeader)^.NumKeys)) then
begin
@@ -1459,7 +1442,6 @@
function TMdxPage.GetRecNo: Integer;
begin
-//Result := SwapIntLE(PMdxEntry(Entry)^.RecBlockNo);
Result := Integer(SwapIntLE(DWORD(PMdxEntry(Entry)^.RecBlockNo)));
end;
@@ -1512,10 +1494,7 @@
function TNdxPage.GetLowerPageNo: Integer;
// *) assumes LowerPage <> nil
begin
-// if LowerPage = nil then
-// Result := 0
-// else
- Result := SwapIntLE(PNdxEntry(Entry)^.LowerPageNo)
+ Result := SwapIntLE(PNdxEntry(Entry)^.LowerPageNo)
end;
function TNdxPage.GetRecNo: Integer;
@@ -1848,14 +1827,11 @@
// page offsets are not related to header length
PageOffsetByHeader := false;
- // we need physical page locks
-// VirtualLocks := false;
// not selected index expression => can't edit yet
FCanEdit := false;
FUserKey := nil;
FUserRecNo := -1;
-// FHeaderLocked := -1;
FHeaderPageNo := 0;
FForceClose := false;
FForceReadOnly := false;
@@ -2360,7 +2336,6 @@
PIndexHdr(FIndexHeader)^.sKeyType := 0;
end;
-//PIndexHdr(FIndexHeader)^.Version := SwapWordLE(2); // this is what DB4 writes into file
PIndexHdr(FIndexHeader)^.Version := 4; // this is what the BDE uses for the first version (SwapWordLE not needed, Version declared as Byte)
PIndexHdr(FIndexHeader)^.Dummy2 := 0;
PIndexHdr(FIndexHeader)^.Dummy3 := 0;
@@ -2517,8 +2492,6 @@
// ---*** numTags not valid from here ***---
// file header changed
WriteFileHeader;
- // repage index to free space used by deleted index
-// RepageFile;
end;
end;
end;
@@ -3030,19 +3003,7 @@
end;
function TIndexFile.GetNewPageNo: Integer;
-//var
-//needLockHeader: Boolean;
begin
- // update header -> lock it if not already locked
-//needLockHeader := FHeaderLocked <> 0;
-//if needLockHeader then
-//begin
- // lock header page
-// LockPage(0, true);
- // someone else could be inserting records at the same moment
-// if NeedLocks then
-// inherited ReadHeader;
-//end;
if FIndexVersion >= xBaseIV then
begin
Result := SwapIntLE(PMdxHdr(Header)^.NumPages);
@@ -3185,7 +3146,6 @@
IntSrc := PInteger(Buffer)^;
// handle zero differently: no decimals
if IntSrc <> 0 then
-// NumDecimals := GetStrFromInt(IntSrc, @FloatRec.Digits[0])
NumDecimals := IntToStrWidth(IntSrc, SizeOf(FloatRec.Digits), @FloatRec.Digits[0], False, #0)
else
NumDecimals := 0;
@@ -3196,7 +3156,6 @@
begin
Int64Src := PLargeInt(Buffer)^;
if Int64Src <> 0 then
-// NumDecimals := GetStrFromInt64(Int64Src, @FloatRec.Digits[0])
NumDecimals := IntToStrWidth(Int64Src, SizeOf(FloatRec.Digits), @FloatRec.Digits[0], False, #0)
else
NumDecimals := 0;
@@ -3206,7 +3165,6 @@
etFloat:
begin
ExtValue := PDouble(Buffer)^;
-// FloatToDecimal(FloatRec, ExtValue, {$ifndef FPC_VERSION}fvExtended,{$endif} 999, 15);
FloatToDecimal(FloatRec, ExtValue, {$ifndef FPC_VERSION}fvExtended,{$endif} 15, 9999);
if ExtValue <> 0.0 then
NumDecimals := dbfStrLen(PAnsiChar(@FloatRec.Digits[0]))
@@ -3284,10 +3242,8 @@
end
else
begin
-// KeyBuffer := FCurrentParser.ExtractFromBuffer(Buffer);
IsNull := False;
KeyBuffer := FCurrentParser.ExtractFromBuffer(PAnsiChar(Buffer), RecNo, IsNull);
-// if (KeyType = 'D') and (FCurrentParser.ExtractIsNull(Buffer)) then
if (KeyType = 'D') and IsNull then
PDouble(KeyBuffer)^ := 1E100;
Result := PAnsiChar(PrepareKey(TDbfRecordBuffer(KeyBuffer), FCurrentParser.ResultType));
@@ -3645,8 +3601,6 @@
numEntries, numKeysAvail, done, searchRecNo: Integer;
begin
// reread index header (to discover whether root page changed)
-//if NeedLocks then
-// ResyncRoot;
// if distinct or unique index -> every entry only occurs once ->
// does not matter which recno we search -> search recno = -2 ->
// extra info = recno
@@ -4471,10 +4425,8 @@
FHeaderPageNo := FMdxTag.HeaderPageNo;
end;
// does dBase actually use this flag?
-// FIsExpression := FMdxTag.KeyFormat = KeyFormat_Expression;
end else begin
// how does dBase III store whether it is expression?
-// FIsExpression := true;
end;
// retrieve properties
UpdateIndexProperties;
@@ -4538,21 +4490,6 @@
inherited;
end;
-(*
-
-function TIndexFile.GetIndexCount: Integer;
-begin
- if FIndexVersion = xBaseIII then
- Result := 1
- else
- if FIndexVersion = xBaseIV then
- Result := PMdxHdr(Header).TagsUsed;
- else
- Result := 0;
-end;
-
-*)
-
procedure TIndexFile.GetIndexNames(const AList: TStrings);
var
I: Integer;
Modified: trunk/src/dbf_memo.pas
===================================================================
--- trunk/src/dbf_memo.pas 2020-10-01 20:27:26 UTC (rev 703)
+++ trunk/src/dbf_memo.pas 2020-10-04 19:40:57 UTC (rev 704)
@@ -292,23 +292,8 @@
end;
// write to stream
DestStream.Write(FBuffer[0], numBytes);
-{
- for i := 0 to RecordSize-2 do
- begin
- if (FBuffer[i]=#$1A) and (FBuffer[i+1]=#$1A) then
- begin
- if i>0 then
- DestStream.Write(FBuffer[0], i);
- done := true;
- break;
- end;
- end;
-}
if not done then
begin
-{
- DestStream.Write(FBuffer[0], 512);
-}
lastc := FBuffer[RecordSize-1];
inc(BlockNo);
if ReadRecord(BlockNo, @FBuffer[0]) > 0 then
@@ -349,8 +334,6 @@
bytesBefore := 0;
bytesAfter := 2;
end;
-// if ((bytesBefore + Src.Size + bytesAfter + PDbtHdr(Header).BlockLen-1) div PDbtHdr(Header).BlockLen)
-// <= ((ReadSize + PDbtHdr(Header).BlockLen-1) div PDbtHdr(Header).BlockLen) then
if ((bytesBefore + Src.Size + bytesAfter + RecordSize-1) div RecordSize)
<= ((ReadSize + RecordSize-1) div RecordSize) then
begin
Modified: trunk/src/dbf_pgfile.pas
===================================================================
--- trunk/src/dbf_pgfile.pas 2020-10-01 20:27:26 UTC (rev 703)
+++ trunk/src/dbf_pgfile.pas 2020-10-04 19:40:57 UTC (rev 704)
@@ -9,9 +9,6 @@
SysUtils,
dbf_common;
-//const
-// MaxHeaders = 256;
-
type
EPagedFile = class(Exception)
end;
@@ -481,12 +478,6 @@
// record outside buffer, flush previous buffer
FlushBuffer;
// read new set of records
-//FBufferPage := IntRecNum;
-//FBufferOffset := CalcPageOffset(IntRecNum);
-//if FBufferOffset + FBufferMaxSize > FCachedSize then
-// FBufferReadSize := FCachedSize - FBufferOffset
-//else
-// FBufferReadSize := FBufferMaxSize;
if (FBufferPage >= 0) and ((IntRecNum < Pred(FBufferPage)) or (IntRecNum > FBufferPage + (FBufferSize div PageSize))) then // 10/28/2011 pb CR 19176
FBufferReadSize := RecordSize
else
@@ -510,8 +501,6 @@
if FBufferOffset + FBufferReadSize > FCachedSize then
FBufferReadSize := FCachedSize - FBufferOffset;
FBufferSize := FBufferReadSize;
-//if FBufferReadSize <> 0 then
-// FBufferReadSize := ReadBlock(FBufferPtr, FBufferReadSize, FBufferOffset);
ReadBuffer;
end;
@@ -539,7 +528,6 @@
begin
Offset := (TPagedFileOffset(IntRecNum) - FBufferPage) * PageSize;
if (FBufferPage <> -1) and (FBufferPage <= IntRecNum) and
-// (Offset+RecordSize <= FBufferReadSize) then
(Offset + RecordSize <= FBufferSize) then
begin
// have record in buffer, nothing to do here
@@ -573,7 +561,6 @@
begin
RecEnd := (TPagedFileOffset(IntRecNum) - FBufferPage + PagesPerRecord) * PageSize;
if (FBufferPage <> -1) and (FBufferPage <= IntRecNum) and
-// (RecEnd <= FBufferMaxSize) then
(RecEnd <= FBufferMaxSize) and (RecEnd <= TPagedFileOffset(FBufferSize) + RecordSize) then
begin
// extend buffer?
@@ -627,7 +614,6 @@
begin
FBufferMaxSize := 65536;
if RecordSize <> 0 then
-// Dec(FBufferMaxSize, FBufferMaxSize mod PageSize);
Dec(FBufferMaxSize, FBufferMaxSize mod RecordSize);
if FBufferMaxSize < RecordSize then
FBufferMaxSize := RecordSize;
@@ -852,7 +838,6 @@
FCachedSize := FHeaderSize + TPagedFileOffset(FHeaderOffset) + (TPagedFileOffset(FPageSize) * NewValue)
else
FCachedSize := TPagedFileOffset(FPageSize) * NewValue;
-// FCachedSize := CalcPageOffset(NewValue);
FRecordCount := NewValue;
FStream.Size := FCachedSize;
end;
@@ -984,8 +969,6 @@
begin
if FVirtualLocks then
begin
-// Offset := LockStart;
-// Length := LockOffset - LockStart + FileLockSize;
{$ifdef SUPPORT_UINT32_CARDINAL}
Offset := LockOffset;
Length := FileLockSize;
@@ -992,8 +975,6 @@
{$else}
// delphi 3 has strange types:
// cardinal 0..2 GIG ?? does it produce correct code?
-// Offset := Cardinal(LockStart);
-// Length := Cardinal(LockOffset) - Cardinal(LockStart) + FileLockSize;
Offset := Cardinal(LockOffset);
Length := Cardinal(FileLockSize);
{$endif}
@@ -1027,15 +1008,11 @@
if FVirtualLocks then
begin
{$ifdef SUPPORT_UINT32_CARDINAL}
-// Offset := LockStart;
-// Length := LockOffset - LockStart + FileLockSize;
Offset := LockOffset;
Length := FileLockSize;
{$else}
// delphi 3 has strange types:
// cardinal 0..2 GIG ?? does it produce correct code?
-// Offset := Cardinal(LockStart);
-// Length := Cardinal(LockOffset) - Cardinal(LockStart) + FileLockSize;
Offset := Cardinal(LockOffset);
Length := Cardinal(FileLockSize);
{$endif}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2021-06-01 14:45:14
|
Revision: 770
http://sourceforge.net/p/tdbf/code/770
Author: paulenandrew
Date: 2021-06-01 14:45:13 +0000 (Tue, 01 Jun 2021)
Log Message:
-----------
Remove unnecessary `AUniqueMode` parameters
The parameters were first added in revision 405, but
`FUniqueMode` can always be used.
Revision Links:
--------------
http://sourceforge.net/p/tdbf/code/405
Modified Paths:
--------------
trunk/src/dbf_dbffile.pas
trunk/src/dbf_idxcur.pas
trunk/src/dbf_idxfile.pas
Modified: trunk/src/dbf_dbffile.pas
===================================================================
--- trunk/src/dbf_dbffile.pas 2021-06-01 14:43:55 UTC (rev 769)
+++ trunk/src/dbf_dbffile.pas 2021-06-01 14:45:13 UTC (rev 770)
@@ -2304,7 +2304,7 @@
while cur <= last do
begin
ReadRecord(cur, FPrevBuffer);
- if not lIndexFile.Insert(cur, FPrevBuffer, lIndexFile.UniqueMode) then
+ if not lIndexFile.Insert(cur, FPrevBuffer) then
lIndexFile.InsertError;
DoProgress(cur, last, STRING_PROGRESS_READINGRECORDS);
inc(cur);
@@ -2528,7 +2528,7 @@
while I < FIndexFiles.Count do
begin
lIndex := TIndexFile(FIndexFiles.Items[I]);
- if not lIndex.Insert(newRecord, Buffer, lIndex.UniqueMode) then
+ if not lIndex.Insert(newRecord, Buffer) then
error := ecInsert;
if lIndex.WriteError then
error := ecWriteIndex;
Modified: trunk/src/dbf_idxcur.pas
===================================================================
--- trunk/src/dbf_idxcur.pas 2021-06-01 14:43:55 UTC (rev 769)
+++ trunk/src/dbf_idxcur.pas 2021-06-01 14:45:13 UTC (rev 770)
@@ -36,7 +36,7 @@
procedure First; override;
procedure Last; override;
- procedure Insert(RecNo: Integer; Buffer: PAnsiChar; AUniqueMode: TIndexUniqueType);
+ procedure Insert(RecNo: Integer; Buffer: PAnsiChar);
procedure Update(RecNo: Integer; PrevBuffer, NewBuffer: PAnsiChar);
{$ifdef SUPPORT_VARIANTS}
@@ -73,9 +73,9 @@
inherited Destroy;
end;
-procedure TIndexCursor.Insert(RecNo: Integer; Buffer: PAnsiChar; AUniqueMode: TIndexUniqueType);
+procedure TIndexCursor.Insert(RecNo: Integer; Buffer: PAnsiChar);
begin
- TIndexFile(PagedFile).Insert(RecNo, {$IFDEF SUPPORT_TRECORDBUFFER}PByte{$ENDIF}(Buffer), AUniqueMode);
+ TIndexFile(PagedFile).Insert(RecNo, {$IFDEF SUPPORT_TRECORDBUFFER}PByte{$ENDIF}(Buffer));
// TODO SET RecNo and Key
end;
Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas 2021-06-01 14:43:55 UTC (rev 769)
+++ trunk/src/dbf_idxfile.pas 2021-06-01 14:45:13 UTC (rev 770)
@@ -295,9 +295,9 @@
procedure LinkTags;
function FindKey(AInsert: boolean): Integer;
- function InsertKey(Buffer: TDbfRecordBuffer; RecNo: Integer; AUniqueMode: TIndexUniqueType): Boolean;
+ function InsertKey(Buffer: TDbfRecordBuffer; RecNo: Integer): Boolean;
procedure DeleteKey(Buffer: TDbfRecordBuffer; RecNo: Integer);
- function InsertCurrent(AUniqueMode: TIndexUniqueType): Boolean;
+ function InsertCurrent: Boolean;
function DeleteCurrent: Boolean;
function UpdateCurrent(PrevBuffer, NewBuffer: TDbfRecordBuffer; RecNo: Integer): Boolean;
function UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: TDbfRecordBuffer; RecNo: Integer): Boolean;
@@ -364,7 +364,7 @@
procedure ClearIndex;
procedure AddNewLevel;
procedure InsertError;
- function Insert(RecNo: Integer; Buffer: TDbfRecordBuffer; AUniqueMode: TIndexUniqueType): Boolean;
+ function Insert(RecNo: Integer; Buffer: TDbfRecordBuffer): Boolean;
function Update(RecNo: Integer; PrevBuffer, NewBuffer: TDbfRecordBuffer): Boolean;
procedure Delete(RecNo: Integer; Buffer: TDbfRecordBuffer);
function CheckKeyViolation(Buffer: TDbfRecordBuffer; RecNo: Integer): Boolean;
@@ -3153,7 +3153,7 @@
begin
FUserRecNo := PEntry^.RecBlockNo;
FUserKey := @PEntry^.KeyData;
- if not InsertCurrent(FUniqueMode) then
+ if not InsertCurrent then
InsertError;
end;
Inc(PAnsiChar(PPEntry), SizeOf(Pointer));
@@ -3247,7 +3247,7 @@
WriteHeader;
end;
-function TIndexFile.Insert(RecNo: Integer; Buffer: TDbfRecordBuffer; AUniqueMode: TIndexUniqueType): Boolean; {override;}
+function TIndexFile.Insert(RecNo: Integer; Buffer: TDbfRecordBuffer): Boolean; {override;}
var
I, curSel, count: Integer;
begin
@@ -3265,7 +3265,7 @@
while I < count do
begin
SelectIndexVars(I);
- Result := InsertKey(Buffer, RecNo, AUniqueMode);
+ Result := InsertKey(Buffer, RecNo);
if not Result then
begin
while I > 0 do
@@ -3281,7 +3281,7 @@
// restore previous selected index
SelectIndexVars(curSel);
end else begin
- Result := InsertKey(Buffer, RecNo, AUniqueMode);
+ Result := InsertKey(Buffer, RecNo);
end;
// check range, disabled by insert
@@ -3502,7 +3502,7 @@
ExprTrailingNulsToSpace(Dest, Result);
end;
-function TIndexFile.InsertKey(Buffer: {$IFDEF SUPPORT_TRECORDBUFFER}PByte{$ELSE}PAnsiChar{$ENDIF}; RecNo: Integer; AUniqueMode: TIndexUniqueType): boolean;
+function TIndexFile.InsertKey(Buffer: {$IFDEF SUPPORT_TRECORDBUFFER}PByte{$ELSE}PAnsiChar{$ENDIF}; RecNo: Integer): boolean;
begin
Result := true;
// ignore deleted records
@@ -3514,11 +3514,11 @@
// get key from buffer
FUserKey := ExtractKeyFromBuffer(Buffer, RecNo);
// patch through
- Result := InsertCurrent(AUniqueMode);
+ Result := InsertCurrent;
end;
end;
-function TIndexFile.InsertCurrent(AUniqueMode: TIndexUniqueType): boolean;
+function TIndexFile.InsertCurrent: boolean;
// insert in current index
// assumes: FUserKey is an OEM key
begin
@@ -3525,7 +3525,7 @@
// only insert if not recalling or mode = distinct
// modify = mmDeleteRecall /\ unique <> distinct -> key already present
Result := true;
- if (FModifyMode <> mmDeleteRecall) or (AUniqueMode = iuDistinct) then
+ if (FModifyMode <> mmDeleteRecall) or (FUniqueMode = iuDistinct) then
begin
// temporarily remove range to find correct location of key
ResetRange;
@@ -3532,7 +3532,7 @@
// find this record as closely as possible
// if result = 0 then key already exists
// if unique index, then don't insert key if already present
- if (FindKey(true) <> 0) or (AUniqueMode = iuNormal) then
+ if (FindKey(true) <> 0) or (FUniqueMode = iuNormal) then
begin
// if we found eof, write to pagebuffer
Leaf.GotoInsertEntry;
@@ -3540,7 +3540,7 @@
Leaf.LocalInsert(FUserRecNo, FUserKey, 0);
end else begin
// key already exists -> test possible key violation
- if AUniqueMode = iuDistinct then
+ if FUniqueMode = iuDistinct then
begin
// raising -> reset modify mode
FModifyMode := mmNormal;
@@ -3724,11 +3724,11 @@
if Result then
begin
FUserKey := InsertKey;
- Result := InsertCurrent(FUniqueMode);
+ Result := InsertCurrent;
if not Result then
begin
FUserKey := DeleteKey;
- InsertCurrent(iuNormal);
+ InsertCurrent;
FUserKey := InsertKey;
end;
end;
@@ -3922,7 +3922,7 @@
begin
// are we distinct -> then reinsert record in index
FModifyMode := mmDeleteRecall;
- Result := Insert(RecNo, Buffer, FUniqueMode);
+ Result := Insert(RecNo, Buffer);
FModifyMode := mmNormal;
end;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2021-06-01 14:53:01
|
Revision: 772
http://sourceforge.net/p/tdbf/code/772
Author: paulenandrew
Date: 2021-06-01 14:52:55 +0000 (Tue, 01 Jun 2021)
Log Message:
-----------
Do not update data/index after delete/undelete until post
Undelete prematurely updates data and inserts an index entry before
post. Defer all decisions until post.
Modified Paths:
--------------
trunk/src/dbf.pas
trunk/src/dbf_dbffile.pas
trunk/src/dbf_idxfile.pas
Modified: trunk/src/dbf.pas
===================================================================
--- trunk/src/dbf.pas 2021-06-01 14:51:37 UTC (rev 771)
+++ trunk/src/dbf.pas 2021-06-01 14:52:55 UTC (rev 772)
@@ -1088,8 +1088,6 @@
lRecord := pDbfRecord(ActiveBuffer);
// flag we deleted this record
lRecord^.DeletedFlag := '*';
- // notify indexes this record is deleted
- FDbfFile.RecordDeleted(FEditingRecNo, @lRecord^.DeletedFlag);
// done!
InternalPost;
end;
@@ -3145,11 +3143,9 @@
begin
if srcptr^ = '*' then
begin
- // notify indexes record is about to be recalled
- FDbfFile.RecordRecalled(FCursor.PhysicalRecNo, src);
// recall record
srcptr^ := ' ';
- FDbfFile.WriteRecord(FCursor.PhysicalRecNo, src);
+ SetModified(True);
end;
end;
end;
Modified: trunk/src/dbf_dbffile.pas
===================================================================
--- trunk/src/dbf_dbffile.pas 2021-06-01 14:51:37 UTC (rev 771)
+++ trunk/src/dbf_dbffile.pas 2021-06-01 14:52:55 UTC (rev 772)
@@ -126,8 +126,6 @@
procedure RegenerateIndexes;
procedure LockRecord(RecNo: Integer; Buffer: TDbfRecordBuffer; Resync: Boolean);
procedure UnlockRecord(RecNo: Integer; Buffer: TDbfRecordBuffer);
- procedure RecordDeleted(RecNo: Integer; Buffer: TDbfRecordBuffer);
- procedure RecordRecalled(RecNo: Integer; Buffer: TDbfRecordBuffer);
procedure DeleteIndexFile(AIndexFile: TIndexFile);
procedure Flush; override;
@@ -2716,43 +2714,6 @@
UnlockPage(RecNo);
end;
-procedure TDbfFile.RecordDeleted(RecNo: Integer; Buffer: TDbfRecordBuffer);
-var
- I: Integer;
- lIndex: TIndexFile;
-begin
- // notify indexes: record deleted
- for I := 0 to FIndexFiles.Count - 1 do
- begin
- lIndex := TIndexFile(FIndexFiles.Items[I]);
- lIndex.RecordDeleted(RecNo, Buffer);
- end;
-end;
-
-procedure TDbfFile.RecordRecalled(RecNo: Integer; Buffer: TDbfRecordBuffer);
-var
- I: Integer;
- lIndex, lErrorIndex: TIndexFile;
-begin
- // notify indexes: record recalled
- I := 0;
- while I < FIndexFiles.Count do
- begin
- lIndex := TIndexFile(FIndexFiles.Items[I]);
- if not lIndex.RecordRecalled(RecNo, Buffer) then
- begin
- lErrorIndex := lIndex;
- while I > 0 do
- begin
- Dec(I);
- lIndex.RecordDeleted(RecNo, Buffer);
- end;
- lErrorIndex.InsertError;
- end;
- Inc(I);
- end;
-end;
-
procedure TDbfFile.DeleteIndexFile(AIndexFile: TIndexFile);
var
Index: Integer;
Modified: trunk/src/dbf_idxfile.pas
===================================================================
--- trunk/src/dbf_idxfile.pas 2021-06-01 14:51:37 UTC (rev 771)
+++ trunk/src/dbf_idxfile.pas 2021-06-01 14:52:55 UTC (rev 772)
@@ -53,7 +53,6 @@
TLocaleError = (leNone, leUnknown, leTableIndexMismatch, leNotAvailable);
TLocaleSolution = (lsNotOpen, lsNoEdit, lsBinary);
TIndexUniqueType = (iuNormal, iuUnique, iuDistinct);
- TIndexModifyMode = (mmNormal, mmDeleteRecall);
TDbfLocaleErrorEvent = procedure(var Error: TLocaleError; var Solution: TLocaleSolution) of object;
TDbfCompareKeysEvent = function(Key1, Key2: PAnsiChar): Integer of object;
@@ -256,7 +255,6 @@
FRangeIndex: Integer;
FIsDescending: Boolean;
FUniqueMode: TIndexUniqueType;
- FModifyMode: TIndexModifyMode;
FKeyBuffer: array[0..MaxIndexKeyLen] of AnsiChar;
FLowBuffer: array[0..MaxIndexKeyLen] of AnsiChar;
FHighBuffer: array[0..MaxIndexKeyLen] of AnsiChar;
@@ -368,8 +366,6 @@
function Update(RecNo: Integer; PrevBuffer, NewBuffer: TDbfRecordBuffer): Boolean;
procedure Delete(RecNo: Integer; Buffer: TDbfRecordBuffer);
function CheckKeyViolation(Buffer: TDbfRecordBuffer; RecNo: Integer): Boolean;
- procedure RecordDeleted({%H-}RecNo: Integer; {%H-}Buffer: TDbfRecordBuffer);
- function RecordRecalled({%H-}RecNo: Integer; {%H-}Buffer: TDbfRecordBuffer): Boolean;
procedure DeleteIndex(const AIndexName: string);
procedure RepageFile;
procedure CompactFile;
@@ -2053,7 +2049,6 @@
FOpened := false;
FRangeActive := false;
FUpdateMode := umCurrent;
- FModifyMode := mmNormal;
FTempMode := TDbfFile(ADbfFile).TempMode;
FRangeIndex := -1;
SelectIndexVars(-1);
@@ -3505,16 +3500,17 @@
function TIndexFile.InsertKey(Buffer: {$IFDEF SUPPORT_TRECORDBUFFER}PByte{$ELSE}PAnsiChar{$ENDIF}; RecNo: Integer): boolean;
begin
Result := true;
- // ignore deleted records
- if (FModifyMode = mmNormal) and (not RecordIsIndexed(Buffer)) then
- exit;
- // check proper index and modifiability
- if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
+ // check record is indexed
+ if RecordIsIndexed(Buffer) then
begin
- // get key from buffer
- FUserKey := ExtractKeyFromBuffer(Buffer, RecNo);
- // patch through
- Result := InsertCurrent;
+ // check proper index and modifiability
+ if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
+ begin
+ // get key from buffer
+ FUserKey := ExtractKeyFromBuffer(Buffer, RecNo);
+ // patch through
+ Result := InsertCurrent;
+ end;
end;
end;
@@ -3522,31 +3518,24 @@
// insert in current index
// assumes: FUserKey is an OEM key
begin
- // only insert if not recalling or mode = distinct
- // modify = mmDeleteRecall /\ unique <> distinct -> key already present
Result := true;
- if (FModifyMode <> mmDeleteRecall) or (FUniqueMode = iuDistinct) then
+ // temporarily remove range to find correct location of key
+ ResetRange;
+ // find this record as closely as possible
+ // if result = 0 then key already exists
+ // if unique index, then don't insert key if already present
+ if (FindKey(true) <> 0) or (FUniqueMode = iuNormal) then
begin
- // temporarily remove range to find correct location of key
- ResetRange;
- // find this record as closely as possible
- // if result = 0 then key already exists
- // if unique index, then don't insert key if already present
- if (FindKey(true) <> 0) or (FUniqueMode = iuNormal) then
+ // if we found eof, write to pagebuffer
+ Leaf.GotoInsertEntry;
+ // insert requested entry, we know there is an entry available
+ Leaf.LocalInsert(FUserRecNo, FUserKey, 0);
+ end else begin
+ // key already exists -> test possible key violation
+ if FUniqueMode = iuDistinct then
begin
- // if we found eof, write to pagebuffer
- Leaf.GotoInsertEntry;
- // insert requested entry, we know there is an entry available
- Leaf.LocalInsert(FUserRecNo, FUserKey, 0);
- end else begin
- // key already exists -> test possible key violation
- if FUniqueMode = iuDistinct then
- begin
- // raising -> reset modify mode
- FModifyMode := mmNormal;
- ConstructInsertErrorMsg;
- Result := false;
- end;
+ ConstructInsertErrorMsg;
+ Result := false;
end;
end;
end;
@@ -3624,25 +3613,20 @@
// deletes from current index
begin
Result := True;
- // only delete if not delete record or mode = distinct
- // modify = mmDeleteRecall /\ unique = distinct -> key needs to be deleted from index
- if (FModifyMode <> mmDeleteRecall) or (FUniqueMode = iuDistinct) then
+ // prevent "confined" view of index while deleting
+ ResetRange;
+ // search correct entry to delete
+ if Leaf.PhysicalRecNo <> FUserRecNo then
begin
- // prevent "confined" view of index while deleting
- ResetRange;
- // search correct entry to delete
- if Leaf.PhysicalRecNo <> FUserRecNo then
- begin
- Result := FindKey(false) = 0;
- if not Result then
- Result := Leaf.PhysicalRecNo = FUserRecNo;
- end;
- // delete selected entry
- if Result then
- Leaf.Delete
- else
- CheckInvalidError;
+ Result := FindKey(false) = 0;
+ if not Result then
+ Result := Leaf.PhysicalRecNo = FUserRecNo;
end;
+ // delete selected entry
+ if Result then
+ Leaf.Delete
+ else
+ CheckInvalidError;
end;
function TIndexFile.UpdateIndex(Index: Integer; PrevBuffer, NewBuffer: TdbfRecordBuffer; RecNo: Integer): Boolean;
@@ -3700,40 +3684,49 @@
function TIndexFile.UpdateCurrent(PrevBuffer, NewBuffer: TdbfRecordBuffer; RecNo: Integer): boolean;
var
- InsertKey, DeleteKey: PAnsiChar;
+ NewKey: PAnsiChar;
+ PrevKey: PAnsiChar;
TempBuffer: array [0..MaxIndexKeyLen] of AnsiChar;
begin
Result := true;
- if not RecordIsIndexed(PrevBuffer) then
- Exit;
- if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
+ // check record is indexed
+ if RecordIsIndexed(PrevBuffer) or RecordIsIndexed(NewBuffer) then
begin
- DeleteKey := ExtractKeyFromBuffer(PrevBuffer, RecNo);
- FillChar(TempBuffer{%H-}, SizeOf(TempBuffer), 0);
- Move(DeleteKey^, TempBuffer, SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen));
- DeleteKey := @TempBuffer[0];
- InsertKey := ExtractKeyFromBuffer(NewBuffer, RecNo);
+ if FCanEdit and (PIndexHdr(FIndexHeader)^.KeyLen <> 0) then
+ begin
+ PrevKey := ExtractKeyFromBuffer(PrevBuffer, RecNo);
+ FillChar(TempBuffer{%H-}, SizeOf(TempBuffer), 0);
+ Move(PrevKey^, TempBuffer, SwapWordLE(PIndexHdr(FIndexHeader)^.KeyLen));
+ PrevKey := @TempBuffer[0];
+ NewKey := ExtractKeyFromBuffer(NewBuffer, RecNo);
- // compare to see if anything changed
- if CompareKeys(DeleteKey, InsertKey) <> 0 then
- begin
- LockIndex;
- try
- FUserKey := DeleteKey;
- Result := DeleteCurrent;
- if Result then
- begin
- FUserKey := InsertKey;
- Result := InsertCurrent;
- if not Result then
+ // compare to see if anything changed
+ if (CompareKeys(PrevKey, NewKey) <> 0) or
+ (RecordIsIndexed(PrevBuffer) <> RecordIsIndexed(NewBuffer)) then
+ begin
+ LockIndex;
+ try
+ if RecordIsIndexed(PrevBuffer) then
begin
- FUserKey := DeleteKey;
- InsertCurrent;
- FUserKey := InsertKey;
+ FUserKey := PrevKey;
+ Result := DeleteCurrent;
+ end
+ else
+ Result := True;
+ if Result and RecordIsIndexed(NewBuffer) then
+ begin
+ FUserKey := NewKey;
+ Result := InsertCurrent;
+ if (not Result) and RecordIsIndexed(PrevBuffer) then
+ begin
+ FUserKey := PrevKey;
+ InsertCurrent;
+ FUserKey := NewKey;
+ end;
end;
+ finally
+ UnlockIndex;
end;
- finally
- UnlockIndex;
end;
end;
end;
@@ -3910,22 +3903,6 @@
ResyncRange(true);
end;
-procedure TIndexFile.RecordDeleted(RecNo: Integer; Buffer: TdbfRecordBuffer);
-begin
- // are we distinct -> then delete record from index
- FModifyMode := mmDeleteRecall;
- Delete(RecNo, Buffer);
- FModifyMode := mmNormal;
-end;
-
-function TIndexFile.RecordRecalled(RecNo: Integer; Buffer: TdbfRecordBuffer): Boolean;
-begin
- // are we distinct -> then reinsert record in index
- FModifyMode := mmDeleteRecall;
- Result := Insert(RecNo, Buffer);
- FModifyMode := mmNormal;
-end;
-
procedure TIndexFile.SetPhysicalRecNo(RecNo: Integer);
begin
// check if already at specified recno
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2022-08-03 17:31:11
|
Revision: 824
http://sourceforge.net/p/tdbf/code/824
Author: paulenandrew
Date: 2022-08-03 17:31:09 +0000 (Wed, 03 Aug 2022)
Log Message:
-----------
Use initial Auto Increment value of 1
An initial Auto Increment value of 1, rather than 0, is correct
according to the documentation.
Modified Paths:
--------------
trunk/src/dbf_dbffile.pas
trunk/src/dbf_fields.pas
Modified: trunk/src/dbf_dbffile.pas
===================================================================
--- trunk/src/dbf_dbffile.pas 2022-08-03 17:30:22 UTC (rev 823)
+++ trunk/src/dbf_dbffile.pas 2022-08-03 17:31:09 UTC (rev 824)
@@ -660,7 +660,6 @@
begin
Assign(lFieldDef);
Offset := lFieldOffset;
- AutoInc := 0;
end;
// save field props
Modified: trunk/src/dbf_fields.pas
===================================================================
--- trunk/src/dbf_fields.pas 2022-08-03 17:30:22 UTC (rev 823)
+++ trunk/src/dbf_fields.pas 2022-08-03 17:31:09 UTC (rev 824)
@@ -35,6 +35,7 @@
FIsLockField: Boolean;
FNullPosition: integer;
+ function GetAutoInc: Cardinal;
function GetDbfVersion: TXBaseVersion;
procedure SetNativeFieldType(lFieldType: TDbfFieldType);
procedure SetFieldType(lFieldType: TFieldType);
@@ -67,7 +68,7 @@
property HasMin: Boolean read FHasMin write FHasMin;
property HasMax: Boolean read FHasMax write FHasMax;
property Offset: Integer read FOffset write FOffset;
- property AutoInc: Cardinal read FAutoInc write FAutoInc;
+ property AutoInc: Cardinal read GetAutoInc write FAutoInc;
property IsLockField: Boolean read FIsLockField write FIsLockField;
property CopyFrom: Integer read FCopyFrom write FCopyFrom;
published
@@ -198,6 +199,7 @@
FHasMin := false;
FHasMax := false;
FNullPosition := -1;
+ FAutoInc := 1;
end;
destructor TDbfFieldDef.Destroy; {override}
@@ -266,7 +268,6 @@
FHasMin := false;
FHasMax := false;
FOffset := 0;
- FAutoInc := 0;
end;
procedure TDbfFieldDef.AssignTo(Dest: TPersistent);
@@ -295,6 +296,14 @@
inherited AssignTo(Dest);
end;
+function TDbfFieldDef.GetAutoInc: Cardinal;
+begin
+ if FNativeFieldType = '+' then
+ Result := FAutoInc
+ else
+ Result := 0;
+end;
+
function TDbfFieldDef.GetDbfVersion: TXBaseVersion;
begin
Result := TDbfFieldDefs(Collection).DbfVersion;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2024-07-09 20:45:29
|
Revision: 850
http://sourceforge.net/p/tdbf/code/850
Author: paulenandrew
Date: 2024-07-09 20:45:27 +0000 (Tue, 09 Jul 2024)
Log Message:
-----------
Support NULL datetime constant
Modified Paths:
--------------
trunk/src/dbf_prscore.pas
trunk/src/dbf_prsdef.pas
Modified: trunk/src/dbf_prscore.pas
===================================================================
--- trunk/src/dbf_prscore.pas 2024-07-09 20:44:16 UTC (rev 849)
+++ trunk/src/dbf_prscore.pas 2024-07-09 20:45:27 UTC (rev 850)
@@ -505,6 +505,7 @@
procedure TCustomExpressionParser.RemoveConstants(var ExprRec: PExpressionRec);
var
I: Integer;
+ ConstantIsNull: Boolean;
begin
if not ResultCanVary(ExprRec) then
begin
@@ -518,6 +519,7 @@
try
// compute result
EvaluateCurrent;
+ ConstantIsNull := ExprRec^.IsNullPtr^;
// make new record to store constant in
ExprRec := MakeRec;
@@ -533,7 +535,14 @@
etLargeInt:ExprWord := TLargeIntConstant.Create(PInt64(FExpResult)^);
{$endif}
etString: ExprWord := TStringConstant.Create(string(FExpResult)); // Added string cast
- etDateTime: ExprWord := TDateTimeConstant.Create(EmptyStr, PDateTime(FExpResult)^);
+ etDateTime:
+ begin
+ if ConstantIsNull then
+ ExprWord := TDateTimeConstant.Create(EmptyStr)
+ else
+ ExprWord := TDateTimeConstant.Create(EmptyStr,
+ PDateTime(FExpResult)^);
+ end;
end;
// fill in structure
Modified: trunk/src/dbf_prsdef.pas
===================================================================
--- trunk/src/dbf_prsdef.pas 2024-07-09 20:44:16 UTC (rev 849)
+++ trunk/src/dbf_prsdef.pas 2024-07-09 20:45:27 UTC (rev 850)
@@ -115,9 +115,9 @@
private
FName: string;
FExprFunc: TExprFunc;
- FIsNull: Boolean;
FIsNullPtr: PBoolean;
protected
+ FIsNull: Boolean;
FRefCount: Integer;
function GetIsOperator: Boolean; virtual;
@@ -254,7 +254,8 @@
private
FValue: TDateTime;
public
- constructor Create(AName: string; AValue: TDateTime);
+ constructor Create(AName: string; AValue: TDateTime); overload;
+ constructor Create(AName: string); overload;
function AsPointer: PAnsiChar; override;
property Value: TDateTime read FValue write FValue;
end;
@@ -786,6 +787,12 @@
FValue := AValue;
end;
+constructor TDateTimeConstant.Create(AName: string);
+begin
+ Create(AName, 0);
+ FIsNull := True;
+end;
+
function TDateTimeConstant.AsPointer: PAnsiChar;
begin
Result := PAnsiChar(@FValue);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <pau...@us...> - 2025-01-22 15:39:02
|
Revision: 859
http://sourceforge.net/p/tdbf/code/859
Author: paulenandrew
Date: 2025-01-22 15:38:58 +0000 (Wed, 22 Jan 2025)
Log Message:
-----------
Fix bookmarks in Delphi 2009 and higher
Modified Paths:
--------------
trunk/src/dbf.pas
trunk/src/dbf_common.inc
trunk/src/dbf_common.pas
Added Paths:
-----------
trunk/src/__history/
Modified: trunk/src/dbf.pas
===================================================================
--- trunk/src/dbf.pas 2024-08-06 20:46:30 UTC (rev 858)
+++ trunk/src/dbf.pas 2025-01-22 15:38:58 UTC (rev 859)
@@ -253,7 +253,7 @@
function AllocRecordBuffer: TDbfRecordBuffer; override; {virtual abstract}
procedure ClearCalcFields(Buffer: TDbfRecordBuffer); override;
procedure FreeRecordBuffer(var Buffer: TDbfRecordBuffer); override; {virtual abstract}
- procedure GetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); override; {virtual abstract}
+ procedure GetBookmarkData(Buffer: TDbfRecBuf; Data: TDbfBookmark); override; {virtual abstract}
function GetBookmarkFlag(Buffer: TDbfRecordBuffer): TBookmarkFlag; override; {virtual abstract}
function GetRecord(Buffer: TDbfRecordBuffer; GetMode: TGetMode; {%H-}DoCheck: Boolean): TGetResult; override; {virtual abstract}
function GetRecordSize: Word; override; {virtual abstract}
@@ -261,7 +261,7 @@
procedure InternalClose; override; {virtual abstract}
procedure InternalDelete; override; {virtual abstract}
procedure InternalFirst; override; {virtual abstract}
- procedure InternalGotoBookmark(ABookmark: Pointer); override; {virtual abstract}
+ procedure InternalGotoBookmark(ABookmark: TDbfBookmark); override; {virtual abstract}
procedure InternalHandleException; override; {virtual abstract}
procedure InternalInitFieldDefs; override; {virtual abstract}
procedure InternalInitRecord(Buffer: TDbfRecordBuffer); override; {virtual abstract}
@@ -748,10 +748,17 @@
FreeMemAndNil(Pointer(Buffer));
end;
-procedure TDbf.GetBookmarkData(Buffer: TDbfRecordBuffer; Data: Pointer); {override virtual abstract from TDataset}
+procedure TDbf.GetBookmarkData(Buffer: TDbfRecBuf; Data: TDbfBookmark);
+var
+ BookmarkData: pBookmarkData;
begin
- pBookmarkData(Data)^ := pDbfRecord(Buffer)^.BookmarkData;
- pBookmarkData(Data)^.PhysicalRecNo := SwapIntLE(DWORD(pBookmarkData(Data)^.PhysicalRecNo));
+ {$ifdef SUPPORT_TBOOKMARK}
+ BookmarkData := @Data[0];
+ {$else}
+ BookmarkData := Data;
+ {$endif}
+ BookmarkData^ := pDbfRecord(Buffer)^.BookmarkData;
+ BookmarkData^.PhysicalRecNo := SwapIntLE(DWORD(pBookmarkData(Data)^.PhysicalRecNo));
end;
function TDbf.GetBookmarkFlag(Buffer: TDbfRecordBuffer): TBookmarkFlag; {override virtual abstract from TDataset}
@@ -1105,11 +1112,17 @@
FCursor.First;
end;
-procedure TDbf.InternalGotoBookmark(ABookmark: Pointer); {override virtual abstract from TDataset}
+procedure TDbf.InternalGotoBookmark(ABookmark: TDbfBookmark); {override virtual abstract from TDataset}
var
+ BookmarkData: PBookmarkData;
APhysicalRecNo: Integer;
begin
- APhysicalRecNo := Integer(SwapIntLE(DWORD(PBookmarkData(ABookmark)^.PhysicalRecNo)));
+ {$ifdef SUPPORT_TBOOKMARK}
+ BookmarkData := @ABookmark[0];
+ {$else}
+ BookmarkData := ABookmark;
+ {$endif}
+ APhysicalRecNo := Integer(SwapIntLE(DWORD(BookmarkData^.PhysicalRecNo)));
if (APhysicalRecNo = 0) then begin
First;
end else
Modified: trunk/src/dbf_common.inc
===================================================================
--- trunk/src/dbf_common.inc 2024-08-06 20:46:30 UTC (rev 858)
+++ trunk/src/dbf_common.inc 2025-01-22 15:38:58 UTC (rev 859)
@@ -583,6 +583,7 @@
{$ifdef Delphi_2009}
{$define WINAPI_IS_UNICODE}
{$define SUPPORT_TRECORDBUFFER}
+ {$define SUPPORT_TBOOKMARK}
{$define SUPPORT_CHARINSET}
{$define SUPPORT_MAXLISTSIZEDEPRECATED}
{$endif}
Modified: trunk/src/dbf_common.pas
===================================================================
--- trunk/src/dbf_common.pas 2024-08-06 20:46:30 UTC (rev 858)
+++ trunk/src/dbf_common.pas 2025-01-22 15:38:58 UTC (rev 859)
@@ -74,7 +74,15 @@
DBfRecBufNil = nil;
{$endif}
+{$ifdef SUPPORT_TBOOKMARK}
type
+ TDbfBookmark = TBookmark;
+{$else}
+type
+ TDbfBookmark = Pointer;
+{$endif}
+
+type
TDbfFieldType = AnsiChar;
TXBaseVersion = (xUnknown, xClipper, xBaseIII, xBaseIV, xBaseV, xFoxPro, xBaseVII);
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X