From 65e3ab11fe02afed5836d8278fd3bb9dcb33f000 Mon Sep 17 00:00:00 2001 From: Roniery Santos Cardoso Date: Tue, 18 Feb 2025 08:22:40 -0300 Subject: [PATCH] =?UTF-8?q?Novas=20Atualiza=C3=A7=C3=B5es?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- ### **Correções e Melhorias para Lazarus/FPC** - Correções de compilação para **Lazarus e FPC**. - Correção de `FreeMem` para Lazarus/Delphi antigos no binário. - Correção para **set de dados Timestamp** em Lazarus/FPC. - Correção no `ServerContext` em **modo visual** para Lazarus/Delphi. - Correção de `IndexDefs`. - Ajustes na **IDE**, nome de eventos e parâmetros dos eventos no Lazarus. ### **Ajustes e Melhorias em Exemplos/Demos** - Correção do exemplo **FileTransfer** para Lazarus no Windows. - Correção do exemplo **Client do FileTransfer**. - Correção do exemplo **FullClient**, permitindo que, ao clicar no título, um índice seja selecionado no campo correspondente via `IndexDefs`. - Melhoria no exemplo **ClientSQL**. - Ajustes gerais nos **demos** para Lazarus e Delphi. ### **Correções e Melhorias Gerais** - Correção no `Get Server Events`. - Correção de `DriverBase` para gravação de **dados nulos** em campos `Data`. - Ajuste de `UTF-8` para **campos string**. - Suporte a **campos UID** adicionado. - Correção de **compilação para Lazarus e Delphi antigos**. --- --- CORE/Source/Basic/uRESTDWBasicDB.pas | 6 +- CORE/Source/Basic/uRESTDWParams.pas | 24 ++-- CORE/Source/Basic/uRESTDWServerContext.pas | 69 +++++---- CORE/Source/Basic/uRESTDWServerEvents.pas | 12 +- CORE/Source/Consts/uRESTDWConsts.pas | 8 +- .../Database_Drivers/uRESTDWDriverBase.pas | 6 +- .../Memdataset/uRESTDWMemoryDataset.pas | 134 ++++++++++++------ .../Plugins/SQLEditor/uRESTDWSqlEditor.dfm | 1 + .../Plugins/SQLEditor/uRESTDWSqlEditor.lfm | 38 +++-- .../Plugins/SQLEditor/uRESTDWSqlEditor.pas | 4 +- CORE/Source/utils/uRESTDWMassiveBuffer.pas | 6 +- 11 files changed, 186 insertions(+), 122 deletions(-) diff --git a/CORE/Source/Basic/uRESTDWBasicDB.pas b/CORE/Source/Basic/uRESTDWBasicDB.pas index 67c4b286c..3acd2064a 100644 --- a/CORE/Source/Basic/uRESTDWBasicDB.pas +++ b/CORE/Source/Basic/uRESTDWBasicDB.pas @@ -23,10 +23,8 @@ Roniery - Devel. } -{$IFNDEF RESTDWLAZARUS} - {$IFDEF FPC} - {$MODE OBJFPC}{$H+} - {$ENDIF} +{$IFDEF FPC} + {$MODE OBJFPC}{$H+} {$ENDIF} interface diff --git a/CORE/Source/Basic/uRESTDWParams.pas b/CORE/Source/Basic/uRESTDWParams.pas index b83cee3c9..85ad94600 100644 --- a/CORE/Source/Basic/uRESTDWParams.pas +++ b/CORE/Source/Basic/uRESTDWParams.pas @@ -22,10 +22,8 @@ Roniery - Devel. } -{$IFNDEF RESTDWLAZARUS} - {$IFDEF FPC} - {$MODE OBJFPC}{$H+} - {$ENDIF} +{$IFDEF FPC} + {$MODE OBJFPC}{$H+} {$ENDIF} @@ -261,20 +259,22 @@ interface vTypeObject : TTypeObject; vObjectDirection : TObjectDirection; vObjectValue : TObjectValue; + FName, vAlias, vDefaultValue, vParamName : String; vEncoded : Boolean; + Property Name : String Read GetDisplayName Write SetDisplayName; Public - Function GetDisplayName : String; {$IFNDEF FPC}Override;{$ENDIF} - Procedure SetDisplayName(Const Value : String); {$IFNDEF FPC}Override;{$ENDIF} - Constructor Create (aCollection : TCollection); {$IFNDEF FPC}Override;{$ENDIF} + Function GetDisplayName : String; Override; + Procedure SetDisplayName(Const Value : String); Override; + Constructor Create (aCollection : TCollection); Override; Published Property TypeObject : TTypeObject Read vTypeObject Write vTypeObject; Property ObjectDirection : TObjectDirection Read vObjectDirection Write vObjectDirection; Property ObjectValue : TObjectValue Read vObjectValue Write vObjectValue; Property Alias : String Read vAlias Write vAlias; - Property ParamName : String Read GetDisplayName Write SetDisplayName; + Property ParamName : String Read FName Write FName; Property Encoded : Boolean Read vEncoded Write vEncoded; Property DefaultValue : String Read vDefaultValue Write vDefaultValue; End; @@ -681,7 +681,8 @@ implementation vTypeObject := toParam; vObjectDirection := odINOUT; vObjectValue := ovString; - vParamName := 'dwparam' + IntToStr(aCollection.Count); + vParamName := 'dwparam' + IntToStr(aCollection.Count); + FName := vParamName; vEncoded := True; vDefaultValue := ''; vAlias := ''; @@ -689,7 +690,7 @@ implementation function TRESTDWParamMethod.GetDisplayName: String; begin - Result := vParamName; + Result := FName; end; procedure TRESTDWParamMethod.SetDisplayName(const Value: String); @@ -699,6 +700,7 @@ procedure TRESTDWParamMethod.SetDisplayName(const Value: String); Else Begin vParamName := Trim(Value); + FName := vParamName; Inherited SetDisplayName(Value); End; end; @@ -1687,7 +1689,7 @@ procedure TRESTDWParamsMethods.PutRecName(Index: String; Item: TRESTDWParamMetho Result := vNewFieldList Else Begin - {$IFDEF RESTDWLAZARUS} + {$IFDEF FPC} Result := @aNewFieldList; {$ELSE} {$IFNDEF FPC} diff --git a/CORE/Source/Basic/uRESTDWServerContext.pas b/CORE/Source/Basic/uRESTDWServerContext.pas index 7b76a486b..69c655511 100644 --- a/CORE/Source/Basic/uRESTDWServerContext.pas +++ b/CORE/Source/Basic/uRESTDWServerContext.pas @@ -94,22 +94,22 @@ interface vOwnerCollection : TCollection; Procedure SetContextScript(Value : TStrings); Public - Function GetDisplayName : String; {$IFNDEF FPC}Override;{$ENDIF} - Procedure SetDisplayName (Const Value : String); {$IFNDEF FPC}Override;{$ENDIF} - Function GetNamePath : String; {$IFNDEF FPC}Override;{$ENDIF} - Procedure Assign (Source : TPersistent); Override; - Constructor Create (aCollection : TCollection); Override; + Function GetDisplayName : String; Override; + Procedure SetDisplayName (Const Value : String); Override; + Function GetNamePath : String; Override; + Procedure Assign (Source : TPersistent); Override; + Constructor Create (aCollection : TCollection); Override; Destructor Destroy; Override; Function BuildClass : String; Published - Property ContextTag : String Read vContextTag Write vContextTag; - Property TypeItem : String Read vType Write vType; - Property ClassItem : String Read vClass Write vClass; - Property TagID : String Read vTagID Write vTagID; - Property TagReplace : String Read vTagReplace Write vTagReplace; - Property css : String Read vCss Write vCss; - Property ContextScript : TStrings Read vContextScript Write SetContextScript; - Property ObjectName : String Read FName Write FName; + Property ContextTag : String Read vContextTag Write vContextTag; + Property TypeItem : String Read vType Write vType; + Property ClassItem : String Read vClass Write vClass; + Property TagID : String Read vTagID Write vTagID; + Property TagReplace : String Read vTagReplace Write vTagReplace; + Property css : String Read vCss Write vCss; + Property ContextScript : TStrings Read vContextScript Write SetContextScript; + Property ObjectName : String Read FName Write FName; Property OnRequestExecute : TRESTDWMarkRequest Read vDWMarkRequest Write vDWMarkRequest; Property OnBeforeRendererContextItem : TRESTDWGetContextItemTag Read vDWGetContextItemTag Write vDWGetContextItemTag; End; @@ -180,6 +180,9 @@ interface Type TRESTDWContext = Class; PDWContext = ^TRESTDWContext; + + { TRESTDWContext } + TRESTDWContext = Class(TCollectionItem) Protected Private @@ -208,6 +211,8 @@ interface Function GetBeforeRenderer : TRESTDWBeforeRenderer; Procedure SetBeforeRenderer (Value : TRESTDWBeforeRenderer); Procedure SetBaseURL(Value : String); + Procedure SetContextName(Value : String); + Property Name : String Read GetDisplayName Write SetDisplayName; Public Function GetDisplayName : String; Override; Procedure SetDisplayName(Const Value : String); Override; @@ -219,9 +224,8 @@ interface Published Property Params : TRESTDWParamsMethods Read vDWParams Write vDWParams; Property ContentType : String Read vContentType Write vContentType; - Property Name : String Read GetDisplayName Write SetDisplayName; Property BaseURL : String Read vBaseURL Write SetBaseURL; - Property ContextName : String Read vContextName Write vContextName; + Property ContextName : String Read vContextName Write SetContextName; Property DefaultHtml : TStrings Read vDefaultHtml Write SetDefaultPage; Property Description : TStrings Read vDescription Write SetDescription; Property Routes : TRESTDWRoutes Read vDWRoutes Write vDWRoutes; @@ -301,7 +305,7 @@ implementation { TRESTDWContext } -Function TRESTDWContext.GetNamePath: String; +function TRESTDWContext.GetNamePath: String; Begin Result := vOwnerCollection.GetNamePath + FName; End; @@ -314,7 +318,7 @@ constructor TRESTDWContext.Create(aCollection: TCollection); DWReplyRequestData := TRESTDWReplyRequestData.Create(Nil); vOwnerCollection := aCollection; FName := 'dwcontext' + IntToStr(aCollection.Count); - vContextName := ''; + vContextName := FName; vBaseURL := '/'; DWReplyRequestData.Name := FName; vDWRoutes := TRESTDWRoutes.Create; @@ -335,17 +339,17 @@ destructor TRESTDWContext.Destroy; inherited; end; -Function TRESTDWContext.GetBeforeRenderer: TRESTDWBeforeRenderer; +function TRESTDWContext.GetBeforeRenderer: TRESTDWBeforeRenderer; Begin Result := vDWBeforeRenderer; End; -Function TRESTDWContext.GetDisplayName: String; +function TRESTDWContext.GetDisplayName: String; Begin - Result := DWReplyRequestData.Name; + Result := FName; End; -Procedure TRESTDWContext.CompareParams(Var Dest : TRESTDWParams); +procedure TRESTDWContext.CompareParams(var Dest: TRESTDWParams); Var I : Integer; Begin @@ -364,7 +368,7 @@ destructor TRESTDWContext.Destroy; End; End; -Procedure TRESTDWContext.Assign(Source: TPersistent); +procedure TRESTDWContext.Assign(Source: TPersistent); begin If Source is TRESTDWContext then Begin @@ -376,17 +380,17 @@ destructor TRESTDWContext.Destroy; Inherited; End; -Function TRESTDWContext.GetReplyRequestStream: TRESTDWReplyRequestStream; +function TRESTDWContext.GetReplyRequestStream: TRESTDWReplyRequestStream; Begin Result := DWReplyRequestData.OnReplyRequestStream; End; -Function TRESTDWContext.GetReplyRequest: TRESTDWReplyRequest; +function TRESTDWContext.GetReplyRequest: TRESTDWReplyRequest; Begin Result := DWReplyRequestData.OnReplyRequest; End; -Procedure TRESTDWContext.SetBaseURL(Value : String); +procedure TRESTDWContext.SetBaseURL(Value: String); Var vTempValue : String; Begin @@ -403,12 +407,18 @@ destructor TRESTDWContext.Destroy; End; End; -Procedure TRESTDWContext.SetBeforeRenderer(Value: TRESTDWBeforeRenderer); +Procedure TRESTDWContext.SetContextName(Value: String); +Begin + FName := Trim(Value); + vContextName := FName; +End; + +procedure TRESTDWContext.SetBeforeRenderer(Value: TRESTDWBeforeRenderer); Begin vDWBeforeRenderer := Value; End; -Procedure TRESTDWContext.SetDescription(Strings : TStrings); +procedure TRESTDWContext.SetDescription(Strings: TStrings); begin vDescription.Assign(Strings); end; @@ -418,7 +428,7 @@ procedure TRESTDWContext.SetDefaultPage(Strings: TStrings); vDefaultHtml.Assign(Strings); end; -Procedure TRESTDWContext.SetDisplayName(Const Value: String); +procedure TRESTDWContext.SetDisplayName(const Value: String); Begin If Trim(Value) = '' Then Raise Exception.Create(cInvalidContextName) @@ -432,7 +442,8 @@ procedure TRESTDWContext.SetDefaultPage(Strings: TStrings); End; End; -Procedure TRESTDWContext.SetReplyRequestStream(Value : TRESTDWReplyRequestStream); +procedure TRESTDWContext.SetReplyRequestStream(Value: TRESTDWReplyRequestStream + ); begin DWReplyRequestData.OnReplyRequestStream := Value; end; diff --git a/CORE/Source/Basic/uRESTDWServerEvents.pas b/CORE/Source/Basic/uRESTDWServerEvents.pas index daf956baa..2074a6612 100644 --- a/CORE/Source/Basic/uRESTDWServerEvents.pas +++ b/CORE/Source/Basic/uRESTDWServerEvents.pas @@ -92,6 +92,7 @@ interface Procedure SetBaseUrl (Value : String); Procedure SetContentType(Value : String); Procedure SetDataMode (Value : TDataMode); + Property Name : String Read GetDisplayName Write SetDisplayName; Public Function GetDisplayName : String; Override; Procedure SetDisplayName(Const Value : String); Override; @@ -104,8 +105,7 @@ interface Property Routes : TRESTDWRoutes Read vDWRoutes Write vDWRoutes; Property Params : TRESTDWParamsMethods Read vDWParams Write vDWParams; Property DataMode : TDataMode Read vDataMode Write SetDataMode; - Property Name : String Read GetDisplayName Write SetDisplayName; - Property EventName : String Read vEventName Write vEventName; + Property EventName : String Read FName Write FName; Property BaseURL : String Read vBaseURL Write SetBaseURL; Property DefaultContentType : String Read vContentType Write SetContentType; Property CallbackEvent : Boolean Read vCallbackEvent Write vCallbackEvent; @@ -171,7 +171,7 @@ interface Var DWParams : TRESTDWParams); Published Property IgnoreInvalidParams : Boolean Read vIgnoreInvalidParams Write vIgnoreInvalidParams; - Property Events : TRESTDWEventList Read vEventList Write vEventList; + Property Events : TRESTDWEventList Read vEventList Write vEventList; Property AccessTag : String Read vAccessTag Write vAccessTag; Property DefaultEvent : String Read vDefaultEvent Write vDefaultEvent; Property OnCreate : TObjectEvent Read vOnCreate Write vOnCreate; @@ -268,7 +268,7 @@ constructor TRESTDWEvent.Create(aCollection: TCollection); Function TRESTDWEvent.GetDisplayName: String; Begin - Result := DWReplyEventData.Name; + Result := FName; End; Procedure TRESTDWEvent.Assign(Source: TPersistent); @@ -802,8 +802,8 @@ procedure TRESTDWClientEvents.GetOnlineEvents(Value: Boolean); If Assigned(vRESTClientPooler.OnBeforeExecute) Then vRESTClientPooler.OnBeforeExecute(Self); DWParams := TRESTDWParams.Create; - DWParams.CriptOptions.Use := CriptOptions.Use; - DWParams.CriptOptions.Key := CriptOptions.Key; +// DWParams.CriptOptions.Use := CriptOptions.Use; +// DWParams.CriptOptions.Key := CriptOptions.Key; JSONParam := TRESTDWJSONParam.Create(RESTClientPoolerExec.Encoding); JSONParam.ParamName := 'dwservereventname'; JSONParam.ObjectDirection := odIn; diff --git a/CORE/Source/Consts/uRESTDWConsts.pas b/CORE/Source/Consts/uRESTDWConsts.pas index 70a2cf354..38994e8fb 100644 --- a/CORE/Source/Consts/uRESTDWConsts.pas +++ b/CORE/Source/Consts/uRESTDWConsts.pas @@ -22,10 +22,8 @@ Roniery - Devel. } -{$IFNDEF RESTDWLAZARUS} - {$IFDEF FPC} - {$MODE OBJFPC}{$H+} - {$ENDIF} +{$IFDEF FPC} + {$MODE OBJFPC}{$H+} {$ENDIF} Interface @@ -62,7 +60,7 @@ // controle de versão RESTDWVersionINFO = 'v2.1.0-'; - RESTDWRelease = '3920'; + RESTDWRelease = '3933'; RESTDWCodeProject = 'Galaga - Github'; RESTDWVersao = RESTDWVersionINFO + RESTDWRelease + '(' + RESTDWCodeProject + ')'; RESTDWDialogoTitulo = 'REST DataWare Components ' + RESTDWVersao; diff --git a/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas b/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas index 0bc833faf..5754478f7 100644 --- a/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas +++ b/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas @@ -578,7 +578,7 @@ procedure TRESTDWDrvDataset.ImportParams(DWParams: TRESTDWParams); vParam.Clear; end else If vParam.DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then begin - if (Trim(DWParams[I].Value) <> '') and (not DWParams[I].IsNull) then begin + if (Trim(DWParams[I].AsString) <> '') and (not DWParams[I].IsNull) then begin if vParam.DataType = ftDate then vParam.Value := DWParams[I].AsDate else If vParam.DataType = ftTime then @@ -617,7 +617,7 @@ procedure TRESTDWDrvDataset.ImportParams(DWParams: TRESTDWParams); if vParam.RESTDWDataTypeParam in [dwftMemo, dwftFmtMemo] then vParam.Value := DecodeStrings(DWParams[I].AsString) else - vParam.Value := utf8tostring(DWParams[I].AsString); + vParam.Value := DWParams[I].AsString; {$ELSE} if vParam.RESTDWDataTypeParam in [dwftMemo, dwftFmtMemo] then vParam.Value := DecodeStrings(DWParams[I].AsString) @@ -628,7 +628,7 @@ procedure TRESTDWDrvDataset.ImportParams(DWParams: TRESTDWParams); if vParam.RESTDWDataTypeParam in [dwftMemo] then vParam.Value := DecodeStrings(DWParams[I].AsString, csUndefined) else - vParam.Value := utf8tostring(DWParams[I].AsString); + vParam.Value := DWParams[I].AsString; {$ENDIF} End Else diff --git a/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas b/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas index 0274eaec0..b72bac632 100644 --- a/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas +++ b/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas @@ -1,4 +1,4 @@ - Unit uRESTDWMemoryDataset; +Unit uRESTDWMemoryDataset; {$I ..\..\Includes\uRESTDW.inc} @@ -183,6 +183,7 @@ Procedure AfterLoad; Function GetDataset : TDataset; Function GetBlob (RecNo, Index : Integer) : PMemBlobData; + Procedure Loaded; {$IFDEF FPC} Function GetDatabaseCharSet : TDatabaseCharSet; {$ENDIF} @@ -409,8 +410,8 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) End; TRESTDWDatasetIndexDefs = Class(TIndexDefs) Private - Function GetBufDatasetIndex(AIndex : Integer) : TRESTDWDatasetIndex; - Function GetBufferIndex(AIndex : Integer) : TRESTDWIndex; + Function GetBufDatasetIndex(AIndex : Integer) : TRESTDWDatasetIndex; + Function GetBufferIndex(AIndex : Integer) : TRESTDWIndex; Public Constructor Create(aDataset : TDataset); {$IFNDEF FPC} {$IF CompilerVersion > 21} @@ -420,9 +421,9 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Override; {$ENDIF} // Does not raise an exception if not found. - Function FindIndex(const IndexName: string) : TRESTDWDatasetIndex; - Property RESTDWIndexdefs [AIndex : Integer] : TRESTDWDatasetIndex Read GetBufDatasetIndex; - Property RESTDWIndexes [AIndex : Integer] : TRESTDWIndex Read GetBufferIndex; + Function FindIndex(const IndexName: string) : TRESTDWDatasetIndex; + Property Indexdefs [AIndex : Integer] : TRESTDWDatasetIndex Read GetBufDatasetIndex; + Property Indexes [AIndex : Integer] : TRESTDWIndex Read GetBufferIndex; End; TRESTDWMemTable = Class(TDataset, IRESTDWMemTable) Private @@ -447,6 +448,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) FSrcAutoIncField : TField; FRecords : TRecordList; FDataSet : TDataset; + FFetch, FAllPacketsFetched, FRefreshing, FClearing, @@ -627,7 +629,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) procedure ClearIndexes; Function GetDataset : TDataset; Procedure SetIndexName(AValue : String); - Property Records [Index : Integer] : TRESTDWMTMemoryRecord Read GetMemoryRecord; + Property Records [Index : Integer] : TRESTDWMTMemoryRecord Read GetMemoryRecord; Public Constructor Create(AOwner : TComponent);Override; Destructor Destroy;Override; @@ -690,6 +692,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Procedure LoadFromStream(stream : TStream); Procedure Assign (Source : TPersistent);Reintroduce;Overload;Override; Function GetCurrentIndexBuf : TRESTDWIndex; + Procedure SetIndexDefs(Value : TIndexDefs); Function GetIndexDefs : TIndexDefs; Function GetIndexName : String; Function GetIndexFieldNames : String; @@ -701,7 +704,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Function LoadField (FieldDef : TFieldDef; buffer : Pointer; out CreateBlob : boolean) : Boolean; - Function Fetch : Boolean; + Function Fetch : Boolean;Virtual; Procedure LoadBlobIntoBuffer(FieldDef : TFieldDef; ABlobBuf : PRESTDWBlobField); Virtual; Abstract; Function LoadBuffer (Buffer : TRecordBuffer) : TGetResult; @@ -761,7 +764,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex) Property AfterApply : TApplyEvent Read FAfterApply Write FAfterApply; Property BeforeApplyRecord : TApplyRecordEvent Read FBeforeApplyRecord Write FBeforeApplyRecord; Property AfterApplyRecord : TApplyRecordEvent Read FAfterApplyRecord Write FAfterApplyRecord; - Property IndexDefs : TIndexDefs Read GetIndexDefs; + Property IndexDefs : TIndexDefs Read GetIndexDefs Write SetIndexDefs; Property IndexName : String Read GetIndexName Write SetIndexName; Property IndexFieldNames : String Read GetIndexFieldNames Write SetIndexFieldNames; Property MaxIndexesCount : Integer Read FMaxIndexesCount Write SetMaxIndexesCount default 2; @@ -1039,9 +1042,7 @@ TMemBookmarkInfo = record End; End; If vDWFieldType In FieldGroupVariant Then - Result := SizeOf(Variant) - Else If vDWFieldType In FieldGroupGUID Then - Result := GuidSize + 1; + Result := SizeOf(Variant); If Result > 0 Then Result := Result + SizeOf(Boolean); End; @@ -1184,16 +1185,17 @@ constructor TRESTDWMemTable.Create(AOwner: TComponent); FRowsOriginal := 0; FRowsChanged := 0; FRowsAffected := 0; - FPacketRecords := -1; + FPacketRecords := 10; FMaxIndexesCount := 2; FSaveLoadState := slsNone; FOneValueInArray := True; FDataSetClosed := False; FRefreshing := False; - FAllPacketsFetched := False; FTrimEmptyString := True; FStorageDataType := Nil; FIndexes := TRESTDWDatasetIndexDefs.Create(Self); + FAllPacketsFetched := False; + FFetch := False; End; destructor TRESTDWMemTable.Destroy; @@ -1249,7 +1251,7 @@ destructor TRESTDWMemTable.Destroy; If CaseInsensitive then Result := AnsiCompareText(vData1, vData2) Else - Result := AnsiCompareStr(PDWString(@Data1)^, PDWString(@Data2)^); + Result := AnsiCompareStr(PDWString(@vData1)^, PDWString(@vData2)^); End; ftSmallint: If Smallint(Data1^) > Smallint(Data2^) then @@ -1948,10 +1950,9 @@ destructor TRESTDWMemTable.Destroy; {$IFEND} {$ENDIF} Case Field.datatype Of - ftGuid : Result := Result and (StrLen({$IFNDEF FPC}{$IF CompilerVersion <= 22}PAnsiChar(Data) - - {$ELSE}PChar(Data){$IFEND} - {$ELSE}PAnsiChar(Data){$ENDIF}) > 0); + ftGuid,// : Result := Result and (StrLen({$IFNDEF FPC}{$IF CompilerVersion <= 22}PAnsiChar(Data) + // {$ELSE}PChar(Data){$IFEND} + // {$ELSE}PAnsiChar(Data){$ENDIF}) > 0); ftString, ftFixedChar {$IF DEFINED(FPC) OR DEFINED(DELPHI10_0UP)} @@ -2149,7 +2150,10 @@ destructor TRESTDWMemTable.Destroy; Begin If Length(TRESTDWBytes(Buffer)) = 0 Then SetLength(TRESTDWBytes(Buffer), cLen); - Move(PRESTDWBytes(@Data)^[0], Pointer(Buffer)^, cLen); + If Field.datatype = ftGuid Then + Move(PRESTDWBytes(@Data)^[0], Pointer(Buffer)^, cLen -1) + Else + Move(PRESTDWBytes(@Data)^[0], Pointer(Buffer)^, cLen); End; {$ELSE} Result := ((Not(aNullData)) and Not(VarIsNull(Data^))); @@ -2194,7 +2198,10 @@ destructor TRESTDWMemTable.Destroy; Begin If Length(TRESTDWBytes(Buffer)) = 0 Then SetLength(TRESTDWBytes(Buffer), cLen); - Move(aDataBytes[0], Pointer(Buffer)^, cLen); + If Field.datatype = ftGuid Then + Move(aDataBytes[0], Pointer(Buffer)^, cLen -1) + Else + Move(aDataBytes[0], Pointer(Buffer)^, cLen); End; {$IFEND} {$ELSE} @@ -2248,7 +2255,10 @@ destructor TRESTDWMemTable.Destroy; Begin If Length(TRESTDWBytes(Buffer)) = 0 Then SetLength(TRESTDWBytes(Buffer), cLen); - Move(aDataBytes[0], Pointer(Buffer)^, cLen); + If Field.datatype = ftGuid Then + Move(aDataBytes[0], Pointer(Buffer)^, cLen -1) + Else + Move(aDataBytes[0], Pointer(Buffer)^, cLen); End; {$ENDIF} SetLength(aDataBytes, 0); @@ -2988,7 +2998,7 @@ destructor TRESTDWMemTable.Destroy; function TRESTDWMemTable.Fetch: boolean; Begin - Result := False; + Result := FFetch; End; Function DBCompareText(subValue, aValue: pointer; size: integer; options: TLocateOptions): LargeInt; @@ -3525,6 +3535,7 @@ procedure TRESTDWMemTable.ProcessFieldsToCompareStruct(Const AFields, CreateBlobField : Boolean; BufBlob : PRESTDWBlobField; Begin + vFieldSize := 0; If Not Fetch Then Begin Result := grEOF; @@ -4405,7 +4416,7 @@ procedure TDoubleLinkedBufIndex.RemoveRecordFromIndex(const ABookmark : TRESTDWB Function TRESTDWDatasetIndexDefs.GetBufferIndex(AIndex : Integer) : TRESTDWIndex; Begin - Result := RESTDWIndexdefs[AIndex].BufferIndex; + Result := Indexdefs[AIndex].BufferIndex; End; Constructor TRESTDWDatasetIndexDefs.Create(aDataset : TDataset); @@ -4419,7 +4430,7 @@ procedure TDoubleLinkedBufIndex.RemoveRecordFromIndex(const ABookmark : TRESTDWB Begin I := IndexOf(IndexName); If I <> -1 Then - Result := RESTDWIndexdefs[I] + Result := Indexdefs[I] Else Result := Nil; End; @@ -4533,12 +4544,12 @@ procedure TRESTDWMemTable.InternalCreateIndex(F : TRESTDWDataSetIndex); Function TRESTDWMemTable.GetBufIndex (Aindex : Integer) : TRESTDWIndex; Begin - Result := FIndexes.RESTDWIndexes[AIndex] + Result := FIndexes.Indexes[AIndex] End; Function TRESTDWMemTable.GetBufIndexDef(Aindex : Integer) : TRESTDWDatasetIndex; Begin - Result := FIndexes.RESTDWIndexdefs[AIndex]; + Result := FIndexes.Indexdefs[AIndex]; End; Procedure TRESTDWMemTable.BuildCustomIndex; @@ -4576,6 +4587,8 @@ procedure TRESTDWMemTable.InternalCreateIndex(F : TRESTDWDataSetIndex); F.DescFields:=DescFields; FCurrentIndexDef:=F; F.SetIndexProperties; + FAllPacketsFetched := False; + FFetch := True; If Active Then Begin FetchAll; @@ -4583,6 +4596,7 @@ procedure TRESTDWMemTable.InternalCreateIndex(F : TRESTDWDataSetIndex); Resync([rmCenter]); End; FPacketRecords := -1; + FFetch := False; end; Procedure TRESTDWMemTable.SetIndexFieldNames(const AValue: String); @@ -4620,16 +4634,17 @@ procedure TRESTDWMemTable.InternalCreateIndex(F : TRESTDWDataSetIndex); DatabaseErrorFmt(SIndexNotFound,[AValue],Self); FIndexName:=AValue; if Assigned(F) then - begin + Begin + SortOnFields(F.Fields, ixCaseInsensitive in F.Options, ixDescending in F.Options); B:=F.BufferIndex as TDoubleLinkedBufIndex; if GetCurrentIndexBuf <> Nil then B.FCurrentRecBuf:=(GetCurrentIndexBuf as TDoubleLinkedBufIndex).FCurrentRecBuf; FCurrentIndexDef:=F; if Active then Resync([rmCenter]); - end - else - FCurrentIndexDef:=Nil; + End + Else + FCurrentIndexDef:=Nil; end; Function TRESTDWMemTable.GetCurrentIndexBuf : TRESTDWIndex; @@ -4640,6 +4655,30 @@ procedure TRESTDWMemTable.InternalCreateIndex(F : TRESTDWDataSetIndex); Result := Nil; End; +Procedure TRESTDWMemTable.SetIndexDefs(Value : TIndexDefs); +Var + I : Integer; + vIndexDef : TIndexDef; +Begin + FIndexes.Clear; + For I := 0 To Value.Count -1 Do + Begin + If FIndexes.IndexOf(Value[I].Name) = -1 Then + Begin + vIndexDef := FIndexes.AddIndexDef; + vIndexDef.Name := Value[I].Name; + vIndexDef.Fields := Value[I].Fields; + vIndexDef.DescFields := Value[I].DescFields; + vIndexDef.Expression := Value[I].Expression; + vIndexDef.Options := Value[I].Options; + vIndexDef.Source := Value[I].Source; + {$IFNDEF FPC} + vIndexDef.GroupingLevel := Value[I].GroupingLevel; + {$ENDIF} + End; + End; +End; + Function TRESTDWMemTable.GetIndexDefs : TIndexDefs; Begin Result := FIndexes; @@ -4895,6 +4934,7 @@ procedure TRESTDWMemTable.InternalCreateIndex(F : TRESTDWDataSetIndex); BindFields(True); InitBufferPointers(True); InternalFirst; + FAllPacketsFetched := False; End; Procedure TRESTDWMemTable.DoAfterOpen; @@ -5797,20 +5837,23 @@ procedure TRESTDWMemTable.InternalCreateIndex(F : TRESTDWDataSetIndex); Pos: Integer; F: TField; Begin - If FIndexList = nil then - FIndexList := TList.Create - Else - FIndexList.Clear; - Pos := 1; - while Pos <= Length(FieldNames) do + If FIndexList = Nil Then + FIndexList := TList.Create; +// Else +// FIndexList.Clear; + Pos := 1; + While Pos <= Length(FieldNames) Do Begin F := FieldByName(ExtractFieldNameEx(FieldNames, Pos)); - If { (F.FieldKind = fkData) and } (F.datatype in ftSupported - ftBlobTypes) then - FIndexList.Add(F) - Else - ErrorFmt('Type mismatch for field %s, expecting: %s actual %s', - [F.DisplayName, GetSetFieldNames(ftSupported - ftBlobTypes), - FieldTypeNames[F.datatype]]); + If FIndexList.IndexOf(F) = -1 Then + Begin + If (F.FieldKind = fkData) And (F.datatype in ftSupported - ftBlobTypes) then + FIndexList.Add(F) + Else + ErrorFmt('Type mismatch for field %s, expecting: %s actual %s', + [F.DisplayName, GetSetFieldNames(ftSupported - ftBlobTypes), + FieldTypeNames[F.datatype]]); + End; End; End; @@ -6839,6 +6882,11 @@ constructor TRESTDWMemTableEx.Create(AOwner: TComponent); End End; +//Function TRESTDWMemTable.Loaded; +//Begin +// Inherited Loaded; +//End; + Function TRESTDWMemTableEx.LoadFromDataSet(Source: TDataSet; {$IFDEF FPC}aRecordCount: Integer; {$ELSE}RecordCount: Integer; {$ENDIF}Mode: TLoadMode): Integer; Var wasFiltered: boolean; diff --git a/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.dfm b/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.dfm index 919f5d97a..e3bd53aa3 100644 --- a/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.dfm +++ b/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.dfm @@ -1,6 +1,7 @@ object FrmDWSqlEditor: TFrmDWSqlEditor Left = 479 Top = 236 + BorderIcons = [biMaximize] BorderWidth = 5 Caption = 'RESTDWClientSQL Editor' ClientHeight = 707 diff --git a/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.lfm b/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.lfm index d18cf5873..3b294a846 100644 --- a/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.lfm +++ b/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.lfm @@ -3,6 +3,7 @@ object FrmDWSqlEditor: TFrmDWSqlEditor Height = 756 Top = 195 Width = 1079 + BorderIcons = [biMinimize] BorderWidth = 5 Caption = 'RESTDWClientSQL Editor' ClientHeight = 756 @@ -16,7 +17,7 @@ object FrmDWSqlEditor: TFrmDWSqlEditor OnCreate = FormCreate OnShow = FormShow Position = poScreenCenter - LCLVersion = '2.2.4.0' + LCLVersion = '3.8.0.0' object PnlSQL: TPanel Left = 5 Height = 415 @@ -26,6 +27,7 @@ object FrmDWSqlEditor: TFrmDWSqlEditor BevelOuter = bvNone ClientHeight = 415 ClientWidth = 1069 + ParentBackground = False TabOrder = 0 object PnlButton: TPanel Left = 974 @@ -36,6 +38,7 @@ object FrmDWSqlEditor: TFrmDWSqlEditor BevelOuter = bvNone ClientHeight = 415 ClientWidth = 95 + ParentBackground = False TabOrder = 0 object BtnExecute: TButton Left = 8 @@ -43,8 +46,8 @@ object FrmDWSqlEditor: TFrmDWSqlEditor Top = 20 Width = 80 Caption = 'Execute' - OnClick = BtnExecuteClick TabOrder = 0 + OnClick = BtnExecuteClick end end object pEditor: TPanel @@ -56,6 +59,7 @@ object FrmDWSqlEditor: TFrmDWSqlEditor BevelOuter = bvNone ClientHeight = 415 ClientWidth = 765 + ParentBackground = False TabOrder = 1 object PageControl: TPageControl Left = 0 @@ -77,10 +81,10 @@ object FrmDWSqlEditor: TFrmDWSqlEditor Top = 0 Width = 757 Align = alClient - OnDragDrop = MemoDragDrop - OnDragOver = MemoDragOver ScrollBars = ssBoth TabOrder = 0 + OnDragDrop = MemoDragDrop + OnDragOver = MemoDragOver end end end @@ -93,6 +97,7 @@ object FrmDWSqlEditor: TFrmDWSqlEditor BevelOuter = bvLowered ClientHeight = 21 ClientWidth = 765 + ParentBackground = False TabOrder = 1 object Label3: TLabel Left = 7 @@ -126,6 +131,7 @@ object FrmDWSqlEditor: TFrmDWSqlEditor BevelOuter = bvNone ClientHeight = 415 ClientWidth = 209 + ParentBackground = False TabOrder = 2 object labSql: TLabel Left = 0 @@ -187,9 +193,9 @@ object FrmDWSqlEditor: TFrmDWSqlEditor BorderStyle = bsNone DragMode = dmAutomatic ItemHeight = 0 + TabOrder = 0 OnClick = lbTablesClick OnKeyUp = lbTablesKeyUp - TabOrder = 0 end object lbFields: TListBox Left = 0 @@ -212,20 +218,21 @@ object FrmDWSqlEditor: TFrmDWSqlEditor BevelOuter = bvNone ClientHeight = 56 ClientWidth = 209 + ParentBackground = False TabOrder = 2 object rbInsert: TRadioButton Left = 88 - Height = 19 + Height = 17 Top = 8 - Width = 49 + Width = 47 Caption = 'Insert' TabOrder = 0 end object rbSelect: TRadioButton Left = 8 - Height = 19 + Height = 17 Top = 8 - Width = 49 + Width = 47 Caption = 'Select' Checked = True TabOrder = 1 @@ -233,17 +240,17 @@ object FrmDWSqlEditor: TFrmDWSqlEditor end object rbDelete: TRadioButton Left = 88 - Height = 19 + Height = 17 Top = 32 - Width = 51 + Width = 49 Caption = 'Delete' TabOrder = 2 end object rbUpdate: TRadioButton Left = 8 - Height = 19 + Height = 17 Top = 32 - Width = 55 + Width = 53 Caption = 'Update' TabOrder = 3 end @@ -259,6 +266,7 @@ object FrmDWSqlEditor: TFrmDWSqlEditor BevelOuter = bvNone ClientHeight = 41 ClientWidth = 1069 + ParentBackground = False TabOrder = 1 object BtnOk: TButton Left = 905 @@ -268,8 +276,8 @@ object FrmDWSqlEditor: TFrmDWSqlEditor Anchors = [akTop, akRight] Caption = 'Ok' Default = True - OnClick = BtnOkClick TabOrder = 0 + OnClick = BtnOkClick end object BtnCancelar: TButton Left = 986 @@ -279,8 +287,8 @@ object FrmDWSqlEditor: TFrmDWSqlEditor Anchors = [akTop, akRight] Cancel = True Caption = 'Cancel' - OnClick = BtnCancelarClick TabOrder = 1 + OnClick = BtnCancelarClick end end object PageControlResult: TPageControl diff --git a/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.pas b/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.pas index c65323965..ee4848db0 100644 --- a/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.pas +++ b/CORE/Source/Plugins/SQLEditor/uRESTDWSqlEditor.pas @@ -163,9 +163,9 @@ TFrmDWSqlEditor = class(TForm) Implementation {$IFDEF FPC} -{$R *.lfm} + {$R *.lfm} {$ELSE} -{$R *.dfm} + {$R *.dfm} {$ENDIF} Function TRESTDWSQLEditor.GetValue : String; diff --git a/CORE/Source/utils/uRESTDWMassiveBuffer.pas b/CORE/Source/utils/uRESTDWMassiveBuffer.pas index 9c5b047a0..16017f633 100644 --- a/CORE/Source/utils/uRESTDWMassiveBuffer.pas +++ b/CORE/Source/utils/uRESTDWMassiveBuffer.pas @@ -22,10 +22,8 @@ Roniery - Devel. } -{$IFNDEF RESTDWLAZARUS} - {$IFDEF FPC} - {$MODE OBJFPC}{$H+} - {$ENDIF} +{$IFDEF FPC} + {$MODE OBJFPC}{$H+} {$ENDIF} interface