From b88379ebc468125f9606f2284e27cb85360c5965 Mon Sep 17 00:00:00 2001 From: Roniery Santos Cardoso Date: Sat, 6 Sep 2025 13:58:44 -0300 Subject: [PATCH] =?UTF-8?q?Adi=C3=A7=C3=A3o=20de=20TExtendedField=20e=20co?= =?UTF-8?q?rre=C3=A7=C3=B5es=20em=20JSON,=20Buffer=20e=20Massive?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit feat: adicionar TExtendedField registrado no IDE (Lazarus/Delphi) fix(json): corrigir serialização e destruição de arrays no serializador fix(restdwmemtable): corrigir TExtendedValue no SetBuffer (Lazarus) fix(buffer): ajuste no Buffer para Delphi fix(massive): corrigir comportamento de Massive em Delphi/Lazarus chore(cgi): atualizar módulo CGI no Lazarus chore(ui): modificar formulário --- .../Lazarus/RESTDataWareComponents.lpk | 2 +- CORE/Source/Basic/uRESTDWBasicDB.pas | 4 +- .../Memdataset/uRESTDWMemoryDataset.pas | 55 +++++++++++++++---- CORE/Source/utils/JSON/uRESTDWDataJSON.pas | 11 +++- CORE/Source/utils/JSON/uRESTDWJSON.pas | 3 +- CORE/Source/utils/uRESTDWMassiveBuffer.pas | 6 +- 6 files changed, 60 insertions(+), 21 deletions(-) diff --git a/CORE/Packages/Lazarus/RESTDataWareComponents.lpk b/CORE/Packages/Lazarus/RESTDataWareComponents.lpk index 74e474c3..0d17e77f 100644 --- a/CORE/Packages/Lazarus/RESTDataWareComponents.lpk +++ b/CORE/Packages/Lazarus/RESTDataWareComponents.lpk @@ -21,7 +21,7 @@ - + diff --git a/CORE/Source/Basic/uRESTDWBasicDB.pas b/CORE/Source/Basic/uRESTDWBasicDB.pas index 3a63a5e0..adc041a8 100644 --- a/CORE/Source/Basic/uRESTDWBasicDB.pas +++ b/CORE/Source/Basic/uRESTDWBasicDB.pas @@ -742,7 +742,7 @@ interface vBookmark : Integer; vActive, vInactive : Boolean; - Procedure InternalPost; overload; // Gilberto Rocha 12/04/2019 - usado para poder fazer datasource.dataset.Post + Procedure InternalPost; override; // Gilberto Rocha 12/04/2019 - usado para poder fazer datasource.dataset.Post procedure InternalOpen; override; // Gilberto Rocha 03/09/2021 - usado para poder fazer datasource.dataset.Open Function GetRecordCount : Integer; Override; procedure InternalRefresh; overload; // Gilberto Rocha 03/09/2021 - usado para poder fazer datasource.dataset.Refresh @@ -9069,7 +9069,7 @@ procedure TRESTDWTable.InternalOpen; Procedure TRESTDWClientSQL.InternalPost; Begin - Inherited; + Inherited InternalPost; End; procedure TRESTDWClientSQL.InternalOpen; diff --git a/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas b/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas index 578229c9..5e72d4ed 100644 --- a/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas +++ b/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas @@ -60,6 +60,7 @@ SMinIndexes = 'The minimum amount of indexes is 1'; SIndexNotFound = 'Index ''%s'' not found'; SUniDirectional = 'Operation cannot be performed on an unidirectional dataset'; + SFieldRequired = 'Field ''%s'' must have a value'; Type TCompareFunc = Function(subValue, @@ -648,6 +649,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Procedure InternalDelete; Override; Procedure InternalPost; Override; Procedure InternalClose; Override; + procedure CheckRequiredFields; Procedure InternalHandleException; Override; Procedure InternalInitFieldDefs; Override; Procedure InternalOpen; Override; @@ -817,6 +819,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Property IndexName : String Read GetIndexName Write SetIndexName; Property IndexFieldNames : String Read GetIndexFieldNames Write SetIndexFieldNames; Property MaxIndexesCount : Integer Read FMaxIndexesCount Write SetMaxIndexesCount default 2; + Property Filter; Property BeforeOpen; Property AfterOpen; Property BeforeClose; @@ -972,9 +975,11 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Private vSize, vPrecision : Integer; + Procedure SetAsExtended(Const AValue : Extended); Protected - Function GetAsString : String; Override; - Function GetAsVariant : Variant; Override; + Function GetAsString : String; Override; + Procedure SetAsString (Const AValue : String); Override; +// Function GetAsVariant : Variant; Override; Public Constructor Create(AOwner: TComponent); override; Property Size : Integer Read vSize Write vSize; @@ -1423,6 +1428,26 @@ TMemBookmarkInfo = record vPrecision := 8; End; +{$IFDEF FPC} +Procedure TExtendedField.SetAsExtended(Const AValue : Extended); +Begin + SetData(@AValue, True); +End; + +Procedure TExtendedField.SetAsString(Const AValue : String); +Var + x : Extended; +Begin + If AValue = '' Then + Clear + Else + Begin + x := StrToFloat(AValue); + SetAsExtended(x); + End; +End; +{$ENDIF} + Function TExtendedField.GetAsString: string; Var x : Extended; @@ -1515,13 +1540,6 @@ TMemBookmarkInfo = record End; {$ENDIF} -{$IFDEF FPC} -Function TExtendedField.GetAsVariant : Variant; -Begin - Result := Extended(Value); //_RealSupportManager._VarFromReal(Value); -End; -{$ENDIF} - Function TRESTDWMTMemoryRecord.GetIndex: Integer; Begin // If FMemoryData <> nil then @@ -2699,8 +2717,9 @@ function TRESTDWMemTable.GetActiveRecBuf(var RecBuf: PRESTDWMTMemBuffer End Else If Field.datatype = ftExtended Then Begin - Move(aDataBytes[1], Pointer(@vLongDouble)^, SizeOf(DWLongDouble)); - PExtended(Buffer)^ := vLongDouble; + If Length(TRESTDWBytes(Buffer)) = 0 Then + SetLength(TRESTDWBytes(Buffer), cLen); + Move(aDataBytes[1], Pointer(Buffer)^, SizeOf(DWLongDouble)); End Else Begin @@ -3084,6 +3103,8 @@ procedure TRESTDWMemTable.InternalSetFieldData(Field : TField; dwftFloat, {$IFNDEF FPC} dwftFMTBCD, + {$ELSE} + 45, {$ENDIF} dwftBCD, dwftCurrency, @@ -5422,6 +5443,18 @@ procedure TRESTDWMemTable.InternalDelete; End; End; +procedure TRESTDWMemTable.CheckRequiredFields; +var + I: Integer; +begin + for I := 0 to Fields.Count - 1 do + if Fields[I].Required and not Fields[I].ReadOnly and (Fields[I].FieldKind = fkData) and Fields[I].IsNull then + begin + Fields[I].FocusControl; + DatabaseErrorFmt(SFieldRequired, [Fields[I].DisplayName]); + end; +end; + procedure TRESTDWMemTable.InternalPost; var RecPos: Integer; diff --git a/CORE/Source/utils/JSON/uRESTDWDataJSON.pas b/CORE/Source/utils/JSON/uRESTDWDataJSON.pas index b591cd01..8bab5151 100644 --- a/CORE/Source/utils/JSON/uRESTDWDataJSON.pas +++ b/CORE/Source/utils/JSON/uRESTDWDataJSON.pas @@ -1424,6 +1424,7 @@ vReal : Real; bJsonValue : TRESTDWJSONInterfaceObject; JSONBase : TRESTDWJSONBase; + vString, DecimalLocal : String; begin {$IF Defined(RESTDWLAZARUS) or not Defined(DELPHIXEUP)} @@ -1439,12 +1440,15 @@ Begin For I := 0 To bJsonValue.PairCount -1 Do Begin + vString := Trim(bJsonValue.pairs[I].Value); If (Lowercase(bJsonValue.pairs[I].classname) = Lowercase('TJSONObject')) Or (Lowercase(bJsonValue.pairs[I].classname) = Lowercase('TDWJSONObject')) Or (Lowercase(bJsonValue.pairs[I].classname) = Lowercase('TJSONArray')) Or - (Lowercase(bJsonValue.pairs[I].classname) = Lowercase('TDWJSONArray')) Then + (Lowercase(bJsonValue.pairs[I].classname) = Lowercase('TDWJSONArray')) Or + ((Lowercase(bJsonValue.pairs[I].classname) = '_string') And (vString <> '') And + ((vString[InitStrPos] = '[')) And (vString[Length(vString) - FinalStrPos] = ']')) Then Begin - JSONBase := TRESTDWJSONBase.Create(bJsonValue.pairs[I].Value); + JSONBase := TRESTDWJSONBase.Create(vString); // If bJsonValue.pairs[I].Name <> '' Then If Assigned(JSONBase) Then If bJsonValue.pairs[I].Name <> '' Then @@ -1478,7 +1482,8 @@ If (bJsonValue.pairs[I].Value <> cNullvalue) And (bJsonValue.pairs[I].Value <> cNullvalueTag) Then Begin - vReal := StrToFloat(StringReplace(bJsonValue.pairs[I].Value, '.', DecimalLocal, [rfReplaceAll])); + vReal := StrToFloat(StringReplace(StringReplace(bJsonValue.pairs[I].Value, '.', DecimalLocal, [rfReplaceAll]), + '"', '', [rfReplaceAll])); AddFloat(bJsonValue.pairs[I].Name, vReal); End Else diff --git a/CORE/Source/utils/JSON/uRESTDWJSON.pas b/CORE/Source/utils/JSON/uRESTDWJSON.pas index aa613bcb..6d317856 100644 --- a/CORE/Source/utils/JSON/uRESTDWJSON.pas +++ b/CORE/Source/utils/JSON/uRESTDWJSON.pas @@ -2284,7 +2284,8 @@ destructor TJSONArray.destroy; obj := TObject(myArrayList[0]); myArrayList [0] := nil; If (obj <> CONST_FALSE) And - (obj <> CONST_TRUE) Then + (obj <> CONST_TRUE) And + (obj <> CNULL) Then FreeAndNil(obj); myArrayList.Delete(0); end; diff --git a/CORE/Source/utils/uRESTDWMassiveBuffer.pas b/CORE/Source/utils/uRESTDWMassiveBuffer.pas index f8db3450..ba37a165 100644 --- a/CORE/Source/utils/uRESTDWMassiveBuffer.pas +++ b/CORE/Source/utils/uRESTDWMassiveBuffer.pas @@ -1535,9 +1535,9 @@ implementation End; End; End; - {$IFDEF DELPHIXEUP}ftSingle, ftFMTBcd,{$ENDIF} - ftFloat, ftCurrency, - ftBCD : Begin + {$IFDEF DELPHIXEUP}ftSingle, {$ENDIF} + ftFloat, ftCurrency, + ftFMTBcd, ftBCD : Begin If Not UpdateTag Then Begin If Field.IsNull Then