You can subscribe to this list here.
2003 |
Jan
|
Feb
|
Mar
(38) |
Apr
(23) |
May
(15) |
Jun
(32) |
Jul
(13) |
Aug
(18) |
Sep
(13) |
Oct
(9) |
Nov
(8) |
Dec
(13) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2004 |
Jan
(9) |
Feb
(3) |
Mar
(7) |
Apr
(10) |
May
(14) |
Jun
(19) |
Jul
(16) |
Aug
(28) |
Sep
(15) |
Oct
(10) |
Nov
(4) |
Dec
(11) |
2005 |
Jan
(2) |
Feb
(3) |
Mar
(7) |
Apr
(4) |
May
|
Jun
(1) |
Jul
(5) |
Aug
(2) |
Sep
|
Oct
(3) |
Nov
(4) |
Dec
(6) |
2006 |
Jan
(11) |
Feb
(3) |
Mar
(8) |
Apr
(9) |
May
(2) |
Jun
(10) |
Jul
(4) |
Aug
(1) |
Sep
(3) |
Oct
(2) |
Nov
|
Dec
|
2007 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(3) |
Sep
(1) |
Oct
|
Nov
(1) |
Dec
|
2013 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(22) |
Aug
(3) |
Sep
|
Oct
(2) |
Nov
|
Dec
|
2014 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(8) |
Aug
(1) |
Sep
|
Oct
|
Nov
|
Dec
|
2015 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(179) |
Jun
(2) |
Jul
(3) |
Aug
(15) |
Sep
(46) |
Oct
(9) |
Nov
(56) |
Dec
|
2016 |
Jan
(1) |
Feb
(1) |
Mar
(1) |
Apr
(4) |
May
|
Jun
|
Jul
(1) |
Aug
(7) |
Sep
|
Oct
|
Nov
(2) |
Dec
(1) |
2017 |
Jan
|
Feb
|
Mar
|
Apr
(3) |
May
|
Jun
(1) |
Jul
|
Aug
(1) |
Sep
|
Oct
(3) |
Nov
|
Dec
|
2018 |
Jan
|
Feb
|
Mar
(2) |
Apr
|
May
(1) |
Jun
(1) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(7) |
2020 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(15) |
Sep
(8) |
Oct
(8) |
Nov
(1) |
Dec
|
2021 |
Jan
(28) |
Feb
(3) |
Mar
(5) |
Apr
(4) |
May
|
Jun
(24) |
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
2022 |
Jan
|
Feb
(29) |
Mar
|
Apr
(4) |
May
(1) |
Jun
(2) |
Jul
(11) |
Aug
(12) |
Sep
(2) |
Oct
|
Nov
|
Dec
|
2023 |
Jan
(7) |
Feb
|
Mar
(3) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
(2) |
Dec
|
2024 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
(6) |
Aug
(5) |
Sep
|
Oct
|
Nov
|
Dec
|
From: <pau...@us...> - 2024-08-06 20:46:32
|
Revision: 858 http://sourceforge.net/p/tdbf/code/858 Author: paulenandrew Date: 2024-08-06 20:46:30 +0000 (Tue, 06 Aug 2024) Log Message: ----------- Fix H2077 Value assigned never used Modified Paths: -------------- trunk/src/dbf_prssupp.pas Modified: trunk/src/dbf_prssupp.pas =================================================================== --- trunk/src/dbf_prssupp.pas 2024-08-06 20:45:55 UTC (rev 857) +++ trunk/src/dbf_prssupp.pas 2024-08-06 20:46:30 UTC (rev 858) @@ -425,7 +425,6 @@ DateStr: AnsiString; DateChar: AnsiChar; begin - Result := False; DateValue := 0; IsNull := True; if Str <> '' then This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2024-08-06 20:45:57
|
Revision: 857 http://sourceforge.net/p/tdbf/code/857 Author: paulenandrew Date: 2024-08-06 20:45:55 +0000 (Tue, 06 Aug 2024) Log Message: ----------- Fix W1058 Implicit string cast with data loss Modified Paths: -------------- trunk/src/dbf_prscore.pas Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2024-08-06 20:45:11 UTC (rev 856) +++ trunk/src/dbf_prscore.pas 2024-08-06 20:45:55 UTC (rev 857) @@ -1340,7 +1340,8 @@ begin DateValue := 0; IsNull := True; - DateValid := StrToDateCTOD(Copy(W, 2, Length(W) - 2), DateValue, IsNull); + DateValid := StrToDateCTOD(AnsiString(Copy(W, 2, Length(W) - 2)), + DateValue, IsNull); if DateValid then begin if IsNull then This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2024-08-06 20:45:13
|
Revision: 856 http://sourceforge.net/p/tdbf/code/856 Author: paulenandrew Date: 2024-08-06 20:45:11 +0000 (Tue, 06 Aug 2024) Log Message: ----------- Fix W1035 Return value might be undefined Modified Paths: -------------- trunk/src/dbf_prscore.pas Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2024-08-06 20:44:33 UTC (rev 855) +++ trunk/src/dbf_prscore.pas 2024-08-06 20:45:11 UTC (rev 856) @@ -1335,6 +1335,7 @@ end else if W[1] = '{' then begin + Result := nil; if W[Length(W)] = '}' then begin DateValue := 0; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2024-08-06 20:44:35
|
Revision: 855 http://sourceforge.net/p/tdbf/code/855 Author: paulenandrew Date: 2024-08-06 20:44:33 +0000 (Tue, 06 Aug 2024) Log Message: ----------- Fix W1057 Implicit string cast Modified Paths: -------------- trunk/src/dbf_prssupp.pas Modified: trunk/src/dbf_prssupp.pas =================================================================== --- trunk/src/dbf_prssupp.pas 2024-08-06 20:43:45 UTC (rev 854) +++ trunk/src/dbf_prssupp.pas 2024-08-06 20:44:33 UTC (rev 855) @@ -421,9 +421,9 @@ var Index: Integer; SeparatorCount: Integer; - SeparatorChar: Char; - DateStr: string; - DateChar: Char; + SeparatorChar: AnsiChar; + DateStr: AnsiString; + DateChar: AnsiChar; begin Result := False; DateValue := 0; @@ -448,7 +448,7 @@ SeparatorChar := DateChar; Inc(SeparatorCount); if Result then - DateStr[Index] := DateSeparator + DateStr[Index] := AnsiChar(DateSeparator) end; else Result := False; @@ -460,7 +460,7 @@ if Result then begin try - DateValue := StrToDate(DateStr); + DateValue := StrToDate(string(DateStr)); IsNull := False; except on EConvertError do This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2024-08-06 20:43:47
|
Revision: 854 http://sourceforge.net/p/tdbf/code/854 Author: paulenandrew Date: 2024-08-06 20:43:45 +0000 (Tue, 06 Aug 2024) Log Message: ----------- Fix E2003 Undeclared identifier: 'DateSeparator' Modified Paths: -------------- trunk/src/dbf_prssupp.pas Modified: trunk/src/dbf_prssupp.pas =================================================================== --- trunk/src/dbf_prssupp.pas 2024-07-09 20:47:17 UTC (rev 853) +++ trunk/src/dbf_prssupp.pas 2024-08-06 20:43:45 UTC (rev 854) @@ -9,7 +9,8 @@ interface uses - Classes; + Classes, + dbf_common; type @@ -447,7 +448,7 @@ SeparatorChar := DateChar; Inc(SeparatorCount); if Result then - DateStr[Index] := DateSeparator{%H-} + DateStr[Index] := DateSeparator end; else Result := False; 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:47:20
|
Revision: 853 http://sourceforge.net/p/tdbf/code/853 Author: paulenandrew Date: 2024-07-09 20:47:17 +0000 (Tue, 09 Jul 2024) Log Message: ----------- add CTOD() function to parser Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_prscore.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2024-07-09 20:46:40 UTC (rev 852) +++ trunk/doc/history.txt 2024-07-09 20:47:17 UTC (rev 853) @@ -95,6 +95,7 @@ - add AT() function to parser - add date literal to parser - add date comparison operators to parser +- add CTOD() function to parser ------------------------ V7.0.1 Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2024-07-09 20:46:40 UTC (rev 852) +++ trunk/src/dbf_prscore.pas 2024-07-09 20:47:17 UTC (rev 853) @@ -2667,6 +2667,12 @@ Param^.Res.Append(@IntValue, SizeOf(Byte)); end; +procedure FuncCTOD(Param: PExpressionRec); +begin + StrToDateCTOD(AnsiString(Param^.Args[0]), PDateTime(Param^.Res.MemoryPos^)^, + Param^.IsNull); +end; + procedure FuncDate(Param: PExpressionRec); begin PDateTime(Param^.Res.MemoryPos^)^ := Now; @@ -3110,6 +3116,7 @@ Add(TFunction.Create('CEILING', 'CEIL', 'F', 1, etInteger, FuncCeil_I_F, '')); Add(TFunction.Create('CEILING', 'CEIL', 'F', 1, etFloat, FuncCeil_F_F, '')); Add(TFunction.Create('CHR', '', 'I', 1, etString, FuncChr, '')); + Add(TFunction.Create('CTOD', '', 'S', 1, etDateTime, FuncCTOD, '')); Add(TFunction.Create('DATE', '', '', 0, etDateTime, FuncDate, '')); Add(TFunction.Create('DAY', '', 'D', 1, etInteger, FuncDay, '')); Add(TFunction.Create('EMPTY', '', 'D', 1, etBoolean, FuncEmpty, '')); 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:46:42
|
Revision: 852 http://sourceforge.net/p/tdbf/code/852 Author: paulenandrew Date: 2024-07-09 20:46:40 +0000 (Tue, 09 Jul 2024) Log Message: ----------- add date comparison operators to parser Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_prscore.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2024-07-09 20:46:09 UTC (rev 851) +++ trunk/doc/history.txt 2024-07-09 20:46:40 UTC (rev 852) @@ -94,6 +94,7 @@ - add DELETED() function to parser - add AT() function to parser - add date literal to parser +- add date comparison operators to parser ------------------------ V7.0.1 Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2024-07-09 20:46:09 UTC (rev 851) +++ trunk/src/dbf_prscore.pas 2024-07-09 20:46:40 UTC (rev 852) @@ -204,6 +204,12 @@ procedure FuncStr_GT(Param: PExpressionRec); procedure FuncStr_LTE(Param: PExpressionRec); procedure FuncStr_GTE(Param: PExpressionRec); +procedure Func_DD_EQ(Param: PExpressionRec); +procedure Func_DD_NEQ(Param: PExpressionRec); +procedure Func_DD_LT(Param: PExpressionRec); +procedure Func_DD_GT(Param: PExpressionRec); +procedure Func_DD_LTE(Param: PExpressionRec); +procedure Func_DD_GTE(Param: PExpressionRec); procedure Func_FF_EQ(Param: PExpressionRec); procedure Func_FF_NEQ(Param: PExpressionRec); procedure Func_FF_LT(Param: PExpressionRec); @@ -550,6 +556,7 @@ Args[0] := ExprWord.AsPointer; FConstantsList.Add(ExprWord); end; + LinkVariable(ExprRec); finally DisposeList(FCurrentRec); FCurrentRec := nil; @@ -2072,6 +2079,60 @@ Param^.Res.MemoryPos^^ := AnsiChar(dbfStrComp(Param^.Args[0], Param^.Args[1]) >= 0); // Was Char end; +procedure Func_DD_EQ(Param: PExpressionRec); +begin + if Param^.ArgList[0]^.IsNullPtr^ then + PBoolean(Param^.Res.MemoryPos^)^ := Param^.ArgList[1]^.IsNullPtr^ + else + PBoolean(Param^.Res.MemoryPos^)^ := (not Param^.ArgList[1]^.IsNullPtr^) and + (PDateTime(Param^.Args[0])^ = PDateTime(Param^.Args[1])^); +end; + +procedure Func_DD_NEQ(Param: PExpressionRec); +begin + if Param^.ArgList[0]^.IsNullPtr^ then + PBoolean(Param^.Res.MemoryPos^)^ := not Param^.ArgList[1]^.IsNullPtr^ + else + PBoolean(Param^.Res.MemoryPos^)^ := Param^.ArgList[1]^.IsNullPtr^ or + (PDateTime(Param^.Args[0])^ <> PDateTime(Param^.Args[1])^); +end; + +procedure Func_DD_LT(Param: PExpressionRec); +begin + if Param^.ArgList[1]^.IsNullPtr^ then + PBoolean(Param^.Res.MemoryPos^)^ := False + else + PBoolean(Param^.Res.MemoryPos^)^ := Param^.ArgList[0]^.IsNullPtr^ or + (PDateTime(Param^.Args[0])^ < PDateTime(Param^.Args[1])^); +end; + +procedure Func_DD_GT(Param: PExpressionRec); +begin + if Param^.ArgList[0]^.IsNullPtr^ then + PBoolean(Param^.Res.MemoryPos^)^ := False + else + PBoolean(Param^.Res.MemoryPos^)^ := Param^.ArgList[1]^.IsNullPtr^ or + (PDateTime(Param^.Args[0])^ > PDateTime(Param^.Args[1])^); +end; + +procedure Func_DD_LTE(Param: PExpressionRec); +begin + if Param^.ArgList[0]^.IsNullPtr^ then + PBoolean(Param^.Res.MemoryPos^)^ := True + else + PBoolean(Param^.Res.MemoryPos^)^ := (not Param^.ArgList[1]^.IsNullPtr^) and + (PDateTime(Param^.Args[0])^ <= PDateTime(Param^.Args[1])^); +end; + +procedure Func_DD_GTE(Param: PExpressionRec); +begin + if Param^.ArgList[1]^.IsNullPtr^ then + PBoolean(Param^.Res.MemoryPos^)^ := True + else + PBoolean(Param^.Res.MemoryPos^)^ := (not Param^.ArgList[0]^.IsNullPtr^) and + (PDateTime(Param^.Args[0])^ >= PDateTime(Param^.Args[1])^); +end; + procedure Func_FF_EQ(Param: PExpressionRec); begin Param^.Res.MemoryPos^^ := AnsiChar(PDouble(Param^.Args[0])^ = PDouble(Param^.Args[1])^); // Was Char @@ -2946,6 +3007,12 @@ Add(TFunction.CreateOper('/', 'LI', etLargeInt, FuncDiv_F_LL, 40)); {$endif} + Add(TFunction.CreateOper('=', 'DD', etBoolean, Func_DD_EQ , 80)); + Add(TFunction.CreateOper('<', 'DD', etBoolean, Func_DD_LT , 80)); + Add(TFunction.CreateOper('>', 'DD', etBoolean, Func_DD_GT , 80)); + Add(TFunction.CreateOper('<=','DD', etBoolean, Func_DD_LTE, 80)); + Add(TFunction.CreateOper('>=','DD', etBoolean, Func_DD_GTE, 80)); + Add(TFunction.CreateOper('<>','DD', etBoolean, Func_DD_NEQ, 80)); Add(TFunction.CreateOper('=', 'FF', etBoolean, Func_FF_EQ , 80)); Add(TFunction.CreateOper('<', 'FF', etBoolean, Func_FF_LT , 80)); Add(TFunction.CreateOper('>', 'FF', etBoolean, Func_FF_GT , 80)); 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:46:12
|
Revision: 851 http://sourceforge.net/p/tdbf/code/851 Author: paulenandrew Date: 2024-07-09 20:46:09 +0000 (Tue, 09 Jul 2024) Log Message: ----------- add date literal to parser Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_common.pas trunk/src/dbf_prscore.pas trunk/src/dbf_prssupp.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2024-07-09 20:45:27 UTC (rev 850) +++ trunk/doc/history.txt 2024-07-09 20:46:09 UTC (rev 851) @@ -93,6 +93,7 @@ - fix potential Range Check Error getting/setting field value - add DELETED() function to parser - add AT() function to parser +- add date literal to parser ------------------------ V7.0.1 Modified: trunk/src/dbf_common.pas =================================================================== --- trunk/src/dbf_common.pas 2024-07-09 20:45:27 UTC (rev 850) +++ trunk/src/dbf_common.pas 2024-07-09 20:46:09 UTC (rev 851) @@ -150,6 +150,7 @@ {$ifdef SUPPORT_FORMATSETTINGS} function TwoDigitYearCenturyWindow: word; function DecimalSeparator: char; +function DateSeparator: Char; {$endif SUPPORT_FORMATSETTINGS} //------------------------------------- @@ -421,6 +422,15 @@ {$endif SUPPORT_FORMATSETTINGS} end; +function DateSeparator: Char; +begin +{$ifdef SUPPORT_FORMATSETTINGS} + Result := FormatSettings.DateSeparator; +{$else SUPPORT_FORMATSETTINGS} + Result := SysUtils.DateSeparator{%H-}; +{$endif SUPPORT_FORMATSETTINGS} +end; + {$ifdef USE_CACHE} function GetFreeMemory: Integer; Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2024-07-09 20:45:27 UTC (rev 850) +++ trunk/src/dbf_prscore.pas 2024-07-09 20:46:09 UTC (rev 851) @@ -1291,6 +1291,14 @@ Inc(I2); '0'..'9': ReadConstant(AnExpr, false); + '{': + begin + isConstant := True; + while (I2 <= Len) and (AnExpr[I2] <> '}') do + Inc(I2); + if I2 <= Len then + Inc(I2); + end; else begin Inc(I2); @@ -1304,6 +1312,9 @@ DecSep: Integer; AInteger: Integer; Code: Integer; + DateValue: TDateTime; + IsNull: Boolean; + DateValid: Boolean; begin if W[1] = HexChar then begin @@ -1314,6 +1325,26 @@ if (W[1] = '''') or (W[1] = '"') then begin // StringConstant will handle any escaped quotes Result := TStringConstant.Create(W); + end + else if W[1] = '{' then + begin + if W[Length(W)] = '}' then + begin + DateValue := 0; + IsNull := True; + DateValid := StrToDateCTOD(Copy(W, 2, Length(W) - 2), DateValue, IsNull); + if DateValid then + begin + if IsNull then + Result := TDateTimeConstant.Create(W) + else + Result := TDateTimeConstant.Create(W, DateValue); + end; + end + else + DateValid := False; + if not DateValid then + StrToDate(W); end else begin DecSep := Pos(FDecimalSeparator, W); if (DecSep > 0) then Modified: trunk/src/dbf_prssupp.pas =================================================================== --- trunk/src/dbf_prssupp.pas 2024-07-09 20:45:27 UTC (rev 850) +++ trunk/src/dbf_prssupp.pas 2024-07-09 20:46:09 UTC (rev 851) @@ -64,6 +64,8 @@ function IntToStrWidth(Val: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; const FieldSize: Integer; const Dest: PAnsiChar; Pad: Boolean; PadChar: AnsiChar): Integer; function FloatToStrWidth(const Val: Extended; const FieldSize, FieldPrec: Integer; const Dest: PAnsiChar; Pad: Boolean): Integer; +function StrToDateCTOD(const Str: AnsiString; + var DateValue: TDateTime; var IsNull: Boolean): Boolean; function StrToIntWidth(var IntValue: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; Src: Pointer; Size: Integer; Default: Integer): Boolean; function StrToInt32Width(var IntValue: Integer; Src: Pointer; Size: Integer; Default: Integer): Boolean; function StrToFloatWidth(var FloatValue: Extended; const Src: PAnsiChar; const Size: Integer; Default: Extended): Boolean; @@ -413,6 +415,62 @@ Result:= NumberPad(FloatResult, Dest, Pad, ' '); end; +function StrToDateCTOD(const Str: AnsiString; + var DateValue: TDateTime; var IsNull: Boolean): Boolean; +var + Index: Integer; + SeparatorCount: Integer; + SeparatorChar: Char; + DateStr: string; + DateChar: Char; +begin + Result := False; + DateValue := 0; + IsNull := True; + if Str <> '' then + begin + DateStr := Str; + SeparatorCount := 0; + SeparatorChar := #0; + Index := 1; + Result := True; + while (Index <= Length(DateStr)) and Result do + begin + DateChar := DateStr[Index]; + case DateChar of + '0'..'9':; + '/', '-', '.': + begin + if SeparatorCount <> 0 then + Result := DateChar = SeparatorChar + else + SeparatorChar := DateChar; + Inc(SeparatorCount); + if Result then + DateStr[Index] := DateSeparator{%H-} + end; + else + Result := False; + end; + Inc(Index); + end; + if Result then + Result := SeparatorCount = 2; + if Result then + begin + try + DateValue := StrToDate(DateStr); + IsNull := False; + except + on EConvertError do + Result := False; + end; + end; + end + else + Result := True; +end; + function StrToIntWidth(var IntValue: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif}; Src: Pointer; Size: Integer; Default: Integer): Boolean; var P: PAnsiChar; 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...> - 2024-07-09 20:44:18
|
Revision: 849 http://sourceforge.net/p/tdbf/code/849 Author: paulenandrew Date: 2024-07-09 20:44:16 +0000 (Tue, 09 Jul 2024) Log Message: ----------- add AT() function to parser Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_prscore.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2024-07-09 20:43:43 UTC (rev 848) +++ trunk/doc/history.txt 2024-07-09 20:44:16 UTC (rev 849) @@ -92,6 +92,7 @@ - fix Access Violation packing table if filter is active - fix potential Range Check Error getting/setting field value - add DELETED() function to parser +- add AT() function to parser ------------------------ V7.0.1 Modified: trunk/src/dbf_prscore.pas =================================================================== --- trunk/src/dbf_prscore.pas 2024-07-09 20:43:43 UTC (rev 848) +++ trunk/src/dbf_prscore.pas 2024-07-09 20:44:16 UTC (rev 849) @@ -2487,6 +2487,42 @@ PInteger(Param^.Res.MemoryPos^)^ := Ord(Param^.Args[0]^); end; +procedure FuncAt(Param: PExpressionRec); +var + SubStr: AnsiString; + Str: AnsiString; + FinalPos: Integer; + APos: Integer; + Occurence: Integer; +begin + if Assigned(Param^.Args[2]) then + Occurence := PInteger(Param^.Args[2])^ + else + Occurence := 1; + FinalPos := 0; + if Occurence > 0 then + begin + SubStr := Param^.Args[0]; + Str := Param^.Args[1]; + APos := -1; + while (Occurence > 0) and (APos <> 0) do + begin + APos := Pos(SubStr, Str); + if APos <> 0 then + begin + if FinalPos <> 0 then + Inc(FinalPos, Pred(Length(SubStr))); + Inc(FinalPos, APos); + Str := Copy(Str, APos + Length(SubStr), MaxInt); + Dec(Occurence); + end + else + FinalPos := 0; + end; + end; + PInteger(Param^.Res.MemoryPos^)^ := FinalPos; +end; + procedure FuncCDOW(Param: PExpressionRec); var ADate: TDateTime; @@ -2961,6 +2997,8 @@ Add(TFunction.Create('ABS', '', 'L', 1, etFloat, FuncAbs_F_L, '')); {$endif} Add(TFunction.Create('ASC', '', 'S', 1, etInteger, FuncAsc, '')); + Add(TFunction.Create('AT', '', 'SS', 2, etInteger, FuncAt, '')); + Add(TFunction.Create('AT', '', 'SSI', 3, etInteger, FuncAt, '')); Add(TFunction.Create('CDOW', '', 'D', 1, etString, FuncCDOW, '')); Add(TFunction.Create('CEILING', 'CEIL', 'F', 1, etInteger, FuncCeil_I_F, '')); Add(TFunction.Create('CEILING', 'CEIL', 'F', 1, etFloat, FuncCeil_F_F, '')); 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:43:45
|
Revision: 848 http://sourceforge.net/p/tdbf/code/848 Author: paulenandrew Date: 2024-07-09 20:43:43 +0000 (Tue, 09 Jul 2024) Log Message: ----------- add DELETED() function to parser Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf_parser.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2023-11-12 11:59:13 UTC (rev 847) +++ trunk/doc/history.txt 2024-07-09 20:43:43 UTC (rev 848) @@ -91,6 +91,7 @@ - get exclusive access to the table, as well as index files, to rebuild indexes (fixes bug introduced in r730). - fix Access Violation packing table if filter is active - fix potential Range Check Error getting/setting field value +- add DELETED() function to parser ------------------------ V7.0.1 Modified: trunk/src/dbf_parser.pas =================================================================== --- trunk/src/dbf_parser.pas 2023-11-12 11:59:13 UTC (rev 847) +++ trunk/src/dbf_parser.pas 2024-07-09 20:43:43 UTC (rev 848) @@ -27,6 +27,7 @@ TDbfParser = class(TCustomExpressionParser) private FDbfFile: Pointer; + FDeletedVariable: TVariable; FFieldVarList: TStringList; FIsExpression: Boolean; // expression or simple field? FFieldType: TExpressionType; @@ -81,6 +82,11 @@ dbf_dbffile, dbf_str; +procedure FuncDeleted(Param: PExpressionRec); +begin + PBoolean(Param^.Res.MemoryPos^)^ := False; +end; + procedure FuncRecNo(Param: PExpressionRec); begin PInteger(Param^.Res.MemoryPos^)^ := -1; @@ -384,6 +390,26 @@ FFieldVal := lFieldVal <> 0; end; +//--TDeletedVariable--------------------------------------------------------- +type + TDeletedVariable = class(TBooleanVariable) + private + FIsDeleted: Boolean; + public + constructor Create; reintroduce; + procedure Refresh(Buffer: PAnsiChar); + end; + +constructor TDeletedVariable.Create; +begin + inherited Create(EmptyStr, @FIsDeleted, nil, nil); +end; + +procedure TDeletedVariable.Refresh(Buffer: PAnsiChar); +begin + FIsDeleted := Buffer^ = '*'; +end; + //--TRecNoVariable----------------------------------------------------------- type TRecNoVariable = class(TIntegerVariable) @@ -422,6 +448,7 @@ ClearExpressions; inherited; FreeAndNil(FFieldVarList); + FreeAndNil(FDeletedVariable); FreeAndNil(FRecNoVariable); end; @@ -520,6 +547,8 @@ FWordsList.AddList(DbfWordsSensNoPartialList, 0, DbfWordsSensNoPartialList.Count - 1); end; end; + FWordsList.Add(TVaryingFunction.Create('DELETED', '', '', 0, etBoolean, + FuncDeleted, '')); FWordsList.Add(TVaryingFunction.Create('RECNO', '', '', 0, etInteger, FuncRecNo, '')); if Length(lExpression) > 0 then ParseExpression(lExpression); @@ -661,6 +690,8 @@ // prepare all field variables for I := 0 to FFieldVarList.Count - 1 do TFieldVar(FFieldVarList.Objects[I]).Refresh(Buffer); + if Assigned(FDeletedVariable) then + TDeletedVariable(FDeletedVariable).Refresh(Buffer); if Assigned(FRecNoVariable) then TRecNoVariable(FRecNoVariable).Refresh(RecNo); @@ -728,10 +759,37 @@ NewExprRec: PExpressionRec; Variable: TVariable; begin - if @ExprRec.Oper = @FuncRecNo then + if @ExprRec.Oper = @FuncDeleted then begin NewExprRec := MakeRec; try + if Assigned(FDeletedVariable) then + Variable := FDeletedVariable + else + Variable := TDeletedVariable.Create; + try + NewExprRec.ExprWord := Variable; + NewExprRec.Oper := NewExprRec.ExprWord.ExprFunc; + NewExprRec.Args[0] := NewExprRec.ExprWord.AsPointer; + NewExprRec.IsNullPtr := @NewExprRec.IsNull; + CurrentRec := nil; + DisposeList(ExprRec); + ExprRec := NewExprRec; + except + if not Assigned(FDeletedVariable) then + FreeAndNil(Variable); + raise; + end; + FDeletedVariable := Variable; + except + DisposeList(NewExprRec); + raise; + end; + end + else if @ExprRec.Oper = @FuncRecNo then + begin + NewExprRec := MakeRec; + try if Assigned(FRecNoVariable) then Variable := FRecNoVariable else This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <tw...@us...> - 2023-11-12 11:59:15
|
Revision: 847 http://sourceforge.net/p/tdbf/code/847 Author: twm Date: 2023-11-12 11:59:13 +0000 (Sun, 12 Nov 2023) Log Message: ----------- * added Delphi 12 to dbf_common.inc * added packages for Delphi 12 Modified Paths: -------------- trunk/packages/Delphi12/dcltdbf.dpk trunk/packages/Delphi12/dcltdbf.dproj trunk/packages/Delphi12/tdbf.dpk trunk/packages/Delphi12/tdbf.dproj trunk/src/dbf_common.inc Added Paths: ----------- trunk/packages/Delphi12/ trunk/packages/Delphi12/tdbf12.groupproj Removed Paths: ------------- trunk/packages/Delphi12/tdbf11.groupproj Modified: trunk/packages/Delphi12/dcltdbf.dpk =================================================================== --- trunk/packages/Delphi11/dcltdbf.dpk 2023-03-21 15:19:50 UTC (rev 845) +++ trunk/packages/Delphi12/dcltdbf.dpk 2023-11-12 11:59:13 UTC (rev 847) @@ -25,8 +25,8 @@ {$IMAGEBASE $400000} {$DEFINE DEBUG} {$ENDIF IMPLICITBUILDING} -{$DESCRIPTION 'TDbf for Delphi 11 Alexandria'} -{$LIBSUFFIX '280'} +{$DESCRIPTION 'TDbf for Delphi 12'} +{$LIBSUFFIX AUTO} {$DESIGNONLY} {$IMPLICITBUILD OFF} Modified: trunk/packages/Delphi12/dcltdbf.dproj =================================================================== --- trunk/packages/Delphi11/dcltdbf.dproj 2023-03-21 15:19:50 UTC (rev 845) +++ trunk/packages/Delphi12/dcltdbf.dproj 2023-11-12 11:59:13 UTC (rev 847) @@ -7,7 +7,7 @@ <TargetedPlatforms>1</TargetedPlatforms> <AppType>Package</AppType> <FrameworkType>VCL</FrameworkType> - <ProjectVersion>19.3</ProjectVersion> + <ProjectVersion>20.1</ProjectVersion> <Platform Condition="'$(Platform)'==''">Win32</Platform> </PropertyGroup> <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> @@ -44,9 +44,9 @@ <SanitizedProjectName>dcltdbf</SanitizedProjectName> <DesignOnlyPackage>true</DesignOnlyPackage> <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> - <DllSuffix>280</DllSuffix> + <DllSuffix>$(Auto)</DllSuffix> <DCC_ImageBase>00400000</DCC_ImageBase> - <DCC_Description>TDbf for Delphi 11 Alexandria</DCC_Description> + <DCC_Description>TDbf for Delphi 12</DCC_Description> <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace> <DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps> <GenPackage>true</GenPackage> @@ -138,7 +138,10 @@ <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> <VersionInfoKeys Name="Comments"/> </VersionInfoKeys> - <Excluded_Packages/> + <Excluded_Packages> + <Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages> + <Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages> + </Excluded_Packages> </Delphi.Personality> <Platforms> <Platform value="Win32">True</Platform> Modified: trunk/packages/Delphi12/tdbf.dpk =================================================================== --- trunk/packages/Delphi11/tdbf.dpk 2023-03-21 15:19:50 UTC (rev 845) +++ trunk/packages/Delphi12/tdbf.dpk 2023-11-12 11:59:13 UTC (rev 847) @@ -25,8 +25,8 @@ {$IMAGEBASE $400000} {$DEFINE DEBUG} {$ENDIF IMPLICITBUILDING} -{$DESCRIPTION 'TDbf for Delphi 11 Alexandria runtime'} -{$LIBSUFFIX '280'} +{$DESCRIPTION 'TDbf for Delphi 12 runtime'} +{$LIBSUFFIX AUTO} {$RUNONLY} {$IMPLICITBUILD OFF} Modified: trunk/packages/Delphi12/tdbf.dproj =================================================================== --- trunk/packages/Delphi11/tdbf.dproj 2023-03-21 15:19:50 UTC (rev 845) +++ trunk/packages/Delphi12/tdbf.dproj 2023-11-12 11:59:13 UTC (rev 847) @@ -7,7 +7,7 @@ <TargetedPlatforms>3</TargetedPlatforms> <AppType>Package</AppType> <FrameworkType>VCL</FrameworkType> - <ProjectVersion>19.3</ProjectVersion> + <ProjectVersion>20.1</ProjectVersion> <Platform Condition="'$(Platform)'==''">Win32</Platform> </PropertyGroup> <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> @@ -62,9 +62,9 @@ <DCC_DcuOutput>.\dcu</DCC_DcuOutput> <DCC_ImageBase>00400000</DCC_ImageBase> <VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys> - <DllSuffix>280</DllSuffix> + <DllSuffix>$(Auto)</DllSuffix> <DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps> - <DCC_Description>TDbf for Delphi 11 Alexandria runtime</DCC_Description> + <DCC_Description>TDbf for Delphi 12 runtime</DCC_Description> <DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace)</DCC_Namespace> <RuntimeOnlyPackage>true</RuntimeOnlyPackage> <GenPackage>true</GenPackage> @@ -188,7 +188,10 @@ <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys> <VersionInfoKeys Name="Comments"/> </VersionInfoKeys> - <Excluded_Packages/> + <Excluded_Packages> + <Excluded_Packages Name="$(BDSBIN)\dcloffice2k290.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages> + <Excluded_Packages Name="$(BDSBIN)\dclofficexp290.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages> + </Excluded_Packages> </Delphi.Personality> <Platforms> <Platform value="Win32">True</Platform> Deleted: trunk/packages/Delphi12/tdbf11.groupproj =================================================================== --- trunk/packages/Delphi11/tdbf11.groupproj 2023-03-21 15:19:50 UTC (rev 845) +++ trunk/packages/Delphi12/tdbf11.groupproj 2023-11-12 11:59:13 UTC (rev 847) @@ -1,48 +0,0 @@ -<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> - <PropertyGroup> - <ProjectGuid>{63327AEB-D4CB-4D0C-B6B0-A45032FCC02A}</ProjectGuid> - </PropertyGroup> - <ItemGroup> - <Projects Include="tdbf.dproj"> - <Dependencies/> - </Projects> - <Projects Include="dcltdbf.dproj"> - <Dependencies>tdbf.dproj</Dependencies> - </Projects> - </ItemGroup> - <ProjectExtensions> - <Borland.Personality>Default.Personality.12</Borland.Personality> - <Borland.ProjectType/> - <BorlandProject> - <Default.Personality/> - </BorlandProject> - </ProjectExtensions> - <Target Name="tdbf"> - <MSBuild Projects="tdbf.dproj"/> - </Target> - <Target Name="tdbf:Clean"> - <MSBuild Projects="tdbf.dproj" Targets="Clean"/> - </Target> - <Target Name="tdbf:Make"> - <MSBuild Projects="tdbf.dproj" Targets="Make"/> - </Target> - <Target Name="dcltdbf" DependsOnTargets="tdbf"> - <MSBuild Projects="dcltdbf.dproj"/> - </Target> - <Target Name="dcltdbf:Clean" DependsOnTargets="tdbf:Clean"> - <MSBuild Projects="dcltdbf.dproj" Targets="Clean"/> - </Target> - <Target Name="dcltdbf:Make" DependsOnTargets="tdbf:Make"> - <MSBuild Projects="dcltdbf.dproj" Targets="Make"/> - </Target> - <Target Name="Build"> - <CallTarget Targets="tdbf;dcltdbf"/> - </Target> - <Target Name="Clean"> - <CallTarget Targets="tdbf:Clean;dcltdbf:Clean"/> - </Target> - <Target Name="Make"> - <CallTarget Targets="tdbf:Make;dcltdbf:Make"/> - </Target> - <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/> -</Project> Copied: trunk/packages/Delphi12/tdbf12.groupproj (from rev 845, trunk/packages/Delphi11/tdbf11.groupproj) =================================================================== --- trunk/packages/Delphi12/tdbf12.groupproj (rev 0) +++ trunk/packages/Delphi12/tdbf12.groupproj 2023-11-12 11:59:13 UTC (rev 847) @@ -0,0 +1,48 @@ +<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> + <PropertyGroup> + <ProjectGuid>{63327AEB-D4CB-4D0C-B6B0-A45032FCC02A}</ProjectGuid> + </PropertyGroup> + <ItemGroup> + <Projects Include="tdbf.dproj"> + <Dependencies/> + </Projects> + <Projects Include="dcltdbf.dproj"> + <Dependencies>tdbf.dproj</Dependencies> + </Projects> + </ItemGroup> + <ProjectExtensions> + <Borland.Personality>Default.Personality.12</Borland.Personality> + <Borland.ProjectType/> + <BorlandProject> + <Default.Personality/> + </BorlandProject> + </ProjectExtensions> + <Target Name="tdbf"> + <MSBuild Projects="tdbf.dproj"/> + </Target> + <Target Name="tdbf:Clean"> + <MSBuild Projects="tdbf.dproj" Targets="Clean"/> + </Target> + <Target Name="tdbf:Make"> + <MSBuild Projects="tdbf.dproj" Targets="Make"/> + </Target> + <Target Name="dcltdbf" DependsOnTargets="tdbf"> + <MSBuild Projects="dcltdbf.dproj"/> + </Target> + <Target Name="dcltdbf:Clean" DependsOnTargets="tdbf:Clean"> + <MSBuild Projects="dcltdbf.dproj" Targets="Clean"/> + </Target> + <Target Name="dcltdbf:Make" DependsOnTargets="tdbf:Make"> + <MSBuild Projects="dcltdbf.dproj" Targets="Make"/> + </Target> + <Target Name="Build"> + <CallTarget Targets="tdbf;dcltdbf"/> + </Target> + <Target Name="Clean"> + <CallTarget Targets="tdbf:Clean;dcltdbf:Clean"/> + </Target> + <Target Name="Make"> + <CallTarget Targets="tdbf:Make;dcltdbf:Make"/> + </Target> + <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/> +</Project> Modified: trunk/src/dbf_common.inc =================================================================== --- trunk/src/dbf_common.inc 2023-11-12 11:41:40 UTC (rev 846) +++ trunk/src/dbf_common.inc 2023-11-12 11:59:13 UTC (rev 847) @@ -488,6 +488,35 @@ {$define DELPHI_3} {$endif} +{$ifdef VER360} // Delphi 12 + {$define DELPHI_12} + {$define DELPHI_11} + {$define DELPHI_104} + {$define DELPHI_103} + {$define DELPHI_102} + {$define DELPHI_101} + {$define DELPHI_10} + {$define DELPHI_XE8} + {$define DELPHI_XE7} + {$define DELPHI_XE6} + {$define DELPHI_XE5} + {$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 --- //------------------------------------------------------- This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <tw...@us...> - 2023-11-12 11:41:42
|
Revision: 846 http://sourceforge.net/p/tdbf/code/846 Author: twm Date: 2023-11-12 11:41:40 +0000 (Sun, 12 Nov 2023) Log Message: ----------- removed some unnecessary entries Modified Paths: -------------- trunk/packages/DelphiXE4/dcltdbf.dproj Modified: trunk/packages/DelphiXE4/dcltdbf.dproj =================================================================== --- trunk/packages/DelphiXE4/dcltdbf.dproj 2023-03-21 15:19:50 UTC (rev 845) +++ trunk/packages/DelphiXE4/dcltdbf.dproj 2023-11-12 11:41:40 UTC (rev 846) @@ -13,11 +13,6 @@ <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''"> <Base>true</Base> </PropertyGroup> - <PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Base)'=='true') or '$(Base_OSX32)'!=''"> - <Base_OSX32>true</Base_OSX32> - <CfgParent>Base</CfgParent> - <Base>true</Base> - </PropertyGroup> <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''"> <Base_Win32>true</Base_Win32> <CfgParent>Base</CfgParent> @@ -39,12 +34,6 @@ <CfgParent>Base</CfgParent> <Base>true</Base> </PropertyGroup> - <PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX32)'!=''"> - <Cfg_2_OSX32>true</Cfg_2_OSX32> - <CfgParent>Cfg_2</CfgParent> - <Cfg_2>true</Cfg_2> - <Base>true</Base> - </PropertyGroup> <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''"> <Cfg_2_Win32>true</Cfg_2_Win32> <CfgParent>Cfg_2</CfgParent> @@ -68,9 +57,6 @@ <DCC_E>false</DCC_E> <DCC_F>false</DCC_F> </PropertyGroup> - <PropertyGroup Condition="'$(Base_OSX32)'!=''"> - <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns> - </PropertyGroup> <PropertyGroup Condition="'$(Base_Win32)'!=''"> <DCC_UsePackage>tdbf;$(DCC_UsePackage)</DCC_UsePackage> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> @@ -92,9 +78,6 @@ <DCC_Optimize>false</DCC_Optimize> <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames> </PropertyGroup> - <PropertyGroup Condition="'$(Cfg_2_OSX32)'!=''"> - <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns> - </PropertyGroup> <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''"> <DCC_DcuOutput>.\dcu</DCC_DcuOutput> <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo> This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2023-03-21 15:19:52
|
Revision: 845 http://sourceforge.net/p/tdbf/code/845 Author: paulenandrew Date: 2023-03-21 15:19:50 +0000 (Tue, 21 Mar 2023) Log Message: ----------- Fix description of Delphi 10.4 Sydney runtime package Modified Paths: -------------- trunk/packages/Delphi104/tdbf.dpk Modified: trunk/packages/Delphi104/tdbf.dpk =================================================================== --- trunk/packages/Delphi104/tdbf.dpk 2023-03-21 14:52:57 UTC (rev 844) +++ trunk/packages/Delphi104/tdbf.dpk 2023-03-21 15:19:50 UTC (rev 845) @@ -25,7 +25,7 @@ {$IMAGEBASE $400000} {$DEFINE DEBUG} {$ENDIF IMPLICITBUILDING} -{$DESCRIPTION 'TDbf for Delphi 10.4 Tokyo runtime'} +{$DESCRIPTION 'TDbf for Delphi 10.4 Sydney runtime'} {$LIBSUFFIX '270'} {$RUNONLY} {$IMPLICITBUILD OFF} This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2023-03-21 14:52:59
|
Revision: 844 http://sourceforge.net/p/tdbf/code/844 Author: paulenandrew Date: 2023-03-21 14:52:57 +0000 (Tue, 21 Mar 2023) Log Message: ----------- Fix potential Range Check Error getting/setting field value Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf.pas trunk/src/dbf_common.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2023-03-03 15:36:45 UTC (rev 843) +++ trunk/doc/history.txt 2023-03-21 14:52:57 UTC (rev 844) @@ -90,6 +90,7 @@ - check can modify before attempting delete. - get exclusive access to the table, as well as index files, to rebuild indexes (fixes bug introduced in r730). - fix Access Violation packing table if filter is active +- fix potential Range Check Error getting/setting field value ------------------------ V7.0.1 Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2023-03-03 15:36:45 UTC (rev 843) +++ trunk/src/dbf.pas 2023-03-21 14:52:57 UTC (rev 844) @@ -355,11 +355,7 @@ function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override; procedure CheckDbfFieldDefs(ADbfFieldDefs: TDbfFieldDefs); - {$ifdef DELPHI_XE} - procedure DataEvent(Event: TDataEvent; Info: NativeInt); override; - {$else} - procedure DataEvent(Event: TDataEvent; Info: {$ifdef FPC_VERSION}Ptrint{$else}Longint{$endif}); override; - {$endif} + procedure DataEvent(Event: TDataEvent; Info: TDbfDataEventInfo); override; // my own methods and properties // most look like ttable functions but they are not tdataset related @@ -597,7 +593,8 @@ // TDbf(FBlobField.DataSet).SetModified(true); // is following better? seems to provide notification for user (from VCL) if not (FBlobField.DataSet.State in [dsCalcFields, dsFilter, dsNewValue]) then - TDbf(FBlobField.DataSet).DataEvent(deFieldChange, PtrInt(FBlobField)); + TDbf(FBlobField.DataSet).DataEvent(deFieldChange, + TDbfDataEventInfo(FBlobField)); end; end; Dec(FRefCount); @@ -873,7 +870,7 @@ Dst[0] := #0; end; { end of ***** fkCalculated, fkLookup ***** } if not (State in [dsCalcFields, dsFilter, dsNewValue]) then begin - DataEvent(deFieldChange, PtrInt(Field)); + DataEvent(deFieldChange, TDbfDataEventInfo(Field)); end; end; @@ -3381,11 +3378,7 @@ FieldDefs.Update; end; -{$ifdef DELPHI_XE} -procedure TDbf.DataEvent(Event: TDataEvent; Info: NativeInt); -{$else} -procedure TDbf.DataEvent(Event: TDataEvent; Info: {$ifdef FPC_VERSION}Ptrint{$else}Longint{$endif}); -{$endif} +procedure TDbf.DataEvent(Event: TDataEvent; Info: TDbfDataEventInfo); begin if ((Event = deDataSetChange) or (Event = deLayoutChange)) and Assigned(FDbfFile) and (not ControlsDisabled) then FDbfFile.ResyncSharedFlushBuffer; Modified: trunk/src/dbf_common.pas =================================================================== --- trunk/src/dbf_common.pas 2023-03-03 15:36:45 UTC (rev 843) +++ trunk/src/dbf_common.pas 2023-03-21 14:52:57 UTC (rev 844) @@ -52,6 +52,16 @@ TDbfValueBuffer = pointer; {$endif} +{$ifdef FPC_VERSION} + TDbfDataEventInfo = Ptrint; +{$else} +{$ifdef DELPHI_XE} + TDbfDataEventInfo = NativeInt; +{$else} + TDbfDataEventInfo = Longint; +{$endif} +{$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: <pau...@us...> - 2023-03-03 15:36:52
|
Revision: 843 http://sourceforge.net/p/tdbf/code/843 Author: paulenandrew Date: 2023-03-03 15:36:45 +0000 (Fri, 03 Mar 2023) Log Message: ----------- Fix AV packing table if filter is active The parser for the filter may have a reference to a field def, but restructuring the table recreates field defs, invalidating the reference. Reparse the filter expression to get a new valid reference. Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2023-01-20 15:27:24 UTC (rev 842) +++ trunk/doc/history.txt 2023-03-03 15:36:45 UTC (rev 843) @@ -89,6 +89,7 @@ - fix "Division by zero" error in TDbf Viewer opening a file that does not exist. - check can modify before attempting delete. - get exclusive access to the table, as well as index files, to rebuild indexes (fixes bug introduced in r730). +- fix Access Violation packing table if filter is active ------------------------ V7.0.1 Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2023-01-20 15:27:24 UTC (rev 842) +++ trunk/src/dbf.pas 2023-03-03 15:36:45 UTC (rev 843) @@ -1777,6 +1777,8 @@ end; // reselect index IndexName := oldIndexName; + // reset filter, to account for field defs being re-created + ParseFilter(Filter); // reset cursor position First; end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2023-01-20 15:27:27
|
Revision: 842 http://sourceforge.net/p/tdbf/code/842 Author: paulenandrew Date: 2023-01-20 15:27:24 +0000 (Fri, 20 Jan 2023) Log Message: ----------- Fix compiler error in Delphi version older than 3 This fixes a side effect of revision 831. Revision Links: -------------- http://sourceforge.net/p/tdbf/code/831 Modified Paths: -------------- trunk/src/dbf.pas Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2023-01-20 15:25:35 UTC (rev 841) +++ trunk/src/dbf.pas 2023-01-20 15:27:24 UTC (rev 842) @@ -1084,7 +1084,11 @@ begin // check can modify if not CanModify then +{$ifdef DELPHI_3} DatabaseError(SDataSetReadOnly, Self); +{$else} + DatabaseError(SDataSetReadOnly); +{$endif} // start editing if not(State in [dsEdit, dsInsert]) then begin This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2023-01-20 15:25:36
|
Revision: 841 http://sourceforge.net/p/tdbf/code/841 Author: paulenandrew Date: 2023-01-20 15:25:35 +0000 (Fri, 20 Jan 2023) Log Message: ----------- Check that field size is non-zero Modified Paths: -------------- trunk/src/dbf.pas Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2023-01-20 15:25:05 UTC (rev 840) +++ trunk/src/dbf.pas 2023-01-20 15:25:35 UTC (rev 841) @@ -1583,6 +1583,12 @@ TempDef.NativeFieldType, ['C', 'F', 'N', 'D', 'L', 'M']))) then raise EDbfError.CreateFmt(STRING_INVALID_FIELD_TYPE, [FieldTypeStr(TempDef.NativeFieldType), TempDef.FieldName]); + if TempDef.Size = 0 then +{$ifdef DELPHI_3} + DatabaseError(SInvalidFieldSize, Self); +{$else} + DatabaseError(SInvalidFieldSize); +{$endif} end; end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2023-01-20 15:25:06
|
Revision: 840 http://sourceforge.net/p/tdbf/code/840 Author: paulenandrew Date: 2023-01-20 15:25:05 +0000 (Fri, 20 Jan 2023) Log Message: ----------- Check that native field type is valid If the native to VCL translation failed, the native field type is invalid. Modified Paths: -------------- trunk/src/dbf.pas Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2023-01-20 15:23:23 UTC (rev 839) +++ trunk/src/dbf.pas 2023-01-20 15:25:05 UTC (rev 840) @@ -1579,11 +1579,10 @@ begin // check dbffielddefs for errors TempDef := ADbfFieldDefs.Items[I]; - 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; + if (TempDef.FieldType = ftUnknown) or ((FTableLevel < 7) and (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; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2023-01-20 15:23:25
|
Revision: 839 http://sourceforge.net/p/tdbf/code/839 Author: paulenandrew Date: 2023-01-20 15:23:23 +0000 (Fri, 20 Jan 2023) Log Message: ----------- Check that field count is non-zero Modified Paths: -------------- trunk/src/dbf.pas Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2023-01-20 15:22:53 UTC (rev 838) +++ trunk/src/dbf.pas 2023-01-20 15:23:23 UTC (rev 839) @@ -1573,6 +1573,8 @@ begin if ADbfFieldDefs = nil then exit; + if ADbfFieldDefs.Count = 0 then + raise EDbfError.Create(STRING_INVALID_DBF_FILE); for I := 0 to ADbfFieldDefs.Count - 1 do begin // check dbffielddefs for errors This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2023-01-20 15:22:55
|
Revision: 838 http://sourceforge.net/p/tdbf/code/838 Author: paulenandrew Date: 2023-01-20 15:22:53 +0000 (Fri, 20 Jan 2023) Log Message: ----------- Treat + the same as other level 7 types `DbfVersion` is not required when the field defs are defined, but should be set in cases where the native to VCL translation depends on it. It is set based on `TableLevel` when the table is created. Modified Paths: -------------- trunk/src/dbf_fields.pas Modified: trunk/src/dbf_fields.pas =================================================================== --- trunk/src/dbf_fields.pas 2023-01-20 15:21:43 UTC (rev 837) +++ trunk/src/dbf_fields.pas 2023-01-20 15:22:53 UTC (rev 838) @@ -341,11 +341,7 @@ procedure TDbfFieldDef.NativeToVCL; begin case FNativeFieldType of -// OH 2000-11-15 dBase7 support. -// Add the new fieldtypes - '+' : - if DbfVersion = xBaseVII then - FFieldType := ftAutoInc; + '+' : FFieldType := ftAutoInc; 'I' : FFieldType := ftInteger; 'O' : FFieldType := ftFloat; '@', 'T': This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2023-01-20 15:21:49
|
Revision: 837 http://sourceforge.net/p/tdbf/code/837 Author: paulenandrew Date: 2023-01-20 15:21:43 +0000 (Fri, 20 Jan 2023) Log Message: ----------- Do not clear native field type If the native field type is invalid, the error message references its value. Modified Paths: -------------- trunk/src/dbf_fields.pas Modified: trunk/src/dbf_fields.pas =================================================================== --- trunk/src/dbf_fields.pas 2023-01-20 15:20:51 UTC (rev 836) +++ trunk/src/dbf_fields.pas 2023-01-20 15:21:43 UTC (rev 837) @@ -388,7 +388,6 @@ FFieldType := ftCurrency; '0' : FFieldType := ftBytes; { Visual FoxPro ``_NullFlags'' } else - FNativeFieldType := #0; FFieldType := ftUnknown; end; //case end; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2023-01-20 15:20:53
|
Revision: 836 http://sourceforge.net/p/tdbf/code/836 Author: paulenandrew Date: 2023-01-20 15:20:51 +0000 (Fri, 20 Jan 2023) Log Message: ----------- Validate field definitions before creating table Modified Paths: -------------- trunk/doc/history.txt trunk/src/dbf.pas Modified: trunk/doc/history.txt =================================================================== --- trunk/doc/history.txt 2022-09-06 14:17:18 UTC (rev 835) +++ trunk/doc/history.txt 2023-01-20 15:20:51 UTC (rev 836) @@ -231,6 +231,7 @@ - fix compiler errors in Delphi XE, mostly related to use of PChar instead of PAnsiChar - fix to allow all 32 characters of a level 7 index tag name to be used - fix compiler information and warning messages in Free Pascal, mostly related to unused parameters or uninitialized var parameters +- validate field definitions before creating a table following changes thx lploeger: Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2022-09-06 14:17:18 UTC (rev 835) +++ trunk/src/dbf.pas 2023-01-20 15:20:51 UTC (rev 836) @@ -1625,6 +1625,9 @@ end; end; + // check field defs for errors + CheckDbfFieldDefs(ADbfFieldDefs); + InitDbfFile(pfExclusiveCreate); FDbfFile.CopyDateTimeAsString := FInCopyFrom and FCopyDateTimeAsString; FDbfFile.DbfVersion := TableLevelToDbfVersion(FTableLevel); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2022-09-06 14:17:20
|
Revision: 835 http://sourceforge.net/p/tdbf/code/835 Author: paulenandrew Date: 2022-09-06 14:17:18 +0000 (Tue, 06 Sep 2022) Log Message: ----------- Fix W1000 Symbol is deprecated Modified Paths: -------------- trunk/src/dbf.pas Modified: trunk/src/dbf.pas =================================================================== --- trunk/src/dbf.pas 2022-09-06 13:56:12 UTC (rev 834) +++ trunk/src/dbf.pas 2022-09-06 14:17:18 UTC (rev 835) @@ -966,7 +966,7 @@ pRecord^.BookmarkData.PhysicalRecNo := FCursor.PhysicalRecNo; pRecord^.BookmarkFlag := bfCurrent; pRecord^.SequentialRecNo := FCursor.SequentialRecNo; - GetCalcFields(Buffer); + GetCalcFields(TDbfRecBuf(Buffer)); if Filtered or FFindRecordFilter then begin This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <pau...@us...> - 2022-09-06 13:56:16
|
Revision: 834 http://sourceforge.net/p/tdbf/code/834 Author: paulenandrew Date: 2022-09-06 13:56:12 +0000 (Tue, 06 Sep 2022) Log Message: ----------- Fix W1057 Implicit string cast Modified Paths: -------------- trunk/src/dbf_idxfile.pas Modified: trunk/src/dbf_idxfile.pas =================================================================== --- trunk/src/dbf_idxfile.pas 2022-08-18 18:39:45 UTC (rev 833) +++ trunk/src/dbf_idxfile.pas 2022-09-06 13:56:12 UTC (rev 834) @@ -656,8 +656,8 @@ end; if Result then begin - StringValue := '0' + AnsiChar(DecimalSeparator) + - PAnsiChar(@FloatRec.Digits) + 'E' + + StringValue := AnsiChar('0') + AnsiChar(DecimalSeparator) + + PAnsiChar(@FloatRec.Digits) + AnsiChar('E') + AnsiString(IntToStr(FloatRec.Exponent)); if FloatRec.Negative then StringValue := '-' + StringValue; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |