diff --git a/CORE/Extras/TaurusTLS.zip b/CORE/Extras/TaurusTLS.zip
new file mode 100644
index 00000000..beab1785
Binary files /dev/null and b/CORE/Extras/TaurusTLS.zip differ
diff --git a/CORE/Packages/Delphi/Connectors/Indy/RESTDWSocketIndy.dpk b/CORE/Packages/Delphi/Connectors/Indy/RESTDWSocketIndy.dpk
index 102993db..832192e5 100644
--- a/CORE/Packages/Delphi/Connectors/Indy/RESTDWSocketIndy.dpk
+++ b/CORE/Packages/Delphi/Connectors/Indy/RESTDWSocketIndy.dpk
@@ -33,7 +33,8 @@ requires
RESTDWCore,
IndySystem,
IndyCore,
- IndyProtocols;
+ IndyProtocols,
+ TaurusTLS_RT;
contains
uRESTDWIdBase in '..\..\..\..\Source\Sockets\Indy\uRESTDWIdBase.pas';
diff --git a/CORE/Packages/Delphi/Connectors/Indy/RESTDWSocketIndy.dproj b/CORE/Packages/Delphi/Connectors/Indy/RESTDWSocketIndy.dproj
index 907b4880..9ef5320d 100644
--- a/CORE/Packages/Delphi/Connectors/Indy/RESTDWSocketIndy.dproj
+++ b/CORE/Packages/Delphi/Connectors/Indy/RESTDWSocketIndy.dproj
@@ -188,6 +188,7 @@
+
Base
@@ -235,6 +236,12 @@
+
+
+ RESTDWSocketIndy.bpl
+ true
+
+
1
diff --git a/CORE/Packages/Delphi/Drivers/FireDAC/RESTDWFireDACDriver.dproj b/CORE/Packages/Delphi/Drivers/FireDAC/RESTDWFireDACDriver.dproj
index b5a607ac..22a34a81 100644
--- a/CORE/Packages/Delphi/Drivers/FireDAC/RESTDWFireDACDriver.dproj
+++ b/CORE/Packages/Delphi/Drivers/FireDAC/RESTDWFireDACDriver.dproj
@@ -6,7 +6,7 @@
None
True
Debug
- Win64
+ Win32
3
Package
RESTDWFireDACDriver
diff --git a/CORE/Packages/Delphi/Drivers/Zeos/RESTDWZEOSDriver.dproj b/CORE/Packages/Delphi/Drivers/Zeos/RESTDWZEOSDriver.dproj
index e4e18037..c7451a4e 100644
--- a/CORE/Packages/Delphi/Drivers/Zeos/RESTDWZEOSDriver.dproj
+++ b/CORE/Packages/Delphi/Drivers/Zeos/RESTDWZEOSDriver.dproj
@@ -8,7 +8,7 @@
Package
None
20.3
- Win64
+ Win32
RESTDWZEOSDriver
diff --git a/CORE/Packages/Delphi/RESTDWCore.dpk b/CORE/Packages/Delphi/RESTDWCore.dpk
index 6c795f19..e628f9be 100644
--- a/CORE/Packages/Delphi/RESTDWCore.dpk
+++ b/CORE/Packages/Delphi/RESTDWCore.dpk
@@ -32,7 +32,10 @@ package RESTDWCore;
requires
rtl,
soaprtl,
- dbrtl;
+ dbrtl,
+ FireDAC,
+ FireDACCommonDriver,
+ FireDACCommon;
contains
uRESTDWBasic in '..\..\Source\Basic\uRESTDWBasic.pas',
@@ -95,7 +98,9 @@ contains
uRESTDWURLFunctions in '..\..\Source\utils\uRESTDWURLFunctions.pas',
uRESTDWPropertyPersist in '..\..\Source\Basic\uRESTDWPropertyPersist.pas',
uRESTDWStorageBin in '..\..\Source\Basic\uRESTDWStorageBin.pas',
- uRESTDWMemoryDataset in '..\..\Source\Plugins\Memdataset\uRESTDWMemoryDataset.pas',
+ {$IFDEF RESTDWMEMTABLE}
+ uRESTDWMemoryDataset in '..\..\Source\Plugins\Memdataset\uRESTDWMemoryDataset.pas',
+ {$ENDIF}
uRESTDWProtoTypes in '..\..\Source\Basic\uRESTDWProtoTypes.pas',
uRESTDWExprParser in '..\..\Source\Plugins\Memdataset\uRESTDWExprParser.pas',
uRESTDWDriverBase in '..\..\Source\Database_Drivers\uRESTDWDriverBase.pas',
diff --git a/CORE/Packages/Delphi/RESTDWCore.dproj b/CORE/Packages/Delphi/RESTDWCore.dproj
index dd5bcf10..5a06fc23 100644
--- a/CORE/Packages/Delphi/RESTDWCore.dproj
+++ b/CORE/Packages/Delphi/RESTDWCore.dproj
@@ -218,12 +218,12 @@
..\..\compiled
true
- CompanyName=XyberPower Desenvolvimento;FileDescription=$(MSBuildProjectName);FileVersion=2.1.0.131;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ CompanyName=XyberPower Desenvolvimento;FileDescription=$(MSBuildProjectName);FileVersion=2.1.0.144;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
1033
2
1
REST Dataware - Core
- 131
+ 144
true
true
@@ -239,6 +239,9 @@
+
+
+
@@ -302,7 +305,6 @@
-
@@ -367,6 +369,12 @@
+
+
+ RESTDWCore.bpl
+ true
+
+
1
diff --git a/CORE/Packages/Delphi/ShellTools/RESTDWShellServicesDesign.dproj b/CORE/Packages/Delphi/ShellTools/RESTDWShellServicesDesign.dproj
index 974a719b..293f9f1e 100644
--- a/CORE/Packages/Delphi/ShellTools/RESTDWShellServicesDesign.dproj
+++ b/CORE/Packages/Delphi/ShellTools/RESTDWShellServicesDesign.dproj
@@ -6,7 +6,7 @@
None
True
Debug
- Win64
+ Win32
3
Package
RESTDWShellServicesDesign
diff --git a/CORE/Source/Basic/uRESTDWBasic.pas b/CORE/Source/Basic/uRESTDWBasic.pas
index e9f5bb6a..acba5f08 100644
--- a/CORE/Source/Basic/uRESTDWBasic.pas
+++ b/CORE/Source/Basic/uRESTDWBasic.pas
@@ -34,7 +34,7 @@ interface
{$IFDEF RESTDWFMX}System.IOUtils,{$ENDIF}
SysUtils, Classes, Db, Variants,
{$IFNDEF RESTDWLAZARUS}SyncObjs,{$ENDIF}
- uRESTDWComponentEvents, uRESTDWBasicTypes, uRESTDWProtoTypes, uRESTDWJSONObject,
+ uRESTDWComponentEvents, uRESTDWBasicTypes, uRESTDWBasicDbTypes, uRESTDWProtoTypes, uRESTDWJSONObject,
uRESTDWParams, uRESTDWMassiveBuffer, uRESTDWDataUtils,
uRESTDWTools, uRESTDWConsts, uRESTDWMessageCoderMIME,
uRESTDWZlib, uRESTDWMimeTypes, uRESTDWAbout, uRESTDWAuthenticators, uRESTDWBasicClass;
diff --git a/CORE/Source/Basic/uRESTDWBasicDB.pas b/CORE/Source/Basic/uRESTDWBasicDB.pas
index 86d1ba01..e72b8efd 100644
--- a/CORE/Source/Basic/uRESTDWBasicDB.pas
+++ b/CORE/Source/Basic/uRESTDWBasicDB.pas
@@ -33,11 +33,33 @@ interface
{$IFDEF RESTDWLAZARUS}memds,{$ENDIF}
{$IFDEF RESTDWFMX}System.UITypes, {$ENDIF}
SysUtils, Classes, Db, SyncObjs, Variants,
- uRESTDWDataUtils, uRESTDWBasicTypes, uRESTDWProtoTypes,
- uRESTDWPoolermethod, uRESTDWComponentEvents, uRESTDWAbout, uRESTDWConsts,
+ uRESTDWDataUtils, uRESTDWProtoTypes,
+ uRESTDWPoolermethod, uRESTDWComponentEvents, uRESTDWAbout,
uRESTDWResponseTranslator, uRESTDWBasicClass, uRESTDWJSONObject, uRESTDWParams,
- uRESTDWBasic, uRESTDWMassiveBuffer, uRESTDWMasterDetailData,
- uRESTDWMemoryDataset, uRESTDWBufferBase, uRESTDWDriverBase, uRESTDWTools;
+ uRESTDWBasic, uRESTDWMassiveBuffer, uRESTDWBasicTypes, uRESTDWBasicDbTypes, uRESTDWMasterDetailData
+ {$IFDEF UNIDACMEM}
+ , DADump, UniDump, VirtualTable, MemDS,
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ , ZAbstractRODataset, ZAbstractDataset, ZMemTable, ZDataset,
+ {$ENDIF}
+ {$IFNDEF FPC}
+ {$IF CompilerVersion > 22} // Delphi 2010 pra cima
+ {$IFDEF RESTFDMEMTABLE}
+ , FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
+ FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
+ FireDAC.Comp.DataSet, FireDAC.Comp.Client,
+ {$IFNDEF FPC}
+ {$IF CompilerVersion > 26} // Delphi XE6 pra cima
+ FireDAC.Stan.StorageBin,
+ {$IFEND}
+ {$ENDIF}
+ {$ENDIF}
+ {$IFEND}
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ , uRESTDWMemoryDataset,
+ {$ENDIF} uRESTDWBufferBase, uRESTDWDriverBase, uRESTDWConsts, uRESTDWTools;
Type
TOnExecuteData = Procedure Of Object;
@@ -684,8 +706,30 @@ interface
vMasterDetailList : TMasterDetailList; //DataSet MasterDetail Function
vMassiveDataset : TMassiveDataset;
vLastOpen : Integer;
- Procedure CloneDefinitions (Source : TRESTDWMemtable;
- aSelf : TRESTDWMemtable); //Fields em Definições
+ Procedure CloneDefinitions (Source : {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF};
+ aSelf : {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF}); //Fields em Definições
Procedure OnChangingSQL (Sender : TObject); //Quando Altera o SQL da Lista
Procedure OnBeforeChangingSQL(Sender : TObject);
Procedure SetActiveDB (Value : Boolean); //Seta o Estado do Dataset
@@ -5229,10 +5273,8 @@ procedure TRESTDWDatabasebaseBase.Loaded;
Function TRESTDWDatabasebaseBase.BuildConnection(aBinaryRequest : Boolean) : TRESTDWPoolerMethodClient;
Begin
Result := nil;
-
if Assigned(vOnBuildConnection) then
vOnBuildConnection(Self);
-
Result := TRESTDWPoolerMethodClient.Create(Nil);
Result.PoolerNotFoundMessage := PoolerNotFoundMessage;
Result.AuthenticationOptions.Assign(AuthenticationOptions);
@@ -8361,8 +8403,30 @@ procedure TRESTDWClientSQL.SetSQL(Value: TStringList);
vCreateDS := True;
SetInBlockEvents(True);
Try
- TRESTDWMemtable(Self).Close;
- TRESTDWMemtable(Self).Open;
+ {$IFDEF UNIDACMEM}
+ TVirtualTable(Self)
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable(Self)
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable(Self)
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable(Self)
+ {$ENDIF}.Close;
+ {$IFDEF UNIDACMEM}
+ TVirtualTable(Self)
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable(Self)
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable(Self)
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable(Self)
+ {$ENDIF}.Open;
vCreateDS := False;
vActive := Not vCreateDS;
Finally
@@ -8379,9 +8443,9 @@ procedure TRESTDWClientSQL.SetSQL(Value: TStringList);
vCreateDS := True;
SetInBlockEvents(True);
Try
-
- EmptyTable;
-
+ {$IFDEF RESTDWMEMTABLE}
+ EmptyTable;
+ {$ENDIF}
vCreateDS := False;
vActive := Not vCreateDS;
Finally
@@ -8391,8 +8455,30 @@ procedure TRESTDWClientSQL.SetSQL(Value: TStringList);
Class Procedure TRESTDWTable.CreateEmptyDataset(Const Dataset : TDataset);
Begin
Try
- TRESTDWMemtable(Dataset).Close;
- TRESTDWMemtable(Dataset).Open;
+ {$IFDEF UNIDACMEM}
+ TVirtualTable(Self)
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable(Self)
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable(Self)
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable(Self)
+ {$ENDIF}.Close;
+ {$IFDEF UNIDACMEM}
+ TVirtualTable(Self)
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable(Self)
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable(Self)
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable(Self)
+ {$ENDIF}.Open;
Finally
End;
End;
@@ -8400,8 +8486,30 @@ procedure TRESTDWClientSQL.SetSQL(Value: TStringList);
Class Procedure TRESTDWClientSQL.CreateEmptyDataset(Const Dataset : TDataset);
Begin
Try
- TRESTDWMemtable(Dataset).Close;
- TRESTDWMemtable(Dataset).Open;
+ {$IFDEF UNIDACMEM}
+ TVirtualTable(Self)
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable(Self)
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable(Self)
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable(Self)
+ {$ENDIF}.Close;
+ {$IFDEF UNIDACMEM}
+ TVirtualTable(Self)
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable(Self)
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable(Self)
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable(Self)
+ {$ENDIF}.Open;
Finally
End;
End;
@@ -8441,13 +8549,35 @@ procedure TRESTDWClientSQL.SetSQL(Value: TStringList);
I : Integer;
FieldDef : TFieldDef;
Begin
- TRESTDWMemtable(Self).Close;
+ {$IFDEF UNIDACMEM}
+ TVirtualTable(Self).Close;
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable(Self).Close;
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable(Self).Close;
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable(Self).Close;
+ {$ENDIF}
For I := 0 To Length(vFieldsList) -1 Do
Begin
FieldDef := FieldDefExist(Self, vFieldsList[I].FieldName);
If FieldDef = Nil Then
Begin
- FieldDef := TRESTDWMemtable(Self).FieldDefs.AddFieldDef;
+ FieldDef := {$IFDEF UNIDACMEM}
+ TVirtualTable(Self)
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable(Self)
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable(Self)
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable(Self)
+ {$ENDIF}.FieldDefs.AddFieldDef;
FieldDef.Name := vFieldsList[I].FieldName;
FieldDef.DataType := vFieldsList[I].DataType;
FieldDef.Size := vFieldsList[I].Size;
@@ -9699,8 +9829,30 @@ constructor TRESTDWThreadRequest.Create(aSelf : TComponent;
// {$ENDIF}
End;
-Procedure TRESTDWClientSQL.CloneDefinitions(Source : TRESTDWMemtable;
- aSelf : TRESTDWMemtable); //Fields em Definições
+Procedure TRESTDWClientSQL.CloneDefinitions(Source : {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF};
+ aSelf : {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF}); //Fields em Definições
Var
I, A : Integer;
Begin
@@ -9842,7 +9994,7 @@ procedure TRESTDWClientSQL.PrepareDetailsNew;
Begin
If Not FindField(vFieldA).IsNull Then
Begin
- {$IFDEF DELPHI10_2UP}
+ {$IFDEF DELPHI11UP}
Value.ParamByName(vFieldD).AsGUID := FindField(vFieldA).AsGUID;
{$ELSE}
Value.ParamByName(vFieldD).AsString := FindField(vFieldA).AsString;
@@ -9922,7 +10074,7 @@ procedure TRESTDWClientSQL.PrepareDetailsNew;
Begin
If Not FindField(vFieldA).IsNull Then
Begin
- {$IFDEF DELPHI10_2UP}
+ {$IFDEF DELPHI11UP}
Value.ParamByName(vFieldD).AsGUID := FindField(vFieldA).AsGUID;
{$ELSE}
Value.ParamByName(vFieldD).AsString := FindField(vFieldA).AsString;
@@ -10288,7 +10440,7 @@ procedure TRESTDWClientSQL.PrepareDetailsNew;
If DataSet = Nil Then
Begin
vRESTDataBase.ExecuteCommandTB(vActualPoolerMethodClient, vTablename, vParams, vError, vMessageError, LDataSetList,
- vRowsAffected, BinaryRequest, True, Fields.Count = 0, Nil);
+ vRowsAffected, BinaryRequest, BinaryCompatibleMode, Fields.Count = 0, Nil);
If LDataSetList <> Nil Then
Begin
If BinaryRequest Then
@@ -10588,7 +10740,7 @@ procedure TRESTDWClientSQL.PrepareDetailsNew;
For I := 0 To 1 Do
Begin
vRESTDataBase.ExecuteCommand(vActualPoolerMethodClient, vSQL, vParams, vError, vMessageError, LDataSetList,
- vRowsAffected, False, BinaryRequest, True, vMetaData, vRESTDataBase.RESTClientPooler);
+ vRowsAffected, False, BinaryRequest, BinaryCompatibleMode, vMetaData, vRESTDataBase.RESTClientPooler);
If Not(vError) or (vMessageError <> cInvalidAuth) Then
Break;
End;
diff --git a/CORE/Source/Basic/uRESTDWBasicDbTypes.pas b/CORE/Source/Basic/uRESTDWBasicDbTypes.pas
new file mode 100644
index 00000000..4854ae49
--- /dev/null
+++ b/CORE/Source/Basic/uRESTDWBasicDbTypes.pas
@@ -0,0 +1,522 @@
+unit uRESTDWBasicDbTypes;
+
+{$I ..\..\Source\Includes\uRESTDW.inc}
+
+{
+ REST Dataware .
+ Criado por XyberX (Gilbero Rocha da Silva), o REST Dataware tem como objetivo o uso de REST/JSON
+ de maneira simples, em qualquer Compilador Pascal (Delphi, Lazarus e outros...).
+ O REST Dataware também tem por objetivo levar componentes compatíveis entre o Delphi e outros Compiladores
+ Pascal e com compatibilidade entre sistemas operacionais.
+ Desenvolvido para ser usado de Maneira RAD, o REST Dataware tem como objetivo principal você usuário que precisa
+ de produtividade e flexibilidade para produção de Serviços REST/JSON, simplificando o processo para você programador.
+
+ Membros do Grupo :
+
+ XyberX (Gilberto Rocha) - Admin - Criador e Administrador do pacote.
+ Alexandre Abbade - Admin - Administrador do desenvolvimento de DEMOS, coordenador do Grupo.
+ Anderson Fiori - Admin - Gerencia de Organização dos Projetos
+ Flávio Motta - Member Tester and DEMO Developer.
+ Mobius One - Devel, Tester and Admin.
+ Gustavo - Criptografia and Devel.
+ Eloy - Devel.
+ Roniery - Devel.
+}
+
+{$IFNDEF RESTDWLAZARUS}
+ {$IFDEF FPC}
+ {$MODE OBJFPC}{$H+}
+ {$ENDIF}
+{$ENDIF}
+
+Interface
+
+Uses
+ {$IFNDEF FPC}
+ {$IF CompilerVersion < 21}
+ DbTables,
+ {$IFEND}
+ {$ENDIF}
+ SysUtils, Classes, Db, FMTBcd,
+ uRESTDWAbout, uRESTDWProtoTypes, uRESTDWConsts, uRESTDWTools;
+
+ Type
+ TRESTDWMemTableAE = Class
+ End;
+ TFieldAttrs = Array of Byte;
+ TMemBlobData = TRESTDWBytes;
+ TMemBlobArray = Array Of TMemBlobData;
+ PMemBlobArray = ^TMemBlobArray;
+
+ {$IFNDEF FPC}
+ {$IF CompilerVersion > 21}
+ PRESTDWMTMemBuffer = PByte;
+ TRESTDWMTBookmark = TBookmark;
+ TRESTDWMTValueBuffer = TValueBuffer;
+ TRESTDWMTRecordBuffer = TRecordBuffer;
+ {$ELSE}
+ {$IFDEF UNICODE}
+ PRESTDWMTMemBuffer = PByte;
+ {$ELSE}
+ PRESTDWMTMemBuffer = PAnsiChar;
+ {$ENDIF UNICODE}
+ TRESTDWMTBookmark = Pointer;
+ TRESTDWMTValueBuffer = Pointer;
+ TRESTDWMTRecordBuffer = Pointer;
+ {$IFEND}
+ {$ELSE}
+ TValueBuffer = Array of Byte;
+ PRESTDWMTMemBuffer = PByte;
+ TRESTDWMTBookmark = Pointer;
+ TRESTDWMTValueBuffer = Pointer;
+ TRESTDWMTRecordBuffer = TRecordBuffer;
+ {$ENDIF}
+ PMemBlobData = ^TRESTDWBytes;
+ Type
+ PRESTDWMTMemoryRecord = ^TRESTDWMTMemoryRecord;
+ TRESTDWMTMemoryRecord = Class(TPersistent)
+ Private
+ FMemoryData : TRESTDWMemTableAE;
+ FIndex,
+ FID : Integer;
+ FData : Pointer;
+ FIsNull : Boolean;
+ Function GetIndex : Integer;
+ Procedure SetMemoryData(Value : TRESTDWMemTableAE;
+ UpdateParent : Boolean);
+ Protected
+ Procedure SetIndex (Value : Integer); Virtual;
+ Public
+ FBlobs : TMemBlobArray;
+ Constructor Create (MemoryData : TRESTDWMemTableAE); Virtual;
+ Constructor CreateEx (MemoryData : TRESTDWMemTableAE;
+ UpdateParent : Boolean); Virtual;
+ Destructor Destroy;Override;
+ Property MemoryData : TRESTDWMemTableAE Read FMemoryData;
+ Property ID : Integer Read FID Write FID;
+ Property Index : Integer Read GetIndex Write SetIndex;
+ Property Data : Pointer Read FData Write FData;
+ Property Blobs : TMemBlobArray Read FBlobs Write FBlobs;
+ Property IsNull : Boolean Read FIsNull Write FIsNull;
+ End;
+ Type
+ IRESTDWMemTable = Interface
+ Function GetRecordCount : Integer;
+ Function GetMemoryRecord (Index : Integer) : TRESTDWMTMemoryRecord;
+ Function GetOffSets (aField : TField) : Word;Overload;
+ Function GetOffSets (Index : Integer) : Word;Overload;
+ Function GetOffSetsBlobs : Word;
+ Function DataTypeSuported(datatype : TFieldType) : Boolean; // new
+ Function DataTypeIsBlobTypes(datatype : TFieldType) : Boolean; // new
+ Function GetBlobRec (Field : TField;
+ Rec : TRESTDWMTMemoryRecord) : TMemBlobData;
+ Function CreateBlobStream (Field : TField;
+ Mode : TBlobStreamMode) : TStream;
+ Function GetCalcFieldLen (FieldType: TFieldType;
+ Size : Word) : Word;
+ Procedure InternalAddRecord (Buffer : {$IFDEF FPC}Pointer{$ELSE}
+ {$IFDEF RESTDWANDROID}TRecBuf{$ELSE}
+ {$IF CompilerVersion >22}Pointer{$ELSE}TRecordBuffer{$IFEND}{$ENDIF}{$ENDIF};
+ aAppend : Boolean);
+ Procedure InitRecord (Buffer : {$IFDEF NEXTGEN}TRecBuf{$ELSE}TRecordBuffer{$ENDIF});
+ Function AllocRecordBuffer : TRecordBuffer;
+ Procedure SetMemoryRecordData(Buffer : PRESTDWMTMemBuffer;
+ Pos : Integer);
+ Procedure AfterLoad;
+ Function GetDataset : TDataset;
+ Function GetBlob (RecNo, Index : Integer) : PMemBlobData;
+ Procedure Loaded;
+ {$IFDEF FPC}
+ Function GetDatabaseCharSet : TDatabaseCharSet;
+ {$ENDIF}
+ End;
+ Type
+ TConnectionDefs = Class(TPersistent)
+ Private
+ votherDetails,
+ vCharset,
+ vDatabaseName,
+ vHostName,
+ vUsername,
+ vPassword,
+ vProtocol,
+ vDriverID,
+ vDataSource : String;
+ vdbPort : Integer;
+ vDWDatabaseType : TRESTDWDatabaseType;
+ Private
+ Function GetDatabaseType(Value : String) : TRESTDWDatabaseType;Overload;
+ Function GetDatabaseType(Value : TRESTDWDatabaseType) : String; Overload;
+ Public
+ Constructor Create; //Cria o Componente
+ Destructor Destroy;Override;//Destroy a Classe
+ Procedure Assign(Source : TPersistent); Override;
+ Function ToJSON : String;
+ Procedure LoadFromJSON(Value : String);
+ Published
+ Property DriverType : TRESTDWDatabaseType Read vDWDatabaseType Write vDWDatabaseType;
+ Property Charset : String Read vCharset Write vCharset;
+ Property DriverID : String Read vDriverID Write vDriverID;
+ Property DatabaseName : String Read vDatabaseName Write vDatabaseName;
+ Property HostName : String Read vHostName Write vHostName;
+ Property Username : String Read vUsername Write vUsername;
+ Property Password : String Read vPassword Write vPassword;
+ Property Protocol : String Read vProtocol Write vProtocol;
+ Property DBPort : Integer Read vdbPort Write vdbPort;
+ Property DataSource : String Read vDataSource Write vDataSource;
+ Property OtherDetails : String Read votherDetails Write votherDetails;
+ End;
+ Type
+ TRESTDWStorageBase = class(TRESTDWComponent)
+ Private
+ {$IFDEF FPC}
+ FDatabaseCharSet: TDatabaseCharSet;
+ {$ENDIF}
+ FEncodeStrs: Boolean;
+ Protected
+ Procedure SaveDatasetToStream (Dataset : TDataset;
+ Var stream : TStream); Virtual;
+ Procedure LoadDatasetFromStream(Dataset : TDataset;
+ stream : TStream); Virtual;
+ Procedure SaveDWMemToStream (Dataset : IRESTDWMemTable;
+ Var stream : TStream); Virtual;
+ Procedure LoadDWMemFromStream (Dataset : IRESTDWMemTable;
+ stream : TStream); Virtual;
+ Public
+ Constructor Create (AOwner : TComponent); Override;
+ Procedure SaveToStream (Dataset : TDataset;
+ Var Stream : TStream);
+ Procedure LoadFromStream(Dataset : TDataset;
+ Stream : TStream);
+ Procedure SaveToFile (Dataset : TDataset;
+ FileName : String);
+ Procedure LoadFromFile (Dataset : TDataset;
+ FileName : String);
+ Public
+ Property EncodeStrs : Boolean Read FEncodeStrs Write FEncodeStrs;
+ Published
+ {$IFDEF FPC}
+ Property DatabaseCharSet : TDatabaseCharSet Read FDatabaseCharSet Write FDatabaseCharSet;
+ {$ENDIF}
+ End;
+
+
+
+implementation
+
+Uses uRESTDWMemoryDataset, uRESTDWDataJSON, uRESTDWJSONInterface;
+
+constructor TRESTDWStorageBase.Create(AOwner: TComponent);
+Begin
+ inherited Create(AOwner);
+ FEncodeStrs := True;
+End;
+
+Procedure TRESTDWStorageBase.LoadDatasetFromStream(Dataset: TDataset; stream: TStream);
+Begin
+
+End;
+
+Procedure TRESTDWStorageBase.LoadDWMemFromStream(Dataset : IRESTDWMemTable;
+ stream : TStream);
+Begin
+
+End;
+
+Procedure TRESTDWStorageBase.LoadFromFile(Dataset: TDataset; FileName: String);
+Var
+ vFileStream : TFileStream;
+Begin
+ If not FileExists(FileName) then
+ Exit;
+ vFileStream := TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
+ Try
+ LoadFromStream(Dataset,TStream(vFileStream));
+ Finally
+ vFileStream := Nil;
+ vFileStream.Free;
+ End;
+End;
+
+Procedure TRESTDWStorageBase.LoadFromStream(Dataset: TDataset; stream: TStream);
+Begin
+ {$IFDEF RESTDWMEMTABLE}
+ LoadDatasetFromStream(Dataset, stream);
+ If Dataset.Active then
+ TRESTDWMemTable(Dataset).SortOnFields;
+ {$ELSE} //TODO LoadFromStream
+ {$IFDEF UNIDACMEM}
+
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+
+ {$ENDIF}
+ {$ENDIF}
+End;
+
+Procedure TRESTDWStorageBase.SaveDatasetToStream(Dataset: TDataset; Var stream: TStream);
+Begin
+
+End;
+
+Procedure TRESTDWStorageBase.SaveDWMemToStream(Dataset: IRESTDWMemTable;
+ Var stream: TStream);
+Begin
+
+End;
+
+Procedure TRESTDWStorageBase.SaveToFile(Dataset: TDataset; FileName: String);
+Var
+ vFileStream : TFileStream;
+Begin
+ Try
+ vFileStream := TFileStream.Create(FileName,fmCreate);
+ Try
+ SaveToStream(Dataset,TStream(vFileStream));
+ Except
+ End;
+ Finally
+ vFileStream.Free;
+ End;
+End;
+
+Procedure TRESTDWStorageBase.SaveToStream(Dataset: TDataset; Var stream: TStream);
+Begin
+ {$IFDEF RESTDWMEMTABLE}
+ If Dataset.InheritsFrom(TRESTDWMemTable) then
+ SaveDWMemToStream(TRESTDWMemTable(Dataset), stream)
+ Else
+ SaveDatasetToStream(Dataset, stream);
+ {$ELSE} //TODO SaveFromStream
+ {$IFDEF UNIDACMEM}
+
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+
+ {$ENDIF}
+ {$ENDIF}
+End;
+
+Constructor TConnectionDefs.Create;
+Begin
+ Inherited;
+ vdbPort := -1;
+ vDWDatabaseType := dbtUndefined;
+End;
+
+Destructor TConnectionDefs.Destroy;
+Begin
+ Inherited;
+End;
+
+Function TConnectionDefs.GetDatabaseType(Value : String) : TRESTDWDatabaseType;
+Begin
+ Result := dbtUndefined;
+ If LowerCase(Value) = LowerCase('dbtUndefined') Then
+ Result := dbtUndefined
+ Else If LowerCase(Value) = LowerCase('dbtAccess') Then
+ Result := dbtAccess
+ Else If LowerCase(Value) = LowerCase('dbtDbase') Then
+ Result := dbtDbase
+ Else If LowerCase(Value) = LowerCase('dbtFirebird') Then
+ Result := dbtFirebird
+ Else If LowerCase(Value) = LowerCase('dbtInterbase') Then
+ Result := dbtInterbase
+ Else If LowerCase(Value) = LowerCase('dbtMySQL') Then
+ Result := dbtMySQL
+ Else If LowerCase(Value) = LowerCase('dbtMsSQL') Then
+ Result := dbtMsSQL
+ Else If LowerCase(Value) = LowerCase('dbtOracle') Then
+ Result := dbtOracle
+ Else If LowerCase(Value) = LowerCase('dbtODBC') Then
+ Result := dbtODBC
+ Else If LowerCase(Value) = LowerCase('dbtParadox') Then
+ Result := dbtParadox
+ Else If LowerCase(Value) = LowerCase('dbtPostgreSQL') Then
+ Result := dbtPostgreSQL
+ Else If LowerCase(Value) = LowerCase('dbtSQLLite') Then
+ Result := dbtSQLLite
+ Else If LowerCase(Value) = LowerCase('dbtAdo') Then
+ Result := dbtAdo;
+End;
+
+Function TConnectionDefs.GetDatabaseType(Value : TRESTDWDatabaseType) : String;
+Begin
+ Case Value Of
+ dbtUndefined : Result := LowerCase('dbtUndefined');
+ dbtAccess : Result := LowerCase('dbtAccess');
+ dbtDbase : Result := LowerCase('dbtDbase');
+ dbtFirebird : Result := LowerCase('dbtFirebird');
+ dbtInterbase : Result := LowerCase('dbtInterbase');
+ dbtMySQL : Result := LowerCase('dbtMySQL');
+ dbtSQLLite : Result := LowerCase('dbtSQLLite');
+ dbtOracle : Result := LowerCase('dbtOracle');
+ dbtMsSQL : Result := LowerCase('dbtMsSQL');
+ dbtParadox : Result := LowerCase('dbtParadox');
+ dbtPostgreSQL : Result := LowerCase('dbtPostgreSQL');
+ dbtODBC : Result := LowerCase('dbtODBC');
+ dbtAdo : Result := LowerCase('dbtAdo');
+ End;
+End;
+
+Procedure TConnectionDefs.Assign(Source : TPersistent);
+Var
+ Src : TConnectionDefs;
+Begin
+ If Source is TConnectionDefs Then
+ Begin
+ Src := TConnectionDefs(Source);
+ votherDetails := Src.votherDetails;
+ vDatabaseName := Src.vDatabaseName;
+ vHostName := Src.vHostName;
+ vUsername := Src.vUsername;
+ vPassword := Src.vPassword;
+ vdbPort := Src.vdbPort;
+ vDriverID := Src.vDriverID;
+ vDataSource := Src.vDataSource;
+ End
+ Else
+ Inherited;
+End;
+
+Function TConnectionDefs.ToJSON : String;
+Begin
+ Result := Format('{"databasename":"%s","hostname":"%s",'+
+ '"username":"%s","password":"%s","dbPort":%d,'+
+ '"otherDetails":"%s","charset":"%s","databasetype":"%s","protocol":"%s",'+
+ '"driverID":"%s","datasource":"%s"}',
+ [EncodeStrings(vDatabaseName{$IFDEF FPC}, csUndefined{$ENDIF}),
+ EncodeStrings(vHostName {$IFDEF FPC}, csUndefined{$ENDIF}),
+ EncodeStrings(vUsername {$IFDEF FPC}, csUndefined{$ENDIF}),
+ EncodeStrings(vPassword {$IFDEF FPC}, csUndefined{$ENDIF}),
+ vdbPort,
+ EncodeStrings(votherDetails{$IFDEF FPC}, csUndefined{$ENDIF}),
+ EncodeStrings(vCharset {$IFDEF FPC}, csUndefined{$ENDIF}),
+ EncodeStrings(GetDatabaseType(vDWDatabaseType){$IFDEF FPC}, csUndefined{$ENDIF}),
+ EncodeStrings(vProtocol {$IFDEF FPC}, csUndefined{$ENDIF}),
+ EncodeStrings(vDriverID {$IFDEF FPC}, csUndefined{$ENDIF}),
+ EncodeStrings(vDataSource{$IFDEF FPC}, csUndefined{$ENDIF})]);
+End;
+
+Procedure TConnectionDefs.LoadFromJSON(Value : String);
+Var
+ bJsonValue : TRESTDWJSONInterfaceObject;
+Begin
+ bJsonValue := TRESTDWJSONInterfaceObject.Create(Value);
+ Try
+ If bJsonValue.PairCount > 0 Then
+ Begin
+ vDatabaseName := DecodeStrings(bJsonValue.Pairs[0].Value{$IFDEF FPC}, csUndefined{$ENDIF});
+ vHostName := DecodeStrings(bJsonValue.Pairs[1].Value{$IFDEF FPC}, csUndefined{$ENDIF});
+ vUsername := DecodeStrings(bJsonValue.Pairs[2].Value{$IFDEF FPC}, csUndefined{$ENDIF});
+ vPassword := DecodeStrings(bJsonValue.Pairs[3].Value{$IFDEF FPC}, csUndefined{$ENDIF});
+ If bJsonValue.Pairs[4].Value <> '' Then
+ vdbPort := StrToInt(bJsonValue.Pairs[4].Value)
+ Else
+ vdbPort := -1;
+ votherDetails := DecodeStrings(bJsonValue.Pairs[5].Value{$IFDEF FPC}, csUndefined{$ENDIF});
+ vCharset := DecodeStrings(bJsonValue.Pairs[6].Value{$IFDEF FPC}, csUndefined{$ENDIF});
+ vDWDatabaseType := GetDatabaseType(DecodeStrings(bJsonValue.Pairs[7].Value{$IFDEF FPC}, csUndefined{$ENDIF}));
+ vProtocol := DecodeStrings(bJsonValue.Pairs[8].Value{$IFDEF FPC}, csUndefined{$ENDIF});
+ vDriverID := DecodeStrings(bJsonValue.Pairs[9].Value{$IFDEF FPC}, csUndefined{$ENDIF});
+ vDataSource := DecodeStrings(bJsonValue.Pairs[10].Value{$IFDEF FPC}, csUndefined{$ENDIF});
+ End;
+ Finally
+ FreeAndNil(bJsonValue);
+ End;
+End;
+
+// === { TRESTDWMTMemoryRecord } ====================================================
+Constructor TRESTDWMTMemoryRecord.Create(MemoryData: TRESTDWMemTableAE);
+Begin
+ FIsNull := True;
+ FIndex := -1;
+ CreateEx(MemoryData, True);
+End;
+
+Constructor TRESTDWMTMemoryRecord.CreateEx(MemoryData: TRESTDWMemTableAE; UpdateParent: Boolean);
+Begin
+ Inherited Create;
+ SetMemoryData(MemoryData, UpdateParent);
+End;
+
+Destructor TRESTDWMTMemoryRecord.Destroy;
+Begin
+ SetMemoryData(Nil, False);
+// Finalize(FBlobs);
+// SetLength(FBlobs, 0);
+ Inherited Destroy;
+End;
+
+Function TRESTDWMTMemoryRecord.GetIndex: Integer;
+Begin
+// If FMemoryData <> Nil then
+// Result := FMemoryData.FRecords.IndexOf(Self)
+// Else
+ Result := FIndex;
+End;
+
+Procedure TRESTDWMTMemoryRecord.SetMemoryData(Value: TRESTDWMemTableAE; UpdateParent: Boolean);
+var
+ I, DataSize: Integer;
+Begin
+ If FMemoryData <> Value then
+ Begin
+ If FMemoryData <> nil then
+ Begin
+ If TRESTDWMemTable(FMemoryData).BlobFieldCount > 0 Then
+ Begin
+// {$IFDEF FPC}
+ SetLength(FBlobs, 0); //Finalize(FBlobs, FMemoryData.BlobFieldCount);
+// {$ELSE}
+// Finalize(FBlobs);
+// {$ENDIF}
+ End;
+ TRESTDWMemTable(FMemoryData).FRecords.Remove(Self);
+ {$IFDEF FPC}
+ ReallocMem(FData, 0);
+ {$ELSE}
+ FreeMem(FData, SizeOf(FData));
+// ReallocMem(FData, 0);
+ {$ENDIF}
+ FMemoryData := Nil;
+ End;
+ If Value <> Nil then
+ Begin
+ If UpdateParent then
+ Begin
+ TRESTDWMemTable(Value).FRecords.Add(Self);
+ Inc(TRESTDWMemTable(Value).FLastID);
+ FID := TRESTDWMemTable(Value).FLastID;
+ End;
+ FMemoryData := Value;
+ If TRESTDWMemTable(Value).BlobFieldCount > 0 then
+ Begin
+ SetLength(FBlobs, 0);
+ SetLength(FBlobs, TRESTDWMemTable(Value).BlobFieldCount);
+ End;
+ DataSize := 0;
+ For I := 0 to TRESTDWMemTable(Value).Fields.Count - 1 do
+ CalcDataSize(TRESTDWMemTable(Value).Fields[I], DataSize);
+ ReallocMem(FData, DataSize);
+ End;
+ End;
+End;
+
+Procedure TRESTDWMTMemoryRecord.SetIndex(Value: Integer);
+var
+ CurIndex: Integer;
+Begin
+ CurIndex := GetIndex;
+ If (CurIndex >= 0) and (CurIndex <> Value) then
+ TRESTDWMemTable(FMemoryData).FRecords.Move(CurIndex, Value);
+ FIndex := Value;
+End;
+
+end.
diff --git a/CORE/Source/Basic/uRESTDWBasicTypes.pas b/CORE/Source/Basic/uRESTDWBasicTypes.pas
index 54766db5..20b16d41 100644
--- a/CORE/Source/Basic/uRESTDWBasicTypes.pas
+++ b/CORE/Source/Basic/uRESTDWBasicTypes.pas
@@ -37,9 +37,33 @@
DbTables,
{$IFEND}
{$ENDIF}
- SysUtils, Classes, Db, FMTBcd,
- uRESTDWAbout, uRESTDWMemoryDataset, uRESTDWConsts,
- uRESTDWProtoTypes, uRESTDWTools;
+ SysUtils, Classes, Db, FMTBcd,
+ uRESTDWAbout, uRESTDWConsts,
+ uRESTDWProtoTypes, uRESTDWTools,
+ uRESTDWBasicDbTypes
+ {$IFDEF UNIDACMEM}
+ , DADump, UniDump, VirtualTable, MemDS
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ , ZAbstractRODataset, ZAbstractDataset, ZMemTable, ZDataset
+ {$ENDIF}
+ {$IFNDEF FPC}
+ {$IF CompilerVersion > 22} // Delphi 2010 pra cima
+ {$IFDEF RESTFDMEMTABLE}
+ , FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
+ FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
+ FireDAC.Comp.DataSet, FireDAC.Comp.Client
+ {$IFNDEF FPC}
+ {$IF CompilerVersion > 26} // Delphi XE6 pra cima
+ , FireDAC.Stan.StorageBin
+ {$IFEND}
+ {$ENDIF}
+ {$ENDIF}
+ {$IFEND}
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ , uRESTDWMemoryDataset
+ {$ENDIF} ;
Type
TFieldDefinition = Class
@@ -57,6 +81,7 @@
MessageText: String;
End;
+ {$IFDEF FPC}
Type
TSQLTimeStamp = Record
Year,
@@ -67,20 +92,7 @@
Second : Word;
Fractions : Cardinal;
End;
-
-type
- TSQLTimeStampOffset = record
- Year,
- Month,
- Day,
- Hour,
- Minute,
- Second : Word;
- Fractions : Cardinal;
- TimeZoneHour: SmallInt;
- TimeZoneMinute: SmallInt;
- end;
-
+ {$ENDIF}
Type
TClassNull= Class(TComponent)
@@ -109,44 +121,6 @@ TSQLTimeStampOffset = record
property ProxyUsername : String Read FUsername Write FUserName;
End;
-
- Type
- TConnectionDefs = Class(TPersistent)
- Private
- votherDetails,
- vCharset,
- vDatabaseName,
- vHostName,
- vUsername,
- vPassword,
- vProtocol,
- vDriverID,
- vDataSource : String;
- vdbPort : Integer;
- vDWDatabaseType : TRESTDWDatabaseType;
- Private
- Function GetDatabaseType(Value : String) : TRESTDWDatabaseType;Overload;
- Function GetDatabaseType(Value : TRESTDWDatabaseType) : String; Overload;
- Public
- Constructor Create; //Cria o Componente
- Destructor Destroy;Override;//Destroy a Classe
- Procedure Assign(Source : TPersistent); Override;
- Function ToJSON : String;
- Procedure LoadFromJSON(Value : String);
- Published
- Property DriverType : TRESTDWDatabaseType Read vDWDatabaseType Write vDWDatabaseType;
- Property Charset : String Read vCharset Write vCharset;
- Property DriverID : String Read vDriverID Write vDriverID;
- Property DatabaseName : String Read vDatabaseName Write vDatabaseName;
- Property HostName : String Read vHostName Write vHostName;
- Property Username : String Read vUsername Write vUsername;
- Property Password : String Read vPassword Write vPassword;
- Property Protocol : String Read vProtocol Write vProtocol;
- Property DBPort : Integer Read vdbPort Write vdbPort;
- Property DataSource : String Read vDataSource Write vDataSource;
- Property OtherDetails : String Read votherDetails Write votherDetails;
- End;
-
Type
TRESTDWDataRoute = Class
Private
@@ -248,7 +222,30 @@ TSQLTimeStampOffset = record
End;
Type
- TRESTDWClientSQLBase = Class(TRESTDWMemTableEx) //Classe com as funcionalidades de um DBQuery
+ {$IFDEF FPC}
+ {$IFDEF UNIDACMEM}
+ TRESTDWClientSQLBase = Class(TVirtualTable)
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TRESTDWClientSQLBase = Class(TZMemTable)
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWClientSQLBase = Class(TRESTDWMemTableEx) //Classe com as funcionalidades de um DBQuery
+ {$ENDIF}
+ {$ELSE}
+ {$IFDEF UNIDACMEM}
+ TRESTDWClientSQLBase = Class(TVirtualTable)
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TRESTDWClientSQLBase = Class(TZMemTable)
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TRESTDWClientSQLBase = Class(TFDMemtable) //Classe com as funcionalidades de um DBQuery
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWClientSQLBase = Class(TRESTDWMemTableEx) //Classe com as funcionalidades de um DBQuery
+ {$ENDIF}
+ {$ENDIF}
Private
fsAbout : TRESTDWAboutInfo;
vComponentTag,
@@ -261,6 +258,7 @@ TSQLTimeStampOffset = record
vOnWriterProcess : TOnWriterProcess;
Function OnEditingState : Boolean;
Public
+ Property BinaryCompatibleMode : Boolean Read vBinaryCompatibleMode;
Procedure BaseOpen;
Procedure BaseClose;
Procedure ForceInternalCalc;
@@ -311,6 +309,8 @@ TSQLTimeStampOffset = record
uRESTDWDataJSON, uRESTDWJSONInterface, uRESTDWBasicDB,
uRESTDWDataUtils, uRESTDWMimeTypes;
+{ TRESTDWStorageBase }
+
Class Function TRESTDWStreamHelper.ReadBytes(Const AStream : TStream;
Var VBytes : TRESTDWBytes;
Const ACount,
@@ -442,135 +442,6 @@ TSQLTimeStampOffset = record
Inherited Create(AFile, fmOpenRead or fmShareDenyWrite);
End;
-Constructor TConnectionDefs.Create;
-Begin
- Inherited;
- vdbPort := -1;
- vDWDatabaseType := dbtUndefined;
-End;
-
-Destructor TConnectionDefs.Destroy;
-Begin
- Inherited;
-End;
-
-Function TConnectionDefs.GetDatabaseType(Value : String) : TRESTDWDatabaseType;
-Begin
- Result := dbtUndefined;
- If LowerCase(Value) = LowerCase('dbtUndefined') Then
- Result := dbtUndefined
- Else If LowerCase(Value) = LowerCase('dbtAccess') Then
- Result := dbtAccess
- Else If LowerCase(Value) = LowerCase('dbtDbase') Then
- Result := dbtDbase
- Else If LowerCase(Value) = LowerCase('dbtFirebird') Then
- Result := dbtFirebird
- Else If LowerCase(Value) = LowerCase('dbtInterbase') Then
- Result := dbtInterbase
- Else If LowerCase(Value) = LowerCase('dbtMySQL') Then
- Result := dbtMySQL
- Else If LowerCase(Value) = LowerCase('dbtMsSQL') Then
- Result := dbtMsSQL
- Else If LowerCase(Value) = LowerCase('dbtOracle') Then
- Result := dbtOracle
- Else If LowerCase(Value) = LowerCase('dbtODBC') Then
- Result := dbtODBC
- Else If LowerCase(Value) = LowerCase('dbtParadox') Then
- Result := dbtParadox
- Else If LowerCase(Value) = LowerCase('dbtPostgreSQL') Then
- Result := dbtPostgreSQL
- Else If LowerCase(Value) = LowerCase('dbtSQLLite') Then
- Result := dbtSQLLite
- Else If LowerCase(Value) = LowerCase('dbtAdo') Then
- Result := dbtAdo;
-End;
-
-Function TConnectionDefs.GetDatabaseType(Value : TRESTDWDatabaseType) : String;
-Begin
- Case Value Of
- dbtUndefined : Result := LowerCase('dbtUndefined');
- dbtAccess : Result := LowerCase('dbtAccess');
- dbtDbase : Result := LowerCase('dbtDbase');
- dbtFirebird : Result := LowerCase('dbtFirebird');
- dbtInterbase : Result := LowerCase('dbtInterbase');
- dbtMySQL : Result := LowerCase('dbtMySQL');
- dbtSQLLite : Result := LowerCase('dbtSQLLite');
- dbtOracle : Result := LowerCase('dbtOracle');
- dbtMsSQL : Result := LowerCase('dbtMsSQL');
- dbtParadox : Result := LowerCase('dbtParadox');
- dbtPostgreSQL : Result := LowerCase('dbtPostgreSQL');
- dbtODBC : Result := LowerCase('dbtODBC');
- dbtAdo : Result := LowerCase('dbtAdo');
- End;
-End;
-
-Procedure TConnectionDefs.Assign(Source : TPersistent);
-Var
- Src : TConnectionDefs;
-Begin
- If Source is TConnectionDefs Then
- Begin
- Src := TConnectionDefs(Source);
- votherDetails := Src.votherDetails;
- vDatabaseName := Src.vDatabaseName;
- vHostName := Src.vHostName;
- vUsername := Src.vUsername;
- vPassword := Src.vPassword;
- vdbPort := Src.vdbPort;
- vDriverID := Src.vDriverID;
- vDataSource := Src.vDataSource;
- End
- Else
- Inherited;
-End;
-
-Function TConnectionDefs.ToJSON : String;
-Begin
- Result := Format('{"databasename":"%s","hostname":"%s",'+
- '"username":"%s","password":"%s","dbPort":%d,'+
- '"otherDetails":"%s","charset":"%s","databasetype":"%s","protocol":"%s",'+
- '"driverID":"%s","datasource":"%s"}',
- [EncodeStrings(vDatabaseName{$IFDEF FPC}, csUndefined{$ENDIF}),
- EncodeStrings(vHostName {$IFDEF FPC}, csUndefined{$ENDIF}),
- EncodeStrings(vUsername {$IFDEF FPC}, csUndefined{$ENDIF}),
- EncodeStrings(vPassword {$IFDEF FPC}, csUndefined{$ENDIF}),
- vdbPort,
- EncodeStrings(votherDetails{$IFDEF FPC}, csUndefined{$ENDIF}),
- EncodeStrings(vCharset {$IFDEF FPC}, csUndefined{$ENDIF}),
- EncodeStrings(GetDatabaseType(vDWDatabaseType){$IFDEF FPC}, csUndefined{$ENDIF}),
- EncodeStrings(vProtocol {$IFDEF FPC}, csUndefined{$ENDIF}),
- EncodeStrings(vDriverID {$IFDEF FPC}, csUndefined{$ENDIF}),
- EncodeStrings(vDataSource{$IFDEF FPC}, csUndefined{$ENDIF})]);
-End;
-
-Procedure TConnectionDefs.LoadFromJSON(Value : String);
-Var
- bJsonValue : TRESTDWJSONInterfaceObject;
-Begin
- bJsonValue := TRESTDWJSONInterfaceObject.Create(Value);
- Try
- If bJsonValue.PairCount > 0 Then
- Begin
- vDatabaseName := DecodeStrings(bJsonValue.Pairs[0].Value{$IFDEF FPC}, csUndefined{$ENDIF});
- vHostName := DecodeStrings(bJsonValue.Pairs[1].Value{$IFDEF FPC}, csUndefined{$ENDIF});
- vUsername := DecodeStrings(bJsonValue.Pairs[2].Value{$IFDEF FPC}, csUndefined{$ENDIF});
- vPassword := DecodeStrings(bJsonValue.Pairs[3].Value{$IFDEF FPC}, csUndefined{$ENDIF});
- If bJsonValue.Pairs[4].Value <> '' Then
- vdbPort := StrToInt(bJsonValue.Pairs[4].Value)
- Else
- vdbPort := -1;
- votherDetails := DecodeStrings(bJsonValue.Pairs[5].Value{$IFDEF FPC}, csUndefined{$ENDIF});
- vCharset := DecodeStrings(bJsonValue.Pairs[6].Value{$IFDEF FPC}, csUndefined{$ENDIF});
- vDWDatabaseType := GetDatabaseType(DecodeStrings(bJsonValue.Pairs[7].Value{$IFDEF FPC}, csUndefined{$ENDIF}));
- vProtocol := DecodeStrings(bJsonValue.Pairs[8].Value{$IFDEF FPC}, csUndefined{$ENDIF});
- vDriverID := DecodeStrings(bJsonValue.Pairs[9].Value{$IFDEF FPC}, csUndefined{$ENDIF});
- vDataSource := DecodeStrings(bJsonValue.Pairs[10].Value{$IFDEF FPC}, csUndefined{$ENDIF});
- End;
- Finally
- FreeAndNil(bJsonValue);
- End;
-End;
-
Function RPos(const Substr, S: string): Integer;
Var
I, X, Len: Integer;
@@ -620,7 +491,11 @@ TSQLTimeStampOffset = record
vOnWriterProcess := Nil;
vBinaryCompatibleMode := False;
vLoadFromStream := False;
- vBinaryCompatibleMode := True;
+ {$IFDEF RESTDWMEMTABLE}
+ vBinaryCompatibleMode := True;
+ {$ELSE}
+ vBinaryCompatibleMode := False;
+ {$ENDIF}
End;
Function TRESTDWClientSQLBase.OnEditingState: Boolean;
diff --git a/CORE/Source/Basic/uRESTDWComponentEvents.pas b/CORE/Source/Basic/uRESTDWComponentEvents.pas
index 106595c8..f3bda322 100644
--- a/CORE/Source/Basic/uRESTDWComponentEvents.pas
+++ b/CORE/Source/Basic/uRESTDWComponentEvents.pas
@@ -32,7 +32,7 @@ interface
Uses
SysUtils, Classes, Db,
- uRESTDWDataUtils, uRESTDWParams, uRESTDWBasicTypes, uRESTDWProtoTypes,
+ uRESTDWDataUtils, uRESTDWParams, uRESTDWBasicDbTypes, uRESTDWProtoTypes,
uRESTDWConsts, uRESTDWMassiveBuffer, uRESTDWAuthenticators;
Type
diff --git a/CORE/Source/Basic/uRESTDWDesignReg.pas b/CORE/Source/Basic/uRESTDWDesignReg.pas
index 59c004b1..a51c986b 100644
--- a/CORE/Source/Basic/uRESTDWDesignReg.pas
+++ b/CORE/Source/Basic/uRESTDWDesignReg.pas
@@ -27,14 +27,14 @@ interface
uses
{$IFDEF FPC}
- {$IFNDEF RESTDWLAMW}StdCtrls, {$ENDIF}
+ {$IFNDEF RESTDWLAMW}StdCtrls, {$ENDIF}
ComCtrls, Forms, ExtCtrls, DBCtrls, DBGrids, Dialogs, Controls,
LResources, LazFileUtils,
- {$IFNDEF RESTDWLAMW}
- FormEditingIntf, PropEdits, lazideintf,
- ProjectIntf, ComponentEditors,
- {$ENDIF}
- fpWeb, TypInfo,
+ {$IFNDEF RESTDWLAMW}
+ FormEditingIntf, PropEdits, lazideintf,
+ ProjectIntf, ComponentEditors,
+ {$ENDIF}
+ fpWeb, TypInfo,
{$ELSE}
{$IFNDEF RESTDWLAMW}
Windows,
@@ -56,8 +56,9 @@ interface
Menus,
{$ENDIF}
uRESTDWBasicClass, uRESTDWDatamodule, uRESTDWServerEvents, uRESTDWBasicDB,
- uRESTDWServerContext, uRESTDWServerRoutes, uRESTDWMassiveBuffer, uRESTDWMemoryDataset,
- uRESTDWBufferDb, uRESTDWAbout, uRESTDWDriverBase, uRESTDWAuthenticators;
+ uRESTDWServerContext, uRESTDWServerRoutes, uRESTDWMassiveBuffer,
+ uRESTDWMemoryDataset, uRESTDWBufferDb, uRESTDWAbout, uRESTDWDriverBase,
+ uRESTDWAuthenticators;
{$IFNDEF RESTDWDELPHINET}
Const
@@ -151,7 +152,7 @@ TDriverConnectionListProperty = class(TComponentProperty)
{$IFNDEF RESTDWLAZARUS}
Type
- TDSDesignerDW = Class(TDSDesigner)
+ TRESTDWDesigner = Class(TDSDesigner)
Private
Public
{$IFDEF DELPHI2006UP}
@@ -431,10 +432,9 @@ procedure UnregisterAboutBox;
{$ENDIF}
{$ENDIF}
-
{$IFNDEF RESTDWLAMW}
{$IFNDEF RESTDWLAZARUS}
-Procedure TDSDesignerDW.BeginUpdateFieldDefs;
+Procedure TRESTDWDesigner.BeginUpdateFieldDefs;
Var
Idx: Integer;
Begin
@@ -446,21 +446,21 @@ procedure UnregisterAboutBox;
End;
End;
-Procedure TDSDesignerDW.EndUpdateFieldDefs;
+Procedure TRESTDWDesigner.EndUpdateFieldDefs;
Begin
Inherited;
If TRESTDWClientSQL(DataSet).Active Then
TRESTDWClientSQL(DataSet).Close;
End;
-Procedure TDSDesignerDW.InitializeMenu(Menu: TPopupMenu);
+Procedure TRESTDWDesigner.InitializeMenu(Menu: TPopupMenu);
Begin
Inherited;
// Ao clicar duas vezes no componente RESTDWClientSQL
// ou ao selecionar no popup menu opção "Fields Editor".
End;
-Procedure TDSDesignerDW.UpdateMenus(Menu: TPopupMenu; EditState: TEditState);
+Procedure TRESTDWDesigner.UpdateMenus(Menu: TPopupMenu; EditState: TEditState);
Begin
// Ao acionar o popup menu dos Fields persistents: (Add, Add All, New Field)
Inherited;
@@ -478,7 +478,7 @@ procedure UnregisterAboutBox;
TRESTDWClientSQL(Component).Close;
TRESTDWClientSQL(Component).CreateDatasetFromList;
{$ENDIF}
- ShowFieldsEditor(Designer, TRESTDWClientSQL(Component), TDSDesignerDW);
+ ShowFieldsEditor(Designer, TRESTDWClientSQL(Component), TRESTDWDesigner);
Finally
{$IFDEF DELPHIXEUP}
TRESTDWClientSQL(Component).SetInDesignEvents(False);
@@ -511,9 +511,9 @@ procedure TRESTDWClientSQLEditor.ExecuteVerb(Index: Integer);
End;
{$IFDEF DELPHI2006UP}
-Function TDSDesignerDW.DoCreateField(const FieldName: WideString; Origin: string): TField;
+Function TRESTDWDesigner.DoCreateField(const FieldName: WideString; Origin: string): TField;
{$ELSE}
-Function TDSDesignerDW.DoCreateField(const FieldName: String; Origin: string): TField;
+Function TRESTDWDesigner.DoCreateField(const FieldName: String; Origin: string): TField;
{$ENDIF}
Var
F: TField;
@@ -560,12 +560,12 @@ procedure TRESTDWClientSQLEditor.ExecuteVerb(Index: Integer);
End;
End;
-Function TDSDesignerDW.SupportsAggregates: Boolean;
+Function TRESTDWDesigner.SupportsAggregates: Boolean;
Begin
Result := True;
End;
-Function TDSDesignerDW.SupportsInternalCalc: Boolean;
+Function TRESTDWDesigner.SupportsInternalCalc: Boolean;
Begin
Result := True;
End;
@@ -792,9 +792,11 @@ procedure TRESTDWContextRulesEditor.ExecuteVerb(Index: Integer);
RegField(TStreamField);
// RegField(TRESTDWSQLTimeStampOffsetField);
{$ELSE}
- RegisterFields([TStringFieldRESTDW]);
- RegisterFields([TRESTDWNumericField]);
- RegisterFields([TStreamField]);
+ {$IFDEF RESTDWMEMTABLE}
+ RegisterFields([TStringFieldRESTDW]);
+ RegisterFields([TRESTDWNumericField]);
+ RegisterFields([TStreamField]);
+ {$ENDIF}
{$ENDIF}
{$IFDEF FPC}
{$I RESTDataWareComponents_LAMW.lrs}
@@ -824,7 +826,7 @@ procedure TRESTDWContextRulesEditor.ExecuteVerb(Index: Integer);
{$IFNDEF RESTDWLAMW}
RegisterComponents('REST Dataware - Tools', [TRESTDWResponseTranslator, TRESTDWBufferDB]);
{$ENDIF}
- RegisterComponents('REST Dataware - DB', [TRESTDWPoolerDB, TRESTDWMemTable, TRESTDWClientSQL,
+ RegisterComponents('REST Dataware - DB', [TRESTDWPoolerDB, TRESTDWMemTable, TRESTDWClientSQL,
TRESTDWTable, TRESTDWUpdateSQL, TRESTDWMassiveSQLCache,
TRESTDWStoredProcedure, TRESTDWMassiveCache, TRESTDWBatchMove]);
RegisterComponents('REST Dataware - Authenticators', [TRESTDWAuthBasic, TRESTDWAuthToken, TRESTDWAuthOAuth]);
diff --git a/CORE/Source/Basic/uRESTDWParams.pas b/CORE/Source/Basic/uRESTDWParams.pas
index dff5feb4..7162215d 100644
--- a/CORE/Source/Basic/uRESTDWParams.pas
+++ b/CORE/Source/Basic/uRESTDWParams.pas
@@ -833,7 +833,7 @@ procedure TRESTDWParamsMethods.PutRecName(Index: String; Item: TRESTDWParamMetho
{$IFDEF DELPHI2010UP}
vRESTDWBytes := StringUtf8ToBytes(DecodeStrings(vTempString{$IFDEF FPC}, csUndefined{$ENDIF}));
If Length(vRESTDWBytes) > 0 Then
- vTempString:= TEncoding.UTF8.Getstring(vRESTDWBytes)
+ vTempString:= TEncoding.UTF8.Getstring(TBytes(vRESTDWBytes))
Else
vTempString:= '';
SetLength(vRESTDWBytes, 0);
diff --git a/CORE/Source/Basic/uRESTDWPoolermethod.pas b/CORE/Source/Basic/uRESTDWPoolermethod.pas
index 336b9de2..d26dbbdb 100644
--- a/CORE/Source/Basic/uRESTDWPoolermethod.pas
+++ b/CORE/Source/Basic/uRESTDWPoolermethod.pas
@@ -33,7 +33,7 @@
Uses
{$IFDEF RESTDWWINDOWS}Windows,{$ENDIF}
SysUtils, Classes,
- uRESTDWMassiveBuffer, uRESTDWComponentEvents, uRESTDWBasicTypes, uRESTDWBasic,
+ uRESTDWMassiveBuffer, uRESTDWComponentEvents, uRESTDWBasicDbTypes, uRESTDWBasic,
uRESTDWProtoTypes, uRESTDWTools, uRESTDWJSONObject, uRESTDWConsts,
uRESTDWDataUtils, uRESTDWParams;
diff --git a/CORE/Source/Basic/uRESTDWStorageBin.pas b/CORE/Source/Basic/uRESTDWStorageBin.pas
index 7ffd8375..05f32c63 100644
--- a/CORE/Source/Basic/uRESTDWStorageBin.pas
+++ b/CORE/Source/Basic/uRESTDWStorageBin.pas
@@ -33,8 +33,31 @@ interface
uses
{$IFNDEF RESTDWLAZARUS}{$IFNDEF RESTDWFPC}SqlTimSt, {$ENDIF}{$ENDIF}
- Classes, SysUtils, uRESTDWMemoryDataset, FmtBcd, DB, Variants, uRESTDWConsts,
- uRESTDWTools{$IFDEF FPC}, uRESTDWBasicTypes{$ENDIF};
+ FmtBcd, DB, Variants, Classes, SysUtils, uRESTDWBasicDbTypes
+ {$IFDEF UNIDACMEM}
+ , DADump, UniDump, VirtualTable, MemDS,
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ , ZAbstractRODataset, ZAbstractDataset, ZMemTable, ZDataset,
+ {$ENDIF}
+ {$IFNDEF FPC}
+ {$IF CompilerVersion > 22} // Delphi 2010 pra cima
+ {$IFDEF RESTFDMEMTABLE}
+ , FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param,
+ FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf,
+ FireDAC.Comp.DataSet, FireDAC.Comp.Client,
+ {$IFNDEF FPC}
+ {$IF CompilerVersion > 26} // Delphi XE6 pra cima
+ FireDAC.Stan.StorageBin,
+ {$IFEND}
+ {$ENDIF}
+ {$ENDIF}
+ {$IFEND}
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ , uRESTDWMemoryDataset,
+ {$ENDIF}
+ uRESTDWConsts, uRESTDWTools, uRESTDWBasicTypes;
Type
TRESTDWStorageBin = Class(TRESTDWStorageBase)
@@ -300,7 +323,18 @@ interface
End;
End;
Var
- ADataSet : TRESTDWMemTable;
+ ADataSet : {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF};
I,
vFieldsCount : DWInteger;
vFieldSize,
@@ -315,7 +349,18 @@ interface
vFieldDef : TFieldDef;
vField : TField;
Begin
- ADataSet := TRESTDWMemTable(IDataset.GetDataset);
+ ADataSet := {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF}(IDataset.GetDataset);
// field count
AStream.Position := 0;
AStream.Read(vFieldsCount, SizeOf(vFieldsCount));
@@ -380,7 +425,9 @@ interface
FFieldExists[I] := (ADataSet.FindField(FFieldNames[I]) <> nil); // or (vNoFields);
// create fieldsDefs like fields persistent
// If ((vNoFields) Or (Not FFieldExists[I])) Then
- ADataSet.FieldAttrs := FFieldAttrs;
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemTable(ADataSet).FieldAttrs := FFieldAttrs;
+ {$ENDIF}
CreateFieldDefs(ADataSet, I);
End;
ADataSet.Open;
@@ -429,7 +476,18 @@ interface
vVarBytes : TRESTDWBytes;
aField : TField;
aIndex : Integer;
- vDataset : TRESTDWMemTable;
+ vDataset : {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF};
vActualRecord : TRESTDWMTMemoryRecord;
vDataType : TFieldType;
vDWFieldType : Byte;
@@ -528,7 +586,18 @@ interface
End;
Begin
pActualRecord := Nil;
- vDataset := TRESTDWMemTable(Dataset.GetDataset);
+ vDataset := {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF}(Dataset.GetDataset);
stream.Read(vRecCount, SizeOf(vRecCount));
vRecCount := vRecCount - 1;
vFieldCount := Length(FFieldNames);
@@ -782,7 +851,9 @@ interface
dwftTimeStampOffset :Begin
{$IF (NOT DEFINED(FPC)) AND (CompilerVersion >= 21)}
stream.Read(vDouble, SizeOf(vDouble));
- vTimeStampOffSet := DateTimeToSQLTimeStampOffset(vDouble);
+ {$IFDEF RESTDWMEMTABLE}
+ vTimeStampOffSet := DateTimeToSQLTimeStampOffset(vDouble);
+ {$ENDIF}
stream.Read(vByte, SizeOf(vByte));
vTimeStampOffSet.TimeZoneHour := vByte - 12;
stream.Read(vByte, SizeOf(vByte));
@@ -1103,14 +1174,18 @@ interface
// + TimeZone - 2 Bytes
Else If (FFieldTypes[i] In [dwftTimeStampOffset]) Then
Begin
- {$IFDEF DELPHIXEUP}
- AStream.Read(vDouble, Sizeof(vDouble));
- vTimeStampOffset := DateTimeToSQLTimeStampOffset(vDouble);
+ {$IFDEF DELPHIXEUP}
+ AStream.Read(vDouble, Sizeof(vDouble));
+ {$IFDEF RESTDWMEMTABLE}
+ vTimeStampOffset := DateTimeToSQLTimeStampOffset(vDouble);
+ {$ENDIF}
AStream.Read(vByte, Sizeof(vByte));
vTimeStampOffset.TimeZoneHour := vByte - 12;
AStream.Read(vByte, Sizeof(vByte));
vTimeStampOffset.TimeZoneMinute := vByte;
- vField.AsSQLTimeStampOffset := vTimeStampOffset;
+ {$IFDEF RESTDWMEMTABLE}
+ vField.AsSQLTimeStampOffset := vTimeStampOffset;
+ {$ENDIF}
{$ELSE}
// field foi transformado em datetime
AStream.Read(vDouble, Sizeof(vDouble));
@@ -1286,7 +1361,18 @@ interface
Procedure TRESTDWStorageBin.SaveDWMemToStream(IDataset : IRESTDWMemTable;
Var AStream : TStream);
Var
- ADataset : TRESTDWMemTable;
+ ADataset : {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF};
I : DWInteger;
vRecordCount : DWInt64;
vString : DWString;
@@ -1295,7 +1381,18 @@ interface
vByte : Byte;
vBookMark : TBookmark;
Begin
- ADataSet := TRESTDWMemTable(IDataset.GetDataset);
+ ADataSet := {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF}(IDataset.GetDataset);
AStream.Size := 0;
If not ADataset.Active Then
ADataset.Open
@@ -1370,7 +1467,18 @@ interface
Function TRESTDWStorageBin.SaveRecordDWMemToStream(Dataset : IRESTDWMemTable;
stream : TStream) : Longint;
Var
- vDataSet : TRESTDWMemTable;
+ vDataSet : {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF};
I, B, aIndex : DWInteger;
vActualRecord : TRESTDWMTMemoryRecord;
PActualRecord : PRESTDWMTMemBuffer;
@@ -1399,13 +1507,26 @@ interface
{$IFEND}
{$ENDIF}
Begin
- vDataSet := TRESTDWMemTable(dataset.GetDataset);
+ vDataSet := {$IFDEF UNIDACMEM}
+ TVirtualTable
+ {$ENDIF}
+ {$IFDEF ZEOSMEM}
+ TZMemTable
+ {$ENDIF}
+ {$IFDEF RESTFDMEMTABLE}
+ TFDMemtable
+ {$ENDIF}
+ {$IFDEF RESTDWMEMTABLE}
+ TRESTDWMemtable
+ {$ENDIF}(dataset.GetDataset);
vFieldCount := vDataSet.Fields.Count - 1;
Result := dataset.GetRecordCount - 1;
For I := 0 To Result Do
Begin
vActualRecord := Dataset.GetMemoryRecord(I);
- pActualRecord := PRESTDWMTMemBuffer(vActualRecord.Data);
+ {$IFDEF RESTDWMEMTABLE}
+ pActualRecord := PRESTDWMTMemBuffer(vActualRecord.Data);
+ {$ENDIF}
vBoolean := False;
For B := 0 To vFieldCount Do
Begin
@@ -1431,10 +1552,12 @@ interface
End;
If Dataset.DataTypeSuported(vDataType) Then
Begin
- If Dataset.DataTypeIsBlobTypes(vDataType) Then
- PData := Pointer(@PMemBlobArray(PActualRecord + Dataset.GetOffSetsBlobs)^[vDataSet.Fields[B].Offset])
- Else
- PData := Pointer(PActualRecord + dataset.GetOffSets(vDataSet.Fields[B]));
+ {$IFDEF RESTDWMEMTABLE}
+ If Dataset.DataTypeIsBlobTypes(vDataType) Then
+ PData := Pointer(@PMemBlobArray(PActualRecord + Dataset.GetOffSetsBlobs)^[vDataSet.Fields[B].Offset])
+ Else
+ PData := Pointer(PActualRecord + dataset.GetOffSets(vDataSet.Fields[B]));
+ {$ENDIF}
End;
vDWFieldType := FieldTypeToDWFieldType(vDataType);
// N Bytes
@@ -1544,7 +1667,9 @@ interface
// + TimeZone - 2 Bytes
dwftTimeStampOffset : Begin
Move(PData^, vTimeStampOffSet, Sizeof(vTimeStampOffSet));
- vDouble := SQLTimeStampOffsetToDateTime(vTimeStampOffSet);
+ {$IFDEF RESTDWMEMTABLE}
+ vDouble := SQLTimeStampOffsetToDateTime(vTimeStampOffSet);
+ {$ENDIF}
Stream.Write(vDouble, Sizeof(vDouble));
vByte := vTimeStampOffSet.TimeZoneHour + 12;
Stream.Write(vByte, Sizeof(vByte));
@@ -1779,8 +1904,10 @@ interface
// TimeStampOffSet To Double - 8 Bytes
// + TimeZone - 2 Bytes
dwftTimeStampOffset : Begin
- vTimeStampOffSet := ADataset.Fields[i].AsSQLTimeStampOffset;
- vDouble := SQLTimeStampOffsetToDateTime(vTimeStampOffSet);
+ {$IFDEF RESTDWMEMTABLE}
+ vTimeStampOffSet := ADataset.Fields[i].AsSQLTimeStampOffset;
+ vDouble := SQLTimeStampOffsetToDateTime(vTimeStampOffSet);
+ {$ENDIF}
AStream.Write(vDouble, Sizeof(vDouble));
vByte := vTimeStampOffSet.TimeZoneHour + 12;
AStream.Write(vByte, Sizeof(vByte));
diff --git a/CORE/Source/Consts/uRESTDWConsts.pas b/CORE/Source/Consts/uRESTDWConsts.pas
index 38ad628a..28af857d 100644
--- a/CORE/Source/Consts/uRESTDWConsts.pas
+++ b/CORE/Source/Consts/uRESTDWConsts.pas
@@ -293,8 +293,9 @@
TRESTDWJSONTypes = Set of TRESTDWJSONType;
TRESTDWMaxLineAction = (maException, maSplit);
TRESTDWOSType = (otUnknown, otUnix, otWindows, otDotNet);
- TRESTDWSSLVersion = (sslvSSLv2, sslvSSLv23, sslvSSLv3, sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2);
+ TRESTDWSSLVersion = (SSLv2, SSLv23, SSLv3, TLSv1, TLSv1_1, TLSv1_2, TLSv1_3);
TRESTDWSSLVersions = set of TRESTDWSSLVersion;
+ TRESTDWSSLMode = (sslUnassigned, sslClient, sslServer, sslBoth);
TTypeObject = (toDataset, toParam, toMassive, toVariable, toObject);
TCaseType = (ctNone, ctUpperCase, ctLowerCase, ctCamelCase);
TRESTDWRouteData = (crAll, crGet, crPost, crPut, crPatch, crDelete, crOption);
diff --git a/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDW.pas b/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDW.pas
index 8b737617..d60e760e 100644
--- a/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDW.pas
+++ b/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDW.pas
@@ -33,7 +33,7 @@ interface
FireDAC.Phys.RESTDWBase;
type
- {$IFDEF DELPHI10_3UP}
+ {$IFDEF DELPHI11UP}
[ComponentPlatformsAttribute(pfidWindows or pfidOSX or pfidLinux)]
{$ENDIF}
TRESTDWFireDACPhysLink = class(TFDPhysRDWBaseDriverLink)
@@ -100,13 +100,13 @@ function TFDPhysRDWDriver.GetConnParams(AKeys: TStrings; AParams: TFDDatSTable):
{-------------------------------------------------------------------------------}
initialization
- {$IFDEF DELPHI10_2UP}
+ {$IFDEF DELPHI11UP}
FDRegisterDriverClass(TFDPhysRDWDriver);
{$ELSE}
FDPhysManager().RegisterDriverClass(TFDPhysRDWDriver);
{$ENDIF}
finalization
- {$IFDEF DELPHI10_2UP}
+ {$IFDEF DELPHI11UP}
FDUnregisterDriverClass(TFDPhysRDWDriver);
{$ENDIF}
diff --git a/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDWBase.pas b/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDWBase.pas
index 07da2a77..2ddb710f 100644
--- a/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDWBase.pas
+++ b/CORE/Source/Database_Drivers/FireDACPhysLink/FireDAC.Phys.RESTDWBase.pas
@@ -120,7 +120,7 @@ TFDPhysRDWCommand = class(TFDPhysCommand)
protected
procedure InternalPrepare; override;
procedure InternalUnprepare; override;
- function InternalOpen{$IFDEF DELPHI10_3UP}(var ACount: TFDCounter){$ENDIF}: Boolean; override;
+ function InternalOpen{$IFDEF DELPHI11UP}(var ACount: TFDCounter){$ENDIF}: Boolean; override;
function InternalNextRecordSet: Boolean; override;
procedure InternalClose; override;
procedure InternalExecute(ATimes, AOffset: integer;
@@ -537,16 +537,16 @@ function TFDPhysRDWCommand.InternalNextRecordSet: Boolean;
Result := False;
end;
-function TFDPhysRDWCommand.InternalOpen{$IFDEF DELPHI10_3UP}(var ACount: TFDCounter){$ENDIF}: Boolean;
+function TFDPhysRDWCommand.InternalOpen{$IFDEF DELPHI11UP}(var ACount: TFDCounter){$ENDIF}: Boolean;
begin
- {$IFDEF DELPHI10_3UP}
+ {$IFDEF DELPHI11UP}
ACount := -1;
{$ENDIF}
Result := False;
case GetMetaInfoKind of
mkNone:
begin
- {$IFDEF DELPHI10_3UP}
+ {$IFDEF DELPHI11UP}
ACount := RDWExecuteComand;
Result := ACount >= 0;
{$ELSE}
@@ -555,7 +555,7 @@ function TFDPhysRDWCommand.InternalOpen{$IFDEF DELPHI10_3UP}(var ACount: TFDCoun
end;
mkTables:
begin
- {$IFDEF DELPHI10_3UP}
+ {$IFDEF DELPHI11UP}
ACount := RDWGetTables;
Result := ACount >= 0;
{$ELSE}
@@ -566,7 +566,7 @@ function TFDPhysRDWCommand.InternalOpen{$IFDEF DELPHI10_3UP}(var ACount: TFDCoun
end;
mkPrimaryKeyFields:
begin
- {$IFDEF DELPHI10_3UP}
+ {$IFDEF DELPHI11UP}
ACount := RDWGetPKTablesFields(GetBaseObjectName);
Result := ACount >= 0;
{$ELSE}
@@ -577,7 +577,7 @@ function TFDPhysRDWCommand.InternalOpen{$IFDEF DELPHI10_3UP}(var ACount: TFDCoun
end;
mkTableFields:
begin
- {$IFDEF DELPHI10_3UP}
+ {$IFDEF DELPHI11UP}
ACount := RDWGetTablesFields(GetBaseObjectName);
Result := ACount >= 0;
{$ELSE}
diff --git a/CORE/Source/Database_Drivers/uRESTDWAnyDACDriver.pas b/CORE/Source/Database_Drivers/uRESTDWAnyDACDriver.pas
index bcf6f378..a1f6bc67 100644
--- a/CORE/Source/Database_Drivers/uRESTDWAnyDACDriver.pas
+++ b/CORE/Source/Database_Drivers/uRESTDWAnyDACDriver.pas
@@ -87,7 +87,7 @@ TRESTDWAnyDACQuery = class(TRESTDWDrvQuery)
TRESTDWAnyDACDriver = class(TRESTDWDriverBase)
protected
Function compConnIsValid(comp : TComponent) : boolean; override;
- function getConectionType : TRESTDWDatabaseType; override;
+ function getConnectionType : TRESTDWDatabaseType; override;
public
function getQuery : TRESTDWDrvQuery; override;
function getQuery(AUnidir : boolean) : TRESTDWDrvQuery; override;
@@ -138,12 +138,12 @@ procedure TRESTDWAnyDACStoreProc.Prepare;
{ TRESTDWAnyDACDriver }
-function TRESTDWAnyDACDriver.getConectionType : TRESTDWDatabaseType;
+function TRESTDWAnyDACDriver.getConnectionType : TRESTDWDatabaseType;
var
conn : string;
i: integer;
begin
- Result:=inherited getConectionType;
+ Result:=inherited getConnectionType;
if not Assigned(Connection) then
Exit;
diff --git a/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas b/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas
index e02a2e3d..a70fb8ad 100644
--- a/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas
+++ b/CORE/Source/Database_Drivers/uRESTDWDriverBase.pas
@@ -31,9 +31,12 @@
Uses
Classes, SysUtils, TypInfo, DB, Variants, StrUtils,
- uRESTDWMemoryDataset, uRESTDWParams, uRESTDWAbout, uRESTDWComponentEvents,
+ {$IFDEF RESTDWMEMTABLE}
+ uRESTDWMemoryDataset,
+ {$ENDIF}
+ uRESTDWParams, uRESTDWAbout, uRESTDWComponentEvents,
uRESTDWJSONInterface, uRESTDWBufferBase, uRESTDWConsts, uRESTDWDatamodule,
- uRESTDWBasicTypes, uRESTDWProtoTypes, uRESTDWTools, uRESTDWStorageBin,
+ uRESTDWBasicTypes, uRESTDWBasicDbTypes, uRESTDWProtoTypes, uRESTDWTools, uRESTDWStorageBin,
uRESTDWMassiveBuffer;
Type
@@ -261,8 +264,8 @@ TRDWDrvParam = class(TObject)
destructor Destroy; override;
Function compConnIsValid (comp : TComponent) : Boolean;Virtual;
- Function getConectionType : TRESTDWDatabaseType; Virtual;
- Procedure setConectionType(aValue : TRESTDWDatabaseType); Virtual;
+ Function getConnectionType : TRESTDWDatabaseType; Virtual;
+ Procedure setConnectionType(aValue : TRESTDWDatabaseType); Virtual;
Function getDatabaseInfo : TRESTDWDatabaseInfo; Virtual;
Function getQuery : TRESTDWDrvQuery; Overload; Virtual;
Function getQuery (AUnidir : Boolean) : TRESTDWDrvQuery; Overload; Virtual;
@@ -403,7 +406,7 @@ TRDWDrvParam = class(TObject)
Property StorageDataType : TRESTDWStorageBase Read FStorageDataType Write FStorageDataType;
Published
Property Connection : TComponent Read FConnection Write setConnection;
- Property ConectionType : TRESTDWDatabaseType Read getConectionType Write setConectionType;
+ Property ConnectionType : TRESTDWDatabaseType Read getConnectionType Write setConnectionType;
Property StrsTrim : Boolean Read vStrsTrim Write vStrsTrim;
Property StrsEmpty2Null : Boolean Read vStrsEmpty2Null Write vStrsEmpty2Null;
Property StrsTrim2Len : Boolean Read vStrsTrim2Len Write vStrsTrim2Len;
@@ -934,7 +937,7 @@ function TRESTDWDrvDataset.getParamDataType(IParam: integer): TFieldType;
Result := -1;
drv := TRESTDWDriverBase(Self.Owner);
Try
- If drv.getConectionType = dbtMySQL Then
+ If drv.getConnectionType = dbtMySQL Then
Begin
Close;
SQL.Clear;
@@ -953,12 +956,12 @@ function TRESTDWDrvDataset.getParamDataType(IParam: integer): TFieldType;
{ TRESTDWDriverBase }
-Procedure TRESTDWDriverBase.setConectionType(aValue : TRESTDWDatabaseType);
+Procedure TRESTDWDriverBase.setConnectionType(aValue : TRESTDWDatabaseType);
Begin
vDatabaseType := aValue;
End;
-function TRESTDWDriverBase.getConectionType : TRESTDWDatabaseType;
+function TRESTDWDriverBase.getConnectionType : TRESTDWDatabaseType;
Begin
Result := vDatabaseType;// : TRESTDWDatabaseType;
// Result := dbtUndefined;
@@ -981,7 +984,7 @@ function TRESTDWDriverBase.getDatabaseInfo : TRESTDWDatabaseInfo;
// ex: no MySQL temos o MariaDB
// ex: no Firebird temos a versao HQBird
sVersion := '';
- connType := getConectionType;
+ connType := getConnectionType;
lst := TStringList.Create;
qry := getQuery;
Try
@@ -1463,7 +1466,7 @@ function TRESTDWDriverBase.GetGenID(Query : TRESTDWDrvQuery; GenName : String; v
connType : TRESTDWDatabaseType;
Begin
Result := -1;
- connType := getConectionType;
+ connType := getConnectionType;
With Query Do
Begin
Close;
@@ -2611,7 +2614,7 @@ function TRESTDWDriverBase.ExecuteCommand(
Error := False;
Result := '';
aResult := TRESTDWJSONValue.Create;
- vTempQuery := getQuery(not Execute);
+ vTempQuery := getQuery(Execute);
vDataSet := TDataSet(vTempQuery.Owner);
try
vStateResource := isConnected;
@@ -2890,7 +2893,7 @@ procedure TRESTDWDriverBase.GetTableNames(var TableNames : TStringList; var Erro
Delete(vTable, InitStrPos, Pos('.', vTable));
end;
}
- connType := getConectionType;
+ connType := getConnectionType;
Try
vStateResource := isConnected;
If Not vStateResource Then
@@ -2985,7 +2988,7 @@ procedure TRESTDWDriverBase.GetFieldNames(TableName : String; var FieldNames : T
vSchema := Copy(vTable, InitStrPos, Pos('.', vTable)-1);
Delete(vTable, InitStrPos, Pos('.', vTable));
End;
- connType := getConectionType;
+ connType := getConnectionType;
Try
vStateResource := isConnected;
If Not vStateResource Then
@@ -3082,7 +3085,7 @@ procedure TRESTDWDriverBase.GetKeyFieldNames(TableName : String; var FieldNames
vSchema := Copy(vTable, InitStrPos, Pos('.', vTable)-1);
Delete(vTable, InitStrPos, Pos('.', vTable));
End;
- connType := getConectionType;
+ connType := getConnectionType;
Try
vStateResource := isConnected;
If Not vStateResource Then
@@ -3237,7 +3240,7 @@ procedure TRESTDWDriverBase.GetProcNames(var ProcNames : TStringList; var Error
If Not Assigned(ProcNames) Then
ProcNames := TStringList.Create;
vSchema := '';
- connType := getConectionType;
+ connType := getConnectionType;
Try
vStateResource := isConnected;
If Not vStateResource Then
@@ -3524,7 +3527,7 @@ procedure TRESTDWDriverBase.GetProcParams(ProcName : String; var ParamNames : TS
vSchema := Copy(vProc, InitStrPos, Pos('.', vProc)-1);
Delete(vProc, InitStrPos, Pos('.', vProc));
End;
- connType := getConectionType;
+ connType := getConnectionType;
Try
vStateResource := isConnected;
If Not vStateResource Then
@@ -3949,7 +3952,6 @@ constructor TRESTDWDriverBase.Create(AOwner: TComponent);
vStrsTrim2Len := vParamCreate;
vEncodeStrings := vParamCreate;
vCompression := vParamCreate;
-
// fernando banhos 25/10/2022
// algumas rotinas de paramscreate foram retiradas devido
// incompatibilidade com outros drivers
diff --git a/CORE/Source/Database_Drivers/uRESTDWFireDACDriver.pas b/CORE/Source/Database_Drivers/uRESTDWFireDACDriver.pas
index 61e62e0d..6dba2ec3 100644
--- a/CORE/Source/Database_Drivers/uRESTDWFireDACDriver.pas
+++ b/CORE/Source/Database_Drivers/uRESTDWFireDACDriver.pas
@@ -26,7 +26,7 @@
interface
uses
- Classes, SysUtils, uRESTDWDriverBase, uRESTDWBasicTypes,
+ Classes, SysUtils, uRESTDWDriverBase, uRESTDWBasicdbTypes,
FireDAC.Comp.Client, FireDAC.Comp.DataSet, FireDAC.Stan.StorageBin,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.DApt.Intf, FireDAC.DApt,
FireDAC.Stan.Param, FireDAC.DatS, DB, uRESTDWBasicDB, uRESTDWProtoTypes,
@@ -94,7 +94,7 @@ TRESTDWFireDACDriver = class(TRESTDWDriverBase)
protected
public
- function getConectionType : TRESTDWDatabaseType; override;
+ function getConnectionType : TRESTDWDatabaseType; override;
Function compConnIsValid(comp : TComponent) : boolean; override;
function getQuery : TRESTDWDrvQuery; override;
function getQuery(AUnidir : boolean) : TRESTDWDrvQuery; override;
@@ -154,26 +154,28 @@ function TRESTDWFireDACDriver.isAutoCommit: boolean;
{$ENDIF}
end;
-function TRESTDWFireDACDriver.getConectionType: TRESTDWDatabaseType;
+function TRESTDWFireDACDriver.getConnectionType: TRESTDWDatabaseType;
var
conn : string;
i: integer;
begin
- Result:=inherited getConectionType;
+ Result := inherited getConnectionType;
if not Assigned(Connection) then
Exit;
-
- conn := LowerCase(TFDConnection(Connection).DriverName);
-
- i := 0;
- while i < Length(rdwFireDACDrivers) do begin
- if Pos(rdwFireDACDrivers[i],conn) > 0 then begin
- Result := rdwFireDACDbType[i];
- Break;
- end;
- i := i + 1;
- end;
-
+ If Result = dbtUndefined Then
+ Begin
+ conn := LowerCase(TFDConnection(Connection).DriverName);
+ i := 0;
+ While i < Length(rdwFireDACDrivers) do
+ Begin
+ If Pos(rdwFireDACDrivers[i], conn) > 0 then
+ Begin
+ Result := rdwFireDACDbType[i];
+ Break;
+ End;
+ i := i + 1;
+ End;
+ End;
// Eloy
case Result of
dbtODBC:
@@ -207,7 +209,6 @@ function TRESTDWFireDACDriver.getQuery: TRESTDWDrvQuery;
qry.ResourceOptions.ParamCreate := True;
qry.ResourceOptions.StoreItems := [siMeta,siData,siDelta];
qry.FetchOptions.Mode := fmAll;
-
Result := TRESTDWFireDACQuery.Create(qry);
end;
@@ -499,7 +500,6 @@ procedure TRESTDWFireDACQuery.SaveToStream(stream: TStream);
begin
qry := TFDQuery(Self.Owner);
qry.SaveToStream(stream, sfBinary);
-
stream.Position := 0;
end;
diff --git a/CORE/Source/Database_Drivers/uRESTDWIBDACDriver.pas b/CORE/Source/Database_Drivers/uRESTDWIBDACDriver.pas
index 2ce2345a..10c4f18d 100644
--- a/CORE/Source/Database_Drivers/uRESTDWIBDACDriver.pas
+++ b/CORE/Source/Database_Drivers/uRESTDWIBDACDriver.pas
@@ -86,7 +86,7 @@ TRESTDWIBDACDriver = class(TRESTDWDriverBase)
procedure setConnection(AValue: TComponent); override;
public
- function getConectionType : TRESTDWDatabaseType; override;
+ function getConnectionType : TRESTDWDatabaseType; override;
Function compConnIsValid(comp : TComponent) : boolean; override;
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
@@ -139,7 +139,7 @@ procedure TRESTDWIBDACStoreProc.Prepare;
{ TRESTDWIBDACDriver }
-function TRESTDWIBDACDriver.getConectionType : TRESTDWDatabaseType;
+function TRESTDWIBDACDriver.getConnectionType : TRESTDWDatabaseType;
begin
// somente Firebird
Result := dbtFirebird;
diff --git a/CORE/Source/Database_Drivers/uRESTDWInterbaseDriver.pas b/CORE/Source/Database_Drivers/uRESTDWInterbaseDriver.pas
index b4db6dd5..55d86b5d 100644
--- a/CORE/Source/Database_Drivers/uRESTDWInterbaseDriver.pas
+++ b/CORE/Source/Database_Drivers/uRESTDWInterbaseDriver.pas
@@ -81,7 +81,7 @@ TRESTDWInterbaseDriver = class(TRESTDWDriverBase)
protected
procedure setConnection(AValue: TComponent); override;
- function getConectionType : TRESTDWDatabaseType; override;
+ function getConnectionType : TRESTDWDatabaseType; override;
Function compConnIsValid(comp : TComponent) : boolean; override;
public
constructor Create(AOwner : TComponent); override;
@@ -255,7 +255,7 @@ procedure TRESTDWInterbaseDriver.setConnection(AValue: TComponent);
inherited setConnection(AValue);
end;
-function TRESTDWInterbaseDriver.getConectionType: TRESTDWDatabaseType;
+function TRESTDWInterbaseDriver.getConnectionType: TRESTDWDatabaseType;
begin
Result := dbtInterbase;
end;
diff --git a/CORE/Source/Database_Drivers/uRESTDWLazarusDriver.pas b/CORE/Source/Database_Drivers/uRESTDWLazarusDriver.pas
index 446e43d6..d248e1e6 100644
--- a/CORE/Source/Database_Drivers/uRESTDWLazarusDriver.pas
+++ b/CORE/Source/Database_Drivers/uRESTDWLazarusDriver.pas
@@ -1,4 +1,4 @@
-unit uRESTDWLazarusDriver;
+unit uRESTDWLazarusDriver;
{
REST Dataware .
@@ -25,7 +25,7 @@ interface
uses
LResources, SQLDB, Classes, SysUtils, DB,
- uRESTDWDriverBase, uRESTDWProtoTypes, uRESTDWBasicTypes;
+ uRESTDWDriverBase, uRESTDWProtoTypes, uRESTDWBasicDbTypes;
const
rdwLazSQLConnector : array[0..9] of string = (('mssql'),('sybase'),
@@ -73,7 +73,7 @@ TRESTDWLazarusDriver = class(TRESTDWDriverBase)
protected
procedure setConnection(AValue: TComponent); override;
- function getConectionType : TRESTDWDatabaseType; override;
+ function getConnectionType : TRESTDWDatabaseType; override;
Function compConnIsValid(comp : TComponent) : boolean; override;
public
constructor Create(AOwner : TComponent); override;
@@ -241,12 +241,12 @@ procedure TRESTDWLazarusDriver.setConnection(AValue: TComponent);
inherited setConnection(AValue);
end;
-function TRESTDWLazarusDriver.getConectionType: TRESTDWDatabaseType;
+function TRESTDWLazarusDriver.getConnectionType: TRESTDWDatabaseType;
var
conn : string;
i: integer;
begin
- Result:=inherited getConectionType;
+ Result:=inherited getConnectionType;
if not Assigned(Connection) then
Exit;
diff --git a/CORE/Source/Database_Drivers/uRESTDWMyDACDriver.pas b/CORE/Source/Database_Drivers/uRESTDWMyDACDriver.pas
index e1c9b6fb..043b34f3 100644
--- a/CORE/Source/Database_Drivers/uRESTDWMyDACDriver.pas
+++ b/CORE/Source/Database_Drivers/uRESTDWMyDACDriver.pas
@@ -81,7 +81,7 @@ TRESTDWMyDACDriver = class(TRESTDWDriverBase)
FTransaction : TMyTransaction;
protected
procedure setConnection(AValue: TComponent); override;
- function getConectionType : TRESTDWDatabaseType; override;
+ function getConnectionType : TRESTDWDatabaseType; override;
Function compConnIsValid(comp : TComponent) : boolean; override;
public
constructor Create(AOwner : TComponent); override;
@@ -135,7 +135,7 @@ procedure TRESTDWMyDACStoreProc.Prepare;
{ TRESTDWMyDACDriver }
-function TRESTDWMyDACDriver.getConectionType : TRESTDWDatabaseType;
+function TRESTDWMyDACDriver.getConnectionType : TRESTDWDatabaseType;
begin
// somente MySQL
Result := dbtMySQL;
diff --git a/CORE/Source/Database_Drivers/uRESTDWUniDACDriver.pas b/CORE/Source/Database_Drivers/uRESTDWUniDACDriver.pas
index 48ae45e3..f73a0bd4 100644
--- a/CORE/Source/Database_Drivers/uRESTDWUniDACDriver.pas
+++ b/CORE/Source/Database_Drivers/uRESTDWUniDACDriver.pas
@@ -100,7 +100,7 @@ TRESTDWUniDACDriver = class(TRESTDWDriverBase)
FTransaction : TUniTransaction;
protected
procedure setConnection(AValue: TComponent); override;
- function getConectionType : TRESTDWDatabaseType; override;
+ function getConnectionType : TRESTDWDatabaseType; override;
Function compConnIsValid(comp : TComponent) : boolean; override;
public
constructor Create(AOwner : TComponent); override;
@@ -154,25 +154,28 @@ procedure TRESTDWUniDACStoreProc.Prepare;
{ TRESTDWUniDACDriver }
-function TRESTDWUniDACDriver.getConectionType : TRESTDWDatabaseType;
+function TRESTDWUniDACDriver.getConnectionType : TRESTDWDatabaseType;
var
prot : string;
i : integer;
begin
- Result:=inherited getConectionType;
- if not Assigned(Connection) then
- Exit;
-
- prot := LowerCase(TUniConnection(Connection).ProviderName);
-
- i := 0;
- while i < Length(rdwUniDACProtocols) do begin
- if Pos(rdwUniDACProtocols[i],prot) > 0 then begin
- Result := rdwUniDACDbType[i];
- Break;
- end;
- i := i + 1;
- end;
+ Result := Inherited getConnectionType;
+ If Not Assigned(Connection) Then
+ Exit;
+ If Result = dbtUndefined Then
+ Begin
+ prot := LowerCase(TUniConnection(Connection).ProviderName);
+ i := 0;
+ While i < Length(rdwUniDACProtocols) Do
+ Begin
+ If Pos(rdwUniDACProtocols[i],prot) > 0 Then
+ Begin
+ Result := rdwUniDACDbType[i];
+ Break;
+ End;
+ i := i + 1;
+ End;
+ End;
end;
function TRESTDWUniDACDriver.getQuery : TRESTDWDrvQuery;
diff --git a/CORE/Source/Database_Drivers/uRESTDWZeosDriver.pas b/CORE/Source/Database_Drivers/uRESTDWZeosDriver.pas
index 210de8a7..4be416b0 100644
--- a/CORE/Source/Database_Drivers/uRESTDWZeosDriver.pas
+++ b/CORE/Source/Database_Drivers/uRESTDWZeosDriver.pas
@@ -1,4 +1,4 @@
-unit uRESTDWZeosDriver;
+unit uRESTDWZeosDriver;
{$I ..\Includes\uRESTDW.inc}
@@ -37,14 +37,14 @@ interface
{$ENDIF}
{$IFDEF ZMEMTABLE_ENABLE_STREAM_EXPORT_IMPORT}
- ZMemTable,
+ ZMemTable,
{$ELSE}
- uRESTDWMemoryDataset,
+ uRESTDWMemoryDataset,
{$ENDIF}
Classes, SysUtils, DB, Variants,
ZConnection, ZDataset, ZSequence, ZDbcIntfs, ZAbstractRODataset,
ZAbstractDataset, ZStoredProcedure, ZEncoding, ZDatasetUtils,
- uRESTDWDriverBase, uRESTDWBasicTypes, uRESTDWProtoTypes, uRESTDWZeosPhysLink
+ uRESTDWDriverBase, uRESTDWBasicDbTypes, uRESTDWProtoTypes, uRESTDWZeosPhysLink
;
const
@@ -111,7 +111,7 @@ TRESTDWZeosDriver = class(TRESTDWDriverBase)
protected
procedure setConnection(AValue: TComponent); override;
- function getConectionType : TRESTDWDatabaseType; override;
+ function getConnectionType : TRESTDWDatabaseType; override;
Function compConnIsValid(comp : TComponent) : boolean; override;
Procedure zAfterPost(DataSet: TDataSet);
public
@@ -171,26 +171,29 @@ procedure TRESTDWZeosDriver.setConnection(AValue: TComponent);
inherited setConnection(AValue);
end;
-function TRESTDWZeosDriver.getConectionType: TRESTDWDatabaseType;
-var
- prot : string;
- i : integer;
-begin
- Result:=inherited getConectionType;
- if not Assigned(Connection) then
- Exit;
-
- prot := LowerCase(TZConnection(Connection).Protocol);
-
- i := 0;
- while i < Length(rdwZeosProtocols) do begin
- if Pos(rdwZeosProtocols[i],prot) > 0 then begin
- Result := rdwZeosDbType[i];
- Break;
- end;
- i := i + 1;
- end;
-end;
+Function TRESTDWZeosDriver.getConnectionType: TRESTDWDatabaseType;
+Var
+ prot : String;
+ i : integer;
+Begin
+ Result:=inherited getConnectionType;
+ If Not Assigned(Connection) Then
+ Exit;
+ If Result = dbtUndefined Then
+ Begin
+ prot := LowerCase(TZConnection(Connection).Protocol);
+ i := 0;
+ While i < Length(rdwZeosProtocols) Do
+ Begin
+ If Pos(rdwZeosProtocols[i],prot) > 0 Then
+ Begin
+ Result := rdwZeosDbType[i];
+ Break;
+ End;
+ i := i + 1;
+ End;
+ End;
+End;
function TRESTDWZeosDriver.getQuery(AUnidir: boolean): TRESTDWDrvQuery;
var
@@ -521,27 +524,20 @@ procedure TRESTDWZeosQuery.setParamValue(IParam : integer; AValue : variant);
procedure TRESTDWZeosQuery.SaveToStream(stream: TStream);
var
- qry : TZAbstractRODataset;
- {$IFDEF ZMEMTABLE_ENABLE_STREAM_EXPORT_IMPORT}
- memtable : TZMemTable;
- {$ELSE}
- memtable : TRESTDWMemtable;
- {$ENDIF}
+ qry : TZAbstractRODataset;
+ memtable : TZMemTable;
begin
qry := TZQuery(Self.Owner);
- {$IFDEF ZMEMTABLE_ENABLE_STREAM_EXPORT_IMPORT}
- memtable := TZMemTable.Create(nil);
- {$ELSE}
- memtable := TRESTDWMemtable.Create(nil);
- {$ENDIF}
+ memtable := TZMemTable.Create(nil);
try
- {$IFDEF ZMEMTABLE_ENABLE_STREAM_EXPORT_IMPORT}
- memtable.AssignDataFrom(qry);
- {$ELSE}
- memtable.Assign(qry);
- {$ENDIF}
- memtable.SaveToStream(stream);
- stream.Position := 0;
+ {$IFDEF ZMEMTABLE_ENABLE_STREAM_EXPORT_IMPORT}
+ memtable.AssignDataFrom(qry);
+ {$ELSE}
+ memtable.Assign(qry);
+ {$ENDIF}
+ //TODO SaveTostream
+// memtable.SaveToStream(stream);
+ stream.Position := 0;
finally
FreeAndNil(memtable);
end;
diff --git a/CORE/Source/Includes/uRESTDW.inc b/CORE/Source/Includes/uRESTDW.inc
index 3eba71cf..5dc1e6b7 100644
--- a/CORE/Source/Includes/uRESTDW.inc
+++ b/CORE/Source/Includes/uRESTDW.inc
@@ -39,6 +39,24 @@
{$ENDIF}
{$ENDIF}
+{$IFNDEF FPC}
+ {$if CompilerVersion < 26}
+ {$DEFINE RESTDWMEMTABLE}
+ {$ELSE}
+ {.$DEFINE RESTDWMEMTABLE}
+ {$DEFINE RESTFDMEMTABLE}
+ {.$DEFINE UNIDACMEM}
+ {.$DEFINE ZEOSMEM}
+ {$IFEND}
+ {$DEFINE USE_TAURUS_TLS}
+{$ELSE}
+ //For Lazarus
+ {$DEFINE RESTDWMEMTABLE}
+ {.$DEFINE UNIDACMEM}
+ {.$DEFINE ZEOSMEM}
+{$ENDIF}
+
+
{$IFNDEF FPC}
{$IFDEF VER370 or CompilerVersion >= 37}
{$DEFINE DELPHI13UP}
@@ -165,6 +183,7 @@
{$ENDIF ~VER330}
{$IFDEF VER320 or CompilerVersion >= 32}
+ {$DEFINE DELPHI10_3UP}
{$DEFINE DELPHI10_2UP}
{$DEFINE DELPHI10_1UP}
{$DEFINE DELPHI10_0UP}
@@ -187,6 +206,8 @@
{$ENDIF ~VER320}
{$IFDEF VER310 or CompilerVersion >= 31}
+ {$DEFINE DELPHI10_3UP}
+ {$DEFINE DELPHI10_2UP}
{$DEFINE DELPHI10_1UP}
{$DEFINE DELPHI10_0UP}
{$DEFINE DELPHIXE8UP}
@@ -208,6 +229,9 @@
{$ENDIF ~VER310}
{$IFDEF VER300 or CompilerVersion >= 30}
+ {$DEFINE DELPHI10_3UP}
+ {$DEFINE DELPHI10_2UP}
+ {$DEFINE DELPHI10_1UP}
{$DEFINE DELPHI10_0UP}
{$DEFINE DELPHIXE8UP}
{$DEFINE DELPHIXE7UP}
@@ -782,14 +806,3 @@
// Warnings
{$IFOPT X+} {$DEFINE EXTENDEDSYNTAX_ON} {$ENDIF}
-// for Delphi/BCB trial versions remove the point from the line below
-{.$UNDEF SUPPORTS_WEAKPACKAGEUNIT}
-
-(* End of Compiler settings *)
-(* REST DataWare Generic Definitions *)
-
- {$DEFINE RESTDWMEMTABLE}
-
-(* End of REST DataWare Generic Definitions *)
-
-(******************************************************************************)
diff --git a/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas b/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas
index 5bef2ff0..ce4f13b3 100644
--- a/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas
+++ b/CORE/Source/Plugins/Memdataset/uRESTDWMemoryDataset.pas
@@ -29,10 +29,11 @@
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}
{$ENDIF}
+
uses
SysUtils, Classes, DB, Variants, uRESTDWProtoTypes, uRESTDWMemDBUtils,
uRESTDWMemExprParser, {$IFNDEF FPC}uRESTDWABMemDBFilterExpr,{$ENDIF}
- uRESTDWAbout, uRESTDWConsts;
+ uRESTDWAbout, uRESTDWConsts, uRESTDWBasicDbTypes;
Const
ftBlobTypes = [ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
@@ -61,8 +62,6 @@
SIndexNotFound = 'Index ''%s'' not found';
SUniDirectional = 'Operation cannot be performed on an unidirectional dataset';
SFieldRequired = 'Field ''%s'' must have a value';
- Type
- TFieldAttrs = Array of Byte;
Type
TCompareFunc = Function(subValue,
@@ -102,147 +101,35 @@
TApplyRecordEvent = Procedure(Dataset : TDataset;
RecStatus : TRecordStatus;
FoundApply : Boolean) Of Object;
- TMemBlobData = TRESTDWBytes;
- PMemBlobData = ^TRESTDWBytes;
- TMemBlobArray = Array Of TMemBlobData;
- PMemBlobArray = ^TMemBlobArray;
- PRESTDWMTMemoryRecord = ^TRESTDWMTMemoryRecord;
- TRESTDWMTMemoryRecord = Class;
TLoadMode = (lmCopy, lmAppend);
TSaveLoadState = (slsNone, slsLoading, slsSaving);
TCompareRecords = Function(Item1, Item2 : TRESTDWMTMemoryRecord) : Integer Of Object;
TIntArray = Array Of Integer;
TRESTDWMTBookmarkData = Integer;
- TRESTDWMemTable = Class;
- {$IFNDEF FPC}
- {$IF CompilerVersion > 21}
- PRESTDWMTMemBuffer = PByte;
- TRESTDWMTBookmark = TBookmark;
- TRESTDWMTValueBuffer = TValueBuffer;
- TRESTDWMTRecordBuffer = TRecordBuffer;
- {$ELSE}
- {$IFDEF UNICODE}
- PRESTDWMTMemBuffer = PByte;
- {$ELSE}
- PRESTDWMTMemBuffer = PAnsiChar;
- {$ENDIF UNICODE}
- TRESTDWMTBookmark = Pointer;
- TRESTDWMTValueBuffer = Pointer;
- TRESTDWMTRecordBuffer = Pointer;
- {$IFEND}
- {$ELSE}
- TValueBuffer = Array of Byte;
- PRESTDWMTMemBuffer = PByte;
- TRESTDWMTBookmark = Pointer;
- TRESTDWMTValueBuffer = Pointer;
- TRESTDWMTRecordBuffer = TRecordBuffer;
- {$ENDIF}
- PBlobBuffer = ^TBlobBuffer;
- TBlobBuffer = Packed Record
- FieldNo,
- OrgBufID : Integer;
- Buffer : Pointer;
- Size : Int64;
- end;
- PRESTDWBlobField = ^TRESTDWBlobField;
- TRESTDWBlobField = Packed Record
- ConnBlobBuffer : Array[0..11] Of Byte; // DB specific data is stored here
- BlobBuffer : PBlobBuffer;
- End;
- PRESTDWRecLinkItem = ^TRESTDWRecLinkItem;
- TRESTDWRecLinkItem = Packed Record
- Prior : PRESTDWRecLinkItem;
- Next : PRESTDWRecLinkItem;
- End;
- PRESTDWBookmark = ^TRESTDWBookmark;
- TRESTDWBookmark = Packed Record
- BookmarkData : PRESTDWRecLinkItem;
- BookmarkInt : Integer; // Was used by TArrayBufIndex
- BookmarkFlag : TBookmarkFlag;
- End;
-
- {
- TdwcolorOptions = Set Of (dwcoAllowedSharp, dwcoShowWebSharp, dwcoSysColors);
- TColorField = class(TIntegerField)
- Private
- FOptions : TdwcolorOptions;
- Protected
- Function GetIdentText (AValue : Integer;
- Var Text : String) : Boolean; Virtual;Overload;
- Procedure GetText (Var Text : String;
- DisplayText : Boolean); Override;
- Function SetAsIdentString(Const AValue : String) : Boolean; Virtual;
- Procedure SetAsString (Const AValue : String); Override;
- Public
- Constructor Create (AOwner : TComponent); Override;
- Published
- Property MaxValue Stored False;
- Property MinValue Stored False;
- Property Options : TdwcolorOptions Read FOptions Write FOptions Default [dwcoAllowedSharp];
- End;
-}
- IRESTDWMemTable = Interface
- Function GetRecordCount : Integer;
- Function GetMemoryRecord (Index : Integer) : TRESTDWMTMemoryRecord;
- Function GetOffSets (aField : TField) : Word;Overload;
- Function GetOffSets (Index : Integer) : Word;Overload;
- Function GetOffSetsBlobs : Word;
- Function DataTypeSuported(datatype : TFieldType) : Boolean; // new
- Function DataTypeIsBlobTypes(datatype : TFieldType) : Boolean; // new
- Function GetBlobRec (Field : TField;
- Rec : TRESTDWMTMemoryRecord) : TMemBlobData;
- Function CreateBlobStream (Field : TField;
- Mode : TBlobStreamMode) : TStream;
- Function GetCalcFieldLen (FieldType: TFieldType;
- Size : Word) : Word;
- Procedure InternalAddRecord (Buffer : {$IFDEF FPC}Pointer{$ELSE}
- {$IFDEF RESTDWANDROID}TRecBuf{$ELSE}
- {$IF CompilerVersion >22}Pointer{$ELSE}TRecordBuffer{$IFEND}{$ENDIF}{$ENDIF};
- aAppend : Boolean);
- Procedure InitRecord (Buffer : {$IFDEF NEXTGEN}TRecBuf{$ELSE}TRecordBuffer{$ENDIF});
- Function AllocRecordBuffer : TRecordBuffer;
- Procedure SetMemoryRecordData(Buffer : PRESTDWMTMemBuffer;
- Pos : Integer);
- Procedure AfterLoad;
- Function GetDataset : TDataset;
- Function GetBlob (RecNo, Index : Integer) : PMemBlobData;
- Procedure Loaded;
- {$IFDEF FPC}
- Function GetDatabaseCharSet : TDatabaseCharSet;
- {$ENDIF}
- End;
- TRESTDWStorageBase = class(TRESTDWComponent)
- Private
- {$IFDEF FPC}
- FDatabaseCharSet: TDatabaseCharSet;
- {$ENDIF}
- FEncodeStrs: Boolean;
- Protected
- Procedure SaveDatasetToStream (Dataset : TDataset;
- Var stream : TStream); Virtual;
- Procedure LoadDatasetFromStream(Dataset : TDataset;
- stream : TStream); Virtual;
- Procedure SaveDWMemToStream (Dataset : IRESTDWMemTable;
- Var stream : TStream); Virtual;
- Procedure LoadDWMemFromStream (Dataset : IRESTDWMemTable;
- stream : TStream); Virtual;
- Public
- Constructor Create (AOwner : TComponent); Override;
- Procedure SaveToStream (Dataset : TDataset;
- Var Stream : TStream);
- Procedure LoadFromStream(Dataset : TDataset;
- Stream : TStream);
- Procedure SaveToFile (Dataset : TDataset;
- FileName : String);
- Procedure LoadFromFile (Dataset : TDataset;
- FileName : String);
- Public
- Property EncodeStrs : Boolean Read FEncodeStrs Write FEncodeStrs;
- Published
- {$IFDEF FPC}
- Property DatabaseCharSet : TDatabaseCharSet Read FDatabaseCharSet Write FDatabaseCharSet;
- {$ENDIF}
- End;
+ PBlobBuffer = ^TBlobBuffer;
+ TBlobBuffer = Packed Record
+ FieldNo,
+ OrgBufID : Integer;
+ Buffer : Pointer;
+ Size : Int64;
+ End;
+ PRESTDWBlobField = ^TRESTDWBlobField;
+ TRESTDWBlobField = Packed Record
+ ConnBlobBuffer : Array[0..11] Of Byte; // DB specific data is stored here
+ BlobBuffer : PBlobBuffer;
+ End;
+ PRESTDWRecLinkItem = ^TRESTDWRecLinkItem;
+ TRESTDWRecLinkItem = Packed Record
+ Prior : PRESTDWRecLinkItem;
+ Next : PRESTDWRecLinkItem;
+ End;
+ PRESTDWBookmark = ^TRESTDWBookmark;
+ TRESTDWBookmark = Packed Record
+ BookmarkData : PRESTDWRecLinkItem;
+ BookmarkInt : Integer; // Was used by TArrayBufIndex
+ BookmarkFlag : TBookmarkFlag;
+ End;
+ TRESTDWMemTable = Class;
PRecordList = ^TRecordList;
TRecordList = Class(TList)
Private
@@ -462,7 +349,6 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex)
FBookmarkOfs,
FBlobOfs,
FRecBufSize,
- FLastID,
FRowsOriginal,
FRowsChanged,
FRowsAffected : Integer;
@@ -471,7 +357,6 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex)
FDeletedValues,
FIndexList : TList;
FSrcAutoIncField : TField;
- FRecords : TRecordList;
FDataSet : TDataset;
FFieldAttrs : TFieldAttrs;
FFetch,
@@ -502,7 +387,6 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex)
FNullmaskSize : Byte;
FFilterParser : TExprParser;
FStorageDataType : TRESTDWStorageBase;
- FBlobs : TMemBlobArray;
FIndexes : TRESTDWDataSetIndexDefs;
FDefaultIndex,
FCurrentIndexDef : TRESTDWDatasetIndex;
@@ -556,7 +440,9 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex)
Procedure InternalSetFieldData (Field : TField;
Buffer : Pointer;
Const ValidateBuffer : TRESTDWMTValueBuffer);
+ {$IFDEF FPC}
Procedure SetProviderFlags;
+ {$ENDIF}
Protected
Function IsLookup (Index : Integer) : Boolean;
Function GetFieldDef (Index : Integer) : Integer;
@@ -675,8 +561,11 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex)
procedure ClearIndexes;
Function GetDataset : TDataset;
Procedure SetIndexName(AValue : String);
- Property Records [Index : Integer] : TRESTDWMTMemoryRecord Read GetMemoryRecord;
Public
+ FLastID : Integer;
+ FBlobs : TMemBlobArray;
+ FRecords : TRecordList;
+ Property Records [Index : Integer] : TRESTDWMTMemoryRecord Read GetMemoryRecord;
Constructor Create(AOwner : TComponent);Override;
Destructor Destroy;Override;
Function InternalGetFieldData(Field : TField;
@@ -792,6 +681,7 @@ TDoubleLinkedBufIndex = class(TRESTDWIndex)
Property RESTDWIndexes [Aindex : Integer] : TRESTDWIndex Read GetBufIndex;
Property RESTDWIndexDefs[Aindex : Integer] : TRESTDWDatasetIndex Read GetBufIndexDef;
Property FieldAttrs : TFieldAttrs Read FFieldAttrs Write FFieldAttrs;
+ Property BlobFieldCount;
published
Property Capacity : Integer Read GetCapacity Write SetCapacity Default 0;
Property Active;
@@ -877,8 +767,10 @@ TBlobStream = class(TMemoryStream)
FPosition : Longint;
Function GetBlobSize : Longint;
Function GetBlobFromRecord(Field : TField) : TMemBlobData;
+ {$IFDEF FPC}
Procedure SetBlobFromRecord(Field : TField;
Value : TMemBlobData);
+ {$ENDIF}
Public
Constructor Create(Field : TBlobField;
Mode : TBlobStreamMode);
@@ -891,31 +783,6 @@ TBlobStream = class(TMemoryStream)
Origin: Word) : Longint;Override;
Procedure Truncate;
End;
- TRESTDWMTMemoryRecord = Class(TPersistent)
- Private
- FMemoryData : TRESTDWMemTable;
- FIndex,
- FID : Integer;
- FData : Pointer;
- FBlobs : TMemBlobArray;
- FIsNull : Boolean;
- Function GetIndex : Integer;
- Procedure SetMemoryData(Value : TRESTDWMemTable;
- UpdateParent : Boolean);
- Protected
- Procedure SetIndex (Value : Integer); Virtual;
- Public
- Constructor Create (MemoryData : TRESTDWMemTable); Virtual;
- Constructor CreateEx (MemoryData : TRESTDWMemTable;
- UpdateParent : Boolean); Virtual;
- Destructor Destroy;Override;
- Property MemoryData : TRESTDWMemTable Read FMemoryData;
- Property ID : Integer Read FID Write FID;
- Property Index : Integer Read GetIndex Write SetIndex;
- Property Data : Pointer Read FData Write FData;
- Property Blobs : TMemBlobArray Read FBlobs Write FBlobs;
- Property IsNull : Boolean Read FIsNull Write FIsNull;
- End;
TSortOrder = (soAsc, soDesc);
//Possible sorting case sensitivity values
// sensitive sorting - insensitive sorting
@@ -1145,6 +1012,10 @@ TBlobStream = class(TMemoryStream)
{$ENDIF});
+
+ Procedure CalcDataSize(FieldDef : TFieldDef; Var DataSize: Integer);Overload;
+ Procedure CalcDataSize(Field : TField; Var DataSize: Integer);Overload;
+
Implementation
Uses
@@ -1155,8 +1026,9 @@ TBlobStream = class(TMemoryStream)
FMTBcd,
{$IFDEF RESTDWVCL}uRESTDWMemVCLUtils,{$ENDIF}
uRESTDWMemResources,
- uRESTDWTools, uRESTDWBasicTypes, uRESTDWStorageBin
- {$IFNDEF FPC}, SqlTimSt{$ENDIF};
+ uRESTDWTools, uRESTDWStorageBin
+ {$IFNDEF FPC}, SqlTimSt{$ENDIF},
+ uRESTDWBasicTypes;
Const
GuidSize = 38;
@@ -1392,28 +1264,6 @@ TMemBookmarkInfo = record
DatabaseErrorFmt(Msg, Args);
End;
-// === { TRESTDWMTMemoryRecord } ====================================================
-Constructor TRESTDWMTMemoryRecord.Create(MemoryData: TRESTDWMemTable);
-Begin
- FIsNull := True;
- FIndex := -1;
- CreateEx(MemoryData, True);
-End;
-
-Constructor TRESTDWMTMemoryRecord.CreateEx(MemoryData: TRESTDWMemTable; UpdateParent: Boolean);
-Begin
- Inherited Create;
- SetMemoryData(MemoryData, UpdateParent);
-End;
-
-Destructor TRESTDWMTMemoryRecord.Destroy;
-Begin
- SetMemoryData(Nil, False);
-// Finalize(FBlobs);
-// SetLength(FBlobs, 0);
- Inherited Destroy;
-End;
-
{$IFNDEF FPC}
{$IF CompilerVersion > 24}
Function TRESTDWNumericField.GetAsExtended: Extended;
@@ -1849,70 +1699,6 @@ TMemBookmarkInfo = record
{$ENDIF}
-Function TRESTDWMTMemoryRecord.GetIndex: Integer;
-Begin
-// If FMemoryData <> Nil then
-// Result := FMemoryData.FRecords.IndexOf(Self)
-// Else
- Result := FIndex;
-End;
-
-Procedure TRESTDWMTMemoryRecord.SetMemoryData(Value: TRESTDWMemTable; UpdateParent: Boolean);
-var
- I, DataSize: Integer;
-Begin
- If FMemoryData <> Value then
- Begin
- If FMemoryData <> nil then
- Begin
- If FMemoryData.BlobFieldCount > 0 Then
- Begin
-// {$IFDEF FPC}
- SetLength(FBlobs, 0); //Finalize(FBlobs, FMemoryData.BlobFieldCount);
-// {$ELSE}
-// Finalize(FBlobs);
-// {$ENDIF}
- End;
- FMemoryData.FRecords.Remove(Self);
- {$IFDEF FPC}
- ReallocMem(FData, 0);
- {$ELSE}
- FreeMem(FData, SizeOf(FData));
-// ReallocMem(FData, 0);
- {$ENDIF}
- FMemoryData := Nil;
- End;
- If Value <> Nil then
- Begin
- If UpdateParent then
- Begin
- Value.FRecords.Add(Self);
- Inc(Value.FLastID);
- FID := Value.FLastID;
- End;
- FMemoryData := Value;
- If Value.BlobFieldCount > 0 then
- Begin
- SetLength(FBlobs, 0);
- SetLength(FBlobs, Value.BlobFieldCount);
- End;
- DataSize := 0;
- For I := 0 to Value.Fields.Count - 1 do
- CalcDataSize(Value.Fields[I], DataSize);
- ReallocMem(FData, DataSize);
- End;
- End;
-End;
-
-Procedure TRESTDWMTMemoryRecord.SetIndex(Value: Integer);
-var
- CurIndex: Integer;
-Begin
- CurIndex := GetIndex;
- If (CurIndex >= 0) and (CurIndex <> Value) then
- FMemoryData.FRecords.Move(CurIndex, Value);
- FIndex := Value;
-End;
// === { TRESTDWMemTable } ======================================================
// Function TRESTDWMemTable.FieldByName(const FieldName: string): TField;
// Begin
@@ -2109,7 +1895,7 @@ procedure TRESTDWMemTable.SetCapacity(Value: Integer);
function TRESTDWMemTable.AddRecord: TRESTDWMTMemoryRecord;
Begin
- Result := TRESTDWMTMemoryRecord.Create(Self);
+ Result := TRESTDWMTMemoryRecord.Create(Nil);
End;
function TRESTDWMemTable.FindRecordID(ID: Integer): TRESTDWMTMemoryRecord;
@@ -2134,8 +1920,7 @@ function TRESTDWMemTable.InsertRecord(Index: Integer): TRESTDWMTMemoryRecord;
function TRESTDWMemTable.GetMemoryRecord(Index: Integer): TRESTDWMTMemoryRecord;
Begin
- Result := TRESTDWMTMemoryRecord(FRecords[Index]);
-// Result := TRESTDWMTMemoryRecord(TRecordList(Pointer(@FRecords)^)[Index]);
+ Result := TRESTDWMTMemoryRecord(FRecords[Index]);
End;
Procedure TRESTDWMemTable.CalcOffSets;
@@ -3081,7 +2866,7 @@ function TRESTDWMemTable.GetRecordSize: Word;
End;
Else
Begin
- vTimeStamp := DateTimeToSQLTimeStamp(vDouble);
+ vTimeStamp := TSQLTimeStamp(DateTimeToSQLTimeStamp(vDouble));
cLen := SizeOf(vTimeStamp);
Move(Pointer(@vTimeStamp)^, Pointer(Buffer)^, cLen);
End;
@@ -4843,7 +4628,7 @@ procedure TRESTDWMemTable.FetchAll;
Begin
// Release unneeded blob buffers, in order to save memory
// TDataSet has own buffer of records, so do not release blobs until they can be referenced
- With FDataSet Do
+ With TRESTDWMemtable(FDataSet) Do
Begin
h := Length(FBlobs);
If h > 0 Then //Free in batches, starting with oldest (at beginning)
@@ -4883,7 +4668,7 @@ procedure TRESTDWMemTable.FetchAll;
Function TDoubleLinkedBufIndex.GetCurrentBuffer: Pointer;
Begin
// pointer(FLastRecBuf) + FDataset.BufferOffset;
- Result := Pointer(FDataset.ActiveBuffer); //Todo XyberX
+ Result := Pointer(TRESTDWMemtable(FDataSet).ActiveBuffer); //Todo XyberX
End;
Function TDoubleLinkedBufIndex.GetCurrentRecord : TRecordBuffer;
@@ -4899,7 +4684,7 @@ procedure TRESTDWMemTable.FetchAll;
Function TDoubleLinkedBufIndex.GetSpareBuffer : TRecordBuffer;
Begin
// Pointer(FLastRecBuf) + FDataset.BufferOffset;
- Result := Pointer(FDataset.ActiveBuffer); //Todo XyberX
+ Result := Pointer(TRESTDWMemtable(FDataSet).ActiveBuffer); //Todo XyberX
End;
Function TDoubleLinkedBufIndex.GetSpareRecord : TRecordBuffer;
@@ -5272,7 +5057,7 @@ procedure TRESTDWMemTable.FetchAll;
Var
ARecord : TRecordBuffer;
Begin
- ARecord := FDataset.IntAllocRecordBuffer;
+ ARecord := TRESTDWMemtable(FDataSet).IntAllocRecordBuffer;
{$IFNDEF FPC}
{$IF CompilerVersion >= 20}
FLastRecBuf[IndNr].next := Pointer(ARecord);
@@ -5547,9 +5332,9 @@ procedure TRESTDWMemTable.InternalCreateIndex(F : TRESTDWDataSetIndex);
If Active and Not Refreshing then
FetchAll;
if IsUniDirectional then
- B:=TUniDirectionalBufIndex.Create(self)
+ B := TUniDirectionalBufIndex.Create(Nil)
else
- B:=TDoubleLinkedBufIndex.Create(self);
+ B := TDoubleLinkedBufIndex.Create(Nil);
F.FBufferIndex:=B;
with B do
begin
@@ -6010,6 +5795,7 @@ procedure TRESTDWMemTable.InternalPost;
{$ENDIF}
End;
+{$IFDEF FPC}
Procedure TRESTDWMemTable.SetProviderFlags;
Var
I : Integer;
@@ -6039,6 +5825,7 @@ procedure TRESTDWMemTable.InternalPost;
End;
End;
End;
+{$ENDIF}
procedure TRESTDWMemTable.InternalOpen;
Begin
@@ -7229,7 +7016,7 @@ function TRESTDWMemTable.CopyFromDataSet: Integer;
constructor TRESTDWIndex.Create(const ADataset: TRESTDWMemtable);
Begin
Inherited Create;
- FDataset := ADataset;
+ FDataset := TRESTDWMemtable(ADataset);
End;
{$IFDEF FPC}
@@ -7721,6 +7508,7 @@ destructor TRESTDWMTMemBlobStream.Destroy;
End;
End;
+{$IFDEF FPC}
Procedure TRESTDWMTMemBlobStream.SetBlobFromRecord(Field: TField; Value: TMemBlobData);
Var
Rec: TRESTDWMTMemoryRecord;
@@ -7743,6 +7531,7 @@ destructor TRESTDWMTMemBlobStream.Destroy;
End;
End;
+{$ENDIF}
Function TRESTDWMTMemBlobStream.Read(Var Buffer; Count: Longint): Longint;
Var
@@ -7922,25 +7711,6 @@ destructor TRESTDWMTMemBlobStream.Destroy;
Result := nil;
end;
-{ TRESTDWStorageBase }
-
-constructor TRESTDWStorageBase.Create(AOwner: TComponent);
-Begin
- inherited Create(AOwner);
- FEncodeStrs := True;
-End;
-
-Procedure TRESTDWStorageBase.LoadDatasetFromStream(Dataset: TDataset; stream: TStream);
-Begin
-
-End;
-
-Procedure TRESTDWStorageBase.LoadDWMemFromStream(Dataset: IRESTDWMemTable;
- stream: TStream);
-Begin
-
-End;
-
Destructor TRecordList.Destroy;
Begin
ClearAll;
@@ -8006,66 +7776,6 @@ constructor TRESTDWStorageBase.Create(AOwner: TComponent);
Inherited Clear;
End;
-Procedure TRESTDWStorageBase.LoadFromFile(Dataset: TDataset; FileName: String);
-Var
- vFileStream : TFileStream;
-Begin
- If not FileExists(FileName) then
- Exit;
- vFileStream := TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
- Try
- LoadFromStream(Dataset,TStream(vFileStream));
- Finally
- vFileStream := Nil;
- vFileStream.Free;
- End;
-End;
-
-Procedure TRESTDWStorageBase.LoadFromStream(Dataset: TDataset; stream: TStream);
-Begin
- If Dataset.InheritsFrom(TRESTDWMemTable) then
- LoadDWMemFromStream(TRESTDWMemTable(Dataset), stream)
- Else
- LoadDatasetFromStream(Dataset, stream);
- If Dataset.Active then
- TRESTDWMemTable(Dataset).SortOnFields;
-End;
-
-Procedure TRESTDWStorageBase.SaveDatasetToStream(Dataset: TDataset; Var stream: TStream);
-Begin
-
-End;
-
-Procedure TRESTDWStorageBase.SaveDWMemToStream(Dataset: IRESTDWMemTable;
- Var stream: TStream);
-Begin
-
-End;
-
-Procedure TRESTDWStorageBase.SaveToFile(Dataset: TDataset; FileName: String);
-Var
- vFileStream : TFileStream;
-Begin
- Try
- vFileStream := TFileStream.Create(FileName,fmCreate);
- Try
- SaveToStream(Dataset,TStream(vFileStream));
- Except
- End;
- Finally
- vFileStream.Free;
- End;
-End;
-
-Procedure TRESTDWStorageBase.SaveToStream(Dataset: TDataset; Var stream: TStream);
-Begin
- If Dataset.InheritsFrom(TRESTDWMemTable) then
- SaveDWMemToStream(TRESTDWMemTable(Dataset), stream)
- Else
- SaveDatasetToStream(Dataset, stream);
-End;
-
-
{ TRESTDWMemTableEx }
Procedure TRESTDWMemTableEx.CopyStructure(Source: TDataSet);
diff --git a/CORE/Source/Sockets/Ics/uRESTDWIcsBase.pas b/CORE/Source/Sockets/Ics/uRESTDWIcsBase.pas
index a694f9a8..7ceac58d 100644
--- a/CORE/Source/Sockets/Ics/uRESTDWIcsBase.pas
+++ b/CORE/Source/Sockets/Ics/uRESTDWIcsBase.pas
@@ -40,7 +40,7 @@ interface
OverbyteIcsWinSock, OverbyteIcsWSocket, OverbyteIcsWndControl,
OverbyteIcsHttpAppServer, OverbyteIcsUtils, OverbyteIcsFormDataDecoder,
OverbyteIcsMimeUtils, OverbyteIcsSSLEAY, OverbyteIcsHttpSrv,
- OverbyteIcsWSocketS, OverbyteIcsSslX509Utils, OverbyteIcsSslBase;
+ OverbyteIcsWSocketS, OverbyteIcsSslX509Utils, OverbyteIcsSslBase, OverbyteIcsTypes;
type
TPoolerHttpConnection = class(THttpAppSrvConnection)
diff --git a/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas b/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas
index 69c9baac..2d9e1e7d 100644
--- a/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas
+++ b/CORE/Source/Sockets/Indy/uRESTDWIdBase.pas
@@ -33,33 +33,45 @@ interface
{$IFDEF RESTDWWINDOWS}Windows,{$ENDIF}
{$IFNDEF RESTDWLAZARUS}SyncObjs,{$ENDIF}
{$IF not Defined(RESTDWLAZARUS) AND not Defined(RESTDWLAMW) AND not Defined(DELPHIXEUP)}uRESTDWMassiveBuffer,{$IFEND}
+ {$IFDEF USE_TAURUS_TLS}
+ TaurusTLS, TaurusTLSHeaders_types, TaurusTLSHeaders_evp, TaurusTLSHeaders_bio, TaurusTLSHeaders_rand,
+ TaurusTLSHeaders_bn, TaurusTLSHeaders_x509, TaurusTLSHeaders_err, TaurusTLSLoader,
+ {$ENDIF}
SysUtils, Classes, Db, Variants,
uRESTDWBasic, uRESTDWBasicDB, uRESTDWComponentEvents, uRESTDWBasicTypes,
uRESTDWJSONObject, uRESTDWParams, uRESTDWBasicClass, uRESTDWAbout,
- uRESTDWConsts, uRESTDWProtoTypes, uRESTDWDataUtils, uRESTDWTools, uRESTDWZlib,
+ uRESTDWProtoTypes, uRESTDWDataUtils, uRESTDWTools, uRESTDWZlib,
uRESTDWAuthenticators,
IdContext, IdHeaderList, IdTCPConnection, IdHTTPServer, IdCustomHTTPServer,
IdSSLOpenSSL, IdSSL, IdAuthentication, IdTCPClient, IdHTTPHeaderInfo,
IdComponent, IdBaseComponent, IdHTTP, IdMultipartFormData, IdMessageCoder,
- IdMessage, IdGlobalProtocols, IdGlobal, IdStack;
+ IdMessage, IdGlobalProtocols, IdGlobal, IdStack, uRESTDWConsts;
Type
- PIdSSLVersions = ^TIdSSLVersions;
+ TRESTDWVersionsBase = Array of Integer;
+ PRESTDWSSLVersions = ^TRESTDWSSLVersion;
+Type
TRESTDWIdProxyRequest = Class(TRESTDWProxyBase)
Private
+ {$IFDEF USE_TAURUS_TLS}
+ vUseTaurus : Boolean;
+ {$ENDIF}
vCipherList,
vaSSLRootCertFile,
ASSLPrivateKeyFile,
ASSLPrivateKeyPassword,
ASSLCertFile : String;
- aSSLMethod : TIdSSLVersion;
+ aSSLMethod : TRESTDWSSLVersion;
HTTPServer : TIdHTTPServer;
- lHandler : TIdServerIOHandlerSSLOpenSSL;
+ lHandler : TComponent;//TIdServerIOHandlerSSLOpenSSL;
vSSLVerifyMode : TIdSSLVerifyModeSet;
vSSLVerifyDepth : Integer;
- vSSLMode : TIdSSLMode;
- aSSLVersions : TIdSSLVersions;
+ vSSLMode : TRESTDWSSLMode;
+ aSSLVersions : TRESTDWSSLVersions;
+ Function GetSSlVersion : Integer;
+ Function GetSSlVersions : TRESTDWVersionsBase;
+ Function GetSSlMode : Integer;
Procedure aCommandGet (AContext : TIdContext;
ARequestInfo : TIdHTTPRequestInfo;
AResponseInfo : TIdHTTPResponseInfo);
@@ -87,32 +99,41 @@ interface
Constructor Create (AOwner : TComponent);Override;
Destructor Destroy; override;
Published
+ {$IFDEF USE_TAURUS_TLS}
+ Property UseTaurus : Boolean Read vUseTaurus Write vUseTaurus;
+ {$ENDIF}
Property SSLPrivateKeyFile : String Read aSSLPrivateKeyFile Write aSSLPrivateKeyFile;
Property SSLPrivateKeyPassword : String Read aSSLPrivateKeyPassword Write aSSLPrivateKeyPassword;
Property SSLCertFile : String Read aSSLCertFile Write aSSLCertFile;
Property SSLRootCertFile : String Read vaSSLRootCertFile Write vaSSLRootCertFile;
Property SSLVerifyMode : TIdSSLVerifyModeSet Read vSSLVerifyMode Write vSSLVerifyMode;
Property SSLVerifyDepth : Integer Read vSSLVerifyDepth Write vSSLVerifyDepth;
- Property SSLMode : TIdSSLMode Read vSSLMode Write vSSLMode;
- Property SSLMethod : TIdSSLVersion Read aSSLMethod Write aSSLMethod;
- Property SSLVersions : TIdSSLVersions Read aSSLVersions Write aSSLVersions;
+ Property SSLMode : TRESTDWSSLMode Read vSSLMode Write vSSLMode;
+ Property SSLMethod : TRESTDWSSLVersion Read aSSLMethod Write aSSLMethod;
+ Property SSLVersions : TRESTDWSSLVersions Read aSSLVersions Write aSSLVersions;
Property CipherList : String Read vCipherList Write vCipherList;
End;
TRESTDWIdServicePooler = Class(TRESTServicePoolerBase)
Private
+ {$IFDEF USE_TAURUS_TLS}
+ vUseTaurus : Boolean;
+ {$ENDIF}
vCipherList,
vaSSLRootCertFile,
ASSLPrivateKeyFile,
ASSLPrivateKeyPassword,
ASSLCertFile : String;
- aSSLMethod : TIdSSLVersion;
+ aSSLMethod : TRESTDWSSLVersion;
HTTPServer : TIdHTTPServer;
- lHandler : TIdServerIOHandlerSSLOpenSSL;
+ lHandler : TComponent;//TIdServerIOHandlerSSLOpenSSL;
vSSLVerifyMode : TIdSSLVerifyModeSet;
vSSLVerifyDepth : Integer;
- vSSLMode : TIdSSLMode;
- aSSLVersions : TIdSSLVersions;
+ vSSLMode : TRESTDWSSLMode;
+ aSSLVersions : TRESTDWSSLVersions;
+ Function GetSSlVersion : Pointer;
+ Function GetSSlMode : Pointer;
+ Function GetSSlVersions : Pointer;
Procedure aCommandGet (AContext : TIdContext;
ARequestInfo : TIdHTTPRequestInfo;
AResponseInfo : TIdHTTPResponseInfo);
@@ -145,15 +166,18 @@ interface
Constructor Create (AOwner : TComponent);Override;
Destructor Destroy; override;
Published
+ {$IFDEF USE_TAURUS_TLS}
+ Property UseTaurus : Boolean Read vUseTaurus Write vUseTaurus;
+ {$ENDIF}
Property SSLPrivateKeyFile : String Read aSSLPrivateKeyFile Write aSSLPrivateKeyFile;
Property SSLPrivateKeyPassword : String Read aSSLPrivateKeyPassword Write aSSLPrivateKeyPassword;
Property SSLCertFile : String Read aSSLCertFile Write aSSLCertFile;
Property SSLRootCertFile : String Read vaSSLRootCertFile Write vaSSLRootCertFile;
Property SSLVerifyMode : TIdSSLVerifyModeSet Read vSSLVerifyMode Write vSSLVerifyMode;
Property SSLVerifyDepth : Integer Read vSSLVerifyDepth Write vSSLVerifyDepth;
- Property SSLMode : TIdSSLMode Read vSSLMode Write vSSLMode;
- Property SSLMethod : TIdSSLVersion Read aSSLMethod Write aSSLMethod;
- Property SSLVersions : TIdSSLVersions Read aSSLVersions Write aSSLVersions;
+ Property SSLMode : TRESTDWSSLMode Read vSSLMode Write vSSLMode;
+ Property SSLMethod : TRESTDWSSLVersion Read aSSLMethod Write aSSLMethod;
+ Property SSLVersions : TRESTDWSSLVersions Read aSSLVersions Write aSSLVersions;
Property CipherList : String Read vCipherList Write vCipherList;
End;
@@ -267,9 +291,13 @@ interface
vHostCert : String;
vPortCert : Integer;
vOnGetpassword : TOnGetpassword;
- vSSLVersions : TIdSSLVersions;
- ssl : TIdSSLIOHandlerSocketOpenSSL;
- vCertMode : TIdSSLMode;
+ vUseTaurus : Boolean;
+ ssl : TComponent;//TIdSSLIOHandlerSocketOpenSSL;
+ vSSLVersions : TRESTDWSSLVersions;
+ vCertMode : TRESTDWSSLMode;
+ Function GetSSlVersion : Integer;
+ Function GetSSlMode : Integer;
+ Function GetSSlVersions : TRESTDWVersionsBase;
Procedure SetParams;
Procedure SetUseSSL (Value : Boolean);Override;
Procedure SetHeaders (AHeaders : TStringList);Overload;Override;
@@ -430,8 +458,8 @@ interface
IgnoreEvents : Boolean = False):Integer;Overload;Override;
Published
Property VerifyCert : Boolean Read GetVerifyCert Write SetVerifyCert;
- Property SSLVersions : TIdSSLVersions Read vSSLVersions Write vSSLVersions;
- Property CertMode : TIdSSLMode Read vCertMode Write vCertMode;
+ Property SSLVersions : TRESTDWSSLVersions Read vSSLVersions Write vSSLVersions;
+ Property CertMode : TRESTDWSSLMode Read vCertMode Write vCertMode;
Property CertFile : String Read vCertFile Write vCertFile;
Property KeyFile : String Read vKeyFile Write vKeyFile;
Property RootCertFile : String Read vRootCertFile Write vRootCertFile;
@@ -458,10 +486,20 @@ interface
TRESTDWIdClientPooler = Class(TRESTClientPoolerBase)
Private
- vCipherList : String;
- aSSLMethod : TIdSSLVersion;
+ {$IFDEF USE_TAURUS_TLS}
+ vUseTaurus : Boolean;
+ {$ENDIF}
+ vCipherList,
+ vaSSLRootCertFile,
+ ASSLPrivateKeyFile,
+ ASSLPrivateKeyPassword,
+ ASSLCertFile : String;
+ aSSLMethod : TRESTDWSSLVersion;
HttpRequest : TRESTDWIdClientREST;
- vSSLMode : TIdSSLMode;
+ vSSLMode : TRESTDWSSLMode;
+ Function GetSSlVersion : Integer;
+ Function GetSSlMode : Integer;
+ Function GetSSlVersions : TRESTDWVersionsBase;
Function SendEvent (EventData : String;
Var Params : TRESTDWParams;
EventType : TSendEvent = sePOST;
@@ -489,8 +527,12 @@ interface
AMessageErro : String): Boolean;
Procedure Abort;Override;
Published
- Property SSLMode : TIdSSLMode Read vSSLMode Write vSSLMode;
- Property CipherList : String Read vCipherList Write vCipherList;
+ Property SSLPrivateKeyFile : String Read aSSLPrivateKeyFile Write aSSLPrivateKeyFile;
+ Property SSLPrivateKeyPassword : String Read aSSLPrivateKeyPassword Write aSSLPrivateKeyPassword;
+ Property SSLCertFile : String Read aSSLCertFile Write aSSLCertFile;
+ Property SSLRootCertFile : String Read vaSSLRootCertFile Write vaSSLRootCertFile;
+ Property SSLMode : TRESTDWSSLMode Read vSSLMode Write vSSLMode;
+ Property SSLMethod : TRESTDWSSLVersion Read aSSLMethod Write aSSLMethod;
End;
TRESTDWIdPoolerList = Class(TRESTDWPoolerListBase)
@@ -2914,6 +2956,21 @@ TIdHTTPAccess = class(TIdHTTP)
vOnGetpassword(Password);
End;
+Function TRESTDWIdClientREST.GetSSlMode : Integer;
+Begin
+ Result := 0;
+End;
+
+Function TRESTDWIdClientREST.GetSSlVersion : Integer;
+Begin
+ Result := 0;
+End;
+
+Function TRESTDWIdClientREST.GetSSlVersions : TRESTDWVersionsBase;
+Begin
+ Result := Nil;
+End;
+
Function TRESTDWIdClientREST.GetVerifyCert : boolean;
Begin
Result := vVerifyCert;
@@ -2925,20 +2982,41 @@ TIdHTTPAccess = class(TIdHTTP)
End;
Procedure TRESTDWIdClientREST.SetCertOptions;
+{$IFDEF USE_TAURUS_TLS}
+Var
+ vRESTDWVersionsBase : TRESTDWVersionsBase;
+{$ENDIF}
Begin
If Assigned(ssl) Then
Begin
{$IFDEF FPC}
- ssl.OnGetPassword := @Getpassword;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).OnGetPassword := @Getpassword;
{$ELSE}
- ssl.OnGetPassword := Getpassword;
+ vRESTDWVersionsBase := GetSSlVersions;
+ {$IFDEF USE_TAURUS_TLS}
+ If vUseTaurus Then
+ Begin
+ End
+ Else
+ Begin
+ TIdSSLIOHandlerSocketOpenSSL(ssl).OnGetPassword := Getpassword;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.CertFile := vCertFile;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.KeyFile := vKeyFile;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.RootCertFile := vRootCertFile;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).Host := vHostCert;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).Port := vPortCert;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.Mode := TIdSSLMode(GetSSlMode);;
+ End;
+ {$ELSE}
+ TIdSSLIOHandlerSocketOpenSSL(ssl).OnGetPassword := Getpassword;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.CertFile := vCertFile;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.KeyFile := vKeyFile;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.RootCertFile := vRootCertFile;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).Host := vHostCert;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).Port := vPortCert;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.Mode := TIdSSLMode(GetSSlMode);;
+ {$ENDIF}
{$ENDIF}
- ssl.SSLOptions.CertFile := vCertFile;
- ssl.SSLOptions.KeyFile := vKeyFile;
- ssl.SSLOptions.RootCertFile := vRootCertFile;
- ssl.Host := vHostCert;
- ssl.Port := vPortCert;
- ssl.SSLOptions.Mode := vCertMode;
End;
End;
@@ -3041,6 +3119,10 @@ TIdHTTPAccess = class(TIdHTTP)
End;
Procedure TRESTDWIdClientREST.SetUseSSL(Value : Boolean);
+{$IFDEF USE_TAURUS_TLS}
+Var
+ vRESTDWVersionsBase : TRESTDWVersionsBase;
+{$ENDIF}
Begin
Inherited;
If Assigned(HttpRequest) Then
@@ -3049,29 +3131,50 @@ TIdHTTPAccess = class(TIdHTTP)
Begin
If ssl = Nil Then
Begin
- ssl := TIdSSLIOHandlerSocketOpenSSL.Create(HttpRequest);
{$IFDEF FPC}
- ssl.OnVerifyPeer := @IdSSLIOHandlerSocketOpenSSL1VerifyPeer;
+ ssl := TIdSSLIOHandlerSocketOpenSSL.Create(HttpRequest);
+ TIdSSLIOHandlerSocketOpenSSL(ssl).OnVerifyPeer := @IdSSLIOHandlerSocketOpenSSL1VerifyPeer;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).OnGetPassword := @Getpassword;
+ If Assigned(HttpRequest) Then
+ HttpRequest.IOHandler := TIdSSLIOHandlerSocketOpenSSL(ssl);
{$ELSE}
- ssl.OnVerifyPeer := IdSSLIOHandlerSocketOpenSSL1VerifyPeer;
+ {$IFDEF USE_TAURUS_TLS}
+ If vUseTaurus Then
+ Begin
+ End
+ Else
+ Begin
+ ssl := TIdSSLIOHandlerSocketOpenSSL.Create(HttpRequest);
+ TIdSSLIOHandlerSocketOpenSSL(ssl).OnVerifyPeer := IdSSLIOHandlerSocketOpenSSL1VerifyPeer;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.Method := TIdSSLVersion(GetSSlVersion);//aSSLMethod;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.SSLVersions := TIdSSLVersions(Pointer(@vRESTDWVersionsBase)^);
+ TIdSSLIOHandlerSocketOpenSSL(ssl).SSLOptions.Mode := TIdSSLMode(GetSSlMode);//vSSLMode;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).OnGetPassword := Getpassword;
+ If Assigned(HttpRequest) Then
+ HttpRequest.IOHandler := TIdSSLIOHandlerSocketOpenSSL(ssl);
+ End;
+ {$ELSE}
+ ssl := TIdSSLIOHandlerSocketOpenSSL.Create(HttpRequest);
+ TIdSSLIOHandlerSocketOpenSSL(ssl).OnVerifyPeer := @IdSSLIOHandlerSocketOpenSSL1VerifyPeer;
+ TIdSSLIOHandlerSocketOpenSSL(ssl).OnGetPassword := @Getpassword;
+ If Assigned(HttpRequest) Then
+ HttpRequest.IOHandler := TIdSSLIOHandlerSocketOpenSSL(ssl);
+ {$ENDIF}
{$ENDIF}
End;
- ssl.SSLOptions.SSLVersions := vSSLVersions;
SetCertOptions;
- If Assigned(HttpRequest) Then
- HttpRequest.IOHandler := ssl;
- If sslvSSLv2 in vSSLVersions Then
- ssl.SSLOptions.Method := sslvSSLv2
- Else If sslvSSLv23 in vSSLVersions Then
- ssl.SSLOptions.Method := sslvSSLv23
- Else If sslvSSLv3 in vSSLVersions Then
- ssl.SSLOptions.Method := sslvSSLv3
- Else If sslvTLSv1 in vSSLVersions Then
- ssl.SSLOptions.Method := sslvTLSv1
- Else If sslvTLSv1_1 in vSSLVersions Then
- ssl.SSLOptions.Method := sslvTLSv1_1
- Else If sslvTLSv1_2 in vSSLVersions Then
- ssl.SSLOptions.Method := sslvTLSv1_2;
+// If sslvSSLv2 in vSSLVersions Then
+// ssl.SSLOptions.Method := sslvSSLv2
+// Else If sslvSSLv23 in vSSLVersions Then
+// ssl.SSLOptions.Method := sslvSSLv23
+// Else If sslvSSLv3 in vSSLVersions Then
+// ssl.SSLOptions.Method := sslvSSLv3
+// Else If sslvTLSv1 in vSSLVersions Then
+// ssl.SSLOptions.Method := sslvTLSv1
+// Else If sslvTLSv1_1 in vSSLVersions Then
+// ssl.SSLOptions.Method := sslvTLSv1_1
+// Else If sslvTLSv1_2 in vSSLVersions Then
+// ssl.SSLOptions.Method := sslvTLSv1_2;
End
Else
Begin
@@ -3395,8 +3498,8 @@ TIdHTTPAccess = class(TIdHTTP)
Begin
Inherited;
SetSocketKind('Standalone - Indy');
+ lHandler := Nil;
HTTPServer := TIdHTTPServer.Create(Nil);
- lHandler := TIdServerIOHandlerSSLOpenSSL.Create(Nil);
{$IFDEF FPC}
HTTPServer.OnQuerySSLPort := @IdHTTPServerQuerySSLPort;
HTTPServer.OnCommandGet := @aCommandGet;
@@ -3556,6 +3659,8 @@ TIdHTTPAccess = class(TIdHTTP)
End;
Procedure TRESTDWIdServicePooler.SetActive(Value: Boolean);
+Var
+ vRESTDWVersionsBase : Pointer;
Begin
If (Value) And
(Not (HTTPServer.Active)) Then
@@ -3564,27 +3669,69 @@ TIdHTTPAccess = class(TIdHTTP)
raise Exception.Create(cServerMethodClassNotAssigned);
Try
- If (ASSLPrivateKeyFile <> '') And
- (ASSLPrivateKeyPassword <> '') And
- (ASSLCertFile <> '') Then
+ If (ASSLCertFile <> '') Then
Begin
- lHandler.SSLOptions.Method := aSSLMethod;
- lHandler.SSLOptions.SSLVersions := PIdSSLVersions(@SSLVersions)^;
- {$IFDEF FPC}
- lHandler.OnGetPassword := @GetSSLPassword;
- lHandler.OnVerifyPeer := @SSLVerifyPeer;
+ vRESTDWVersionsBase := GetSSlVersions;
+ {$IFDEF USE_TAURUS_TLS}
+ If vUseTaurus Then
+ Begin
+ If (Assigned(lHandler) And (lHandler is TIdServerIOHandlerSSLOpenSSL)) Then
+ FreeAndNil(lHandler);
+ If Not Assigned(lHandler) Then
+ lHandler := TTaurusTLSServerIOHandler.Create(Nil);
+ TTaurusTLSServerIOHandler(lHandler).SSLOptions.MinTLSVersion := TTaurusTLSSSLVersion(Pointer(GetSSlVersion)^);//vSSLMode;
+ TTaurusTLSServerIOHandler(lHandler).SSLOptions.Mode := TTaurusTLSSSLMode(Pointer(GetSSlMode)^);//vSSLMode;
+ TTaurusTLSServerIOHandler(lHandler).DefaultCert.PublicKey := ASSLCertFile;
+ TTaurusTLSServerIOHandler(lHandler).DefaultCert.PrivateKey := ASSLPrivateKeyFile;
+ TTaurusTLSServerIOHandler(lHandler).SSLOptions.VerifyDepth := vSSLVerifyDepth;
+ TTaurusTLSServerIOHandler(lHandler).DefaultCert.RootKey := vASSLRootCertFile;
+ TTaurusTLSServerIOHandler(lHandler).SSLOptions.CipherList := vCipherList;
+ TTaurusTLSServerIOHandler(lHandler).SSLOptions.VerifyHostname := False;
+ HTTPServer.IOHandler := TTaurusTLSServerIOHandler(lHandler);
+ End
+ Else
+ Begin
+ If (Assigned(lHandler) And (lHandler is TTaurusTLSServerIOHandler)) Then
+ FreeAndNil(lHandler);
+ If Not Assigned(lHandler) Then
+ lHandler := TIdServerIOHandlerSSLOpenSSL.Create(Nil);
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.SSLVersions := TIdSSLVersions(Pointer(vRESTDWVersionsBase)^);
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.Method := TIdSSLVersion(Pointer(GetSSlVersion)^);//aSSLMethod;
+ {$IFDEF FPC}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnGetPassword := @GetSSLPassword;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnVerifyPeer := @SSLVerifyPeer;
+ {$ELSE}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnGetPassword := GetSSLPassword;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnVerifyPeer := SSLVerifyPeer;
+ {$ENDIF}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.CertFile := ASSLCertFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.KeyFile := ASSLPrivateKeyFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.VerifyMode := vSSLVerifyMode;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.VerifyDepth := vSSLVerifyDepth;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.RootCertFile := vASSLRootCertFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.Mode := TIdSSLMode(Pointer(GetSSlMode)^);//vSSLMode;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.CipherList := vCipherList;
+ HTTPServer.IOHandler := TIdServerIOHandlerSSLOpenSSL(lHandler);
+ End;
{$ELSE}
- lHandler.OnGetPassword := GetSSLPassword;
- lHandler.OnVerifyPeer := SSLVerifyPeer;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.SSLVersions := TIdSSLVersions(Pointer(vRESTDWVersionsBase)^);
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.Method := TIdSSLVersion(Pointer(GetSSlVersion)^);//aSSLMethod;
+ {$IFDEF FPC}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnGetPassword := @GetSSLPassword;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnVerifyPeer := @SSLVerifyPeer;
+ {$ELSE}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnGetPassword := GetSSLPassword;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnVerifyPeer := SSLVerifyPeer;
+ {$ENDIF}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.CertFile := ASSLCertFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.KeyFile := ASSLPrivateKeyFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.VerifyMode := vSSLVerifyMode;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.VerifyDepth := vSSLVerifyDepth;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.RootCertFile := vASSLRootCertFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.Mode := TIdSSLMode(Pointer(GetSSlMode)^);//vSSLMode;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.CipherList := vCipherList;
+ HTTPServer.IOHandler := TIdServerIOHandlerSSLOpenSSL(lHandler);
{$ENDIF}
- lHandler.SSLOptions.CertFile := ASSLCertFile;
- lHandler.SSLOptions.KeyFile := ASSLPrivateKeyFile;
- lHandler.SSLOptions.VerifyMode := vSSLVerifyMode;
- lHandler.SSLOptions.VerifyDepth := vSSLVerifyDepth;
- lHandler.SSLOptions.RootCertFile := vASSLRootCertFile;
- lHandler.SSLOptions.Mode := vSSLMode;
- lHandler.SSLOptions.CipherList := vCipherList;
- HTTPServer.IOHandler := lHandler;
End
Else
HTTPServer.IOHandler := Nil;
@@ -3596,7 +3743,7 @@ TIdHTTPAccess = class(TIdHTTP)
With HTTPServer.Bindings.Add do
Begin
IP := ServerIPVersionConfig.IPv4Address;
- IPVersion := Id_IPv4;
+ IPVersion := TIdIPVersion(Id_IPv4);
Port := ServicePort;
End;
End;
@@ -3606,7 +3753,7 @@ TIdHTTPAccess = class(TIdHTTP)
With HTTPServer.Bindings.Add do
Begin
IP := ServerIPVersionConfig.IPv6Address;
- IPVersion := Id_IPv6;
+ IPVersion := TIdIPVersion(Id_IPv6);
Port := ServicePort;
End;
End;
@@ -3631,6 +3778,180 @@ TIdHTTPAccess = class(TIdHTTP)
Password := aSSLPrivateKeyPassword;
End;
+Function TRESTDWIdServicePooler.GetSSlMode : Pointer;
+{$IFDEF USE_TAURUS_TLS}
+ Var
+ SSLMode : TIdSSLMode;
+ aTaurSSLMode : TTaurusTLSSSLMode;
+{$ENDIF}
+Begin
+ Result := Nil;
+ {$IFDEF USE_TAURUS_TLS}
+ If vUseTaurus Then
+ Begin
+ If vSSLMode = sslUnassigned Then
+ aTaurSSLMode := TTaurusTLSSSLMode(sslmUnassigned)
+ Else If vSSLMode = sslClient Then
+ aTaurSSLMode := TTaurusTLSSSLMode(sslmClient)
+ Else If vSSLMode = sslServer Then
+ aTaurSSLMode := TTaurusTLSSSLMode(sslmServer)
+ Else If vSSLMode = sslBoth Then
+ aTaurSSLMode := TTaurusTLSSSLMode(sslmBoth);
+ Result := @aTaurSSLMode;
+ End
+ Else
+ Begin
+ If vSSLMode = sslUnassigned Then
+ SSLMode := sslmUnassigned
+ Else If vSSLMode = sslClient Then
+ SSLMode := sslmClient
+ Else If vSSLMode = sslServer Then
+ SSLMode := sslmServer
+ Else If vSSLMode = sslBoth Then
+ SSLMode := sslmBoth;
+ Result := @SSLMode;
+ End;
+ {$ELSE}
+ If vSSLMode = sslUnassigned Then
+ SSLMode := sslUnassigned
+ Else If vSSLMode = sslClient Then
+ SSLMode := sslClient
+ Else If vSSLMode = sslServer Then
+ SSLMode := sslServer
+ Else If vSSLMode = sslBoth Then
+ SSLMode := sslBoth;
+ Result := @SSLMode;
+ {$ENDIF}
+End;
+
+Function TRESTDWIdServicePooler.GetSSlVersion : Pointer;
+Var
+ SSLVersion : TIdSSLVersion;
+ {$IFDEF USE_TAURUS_TLS}
+ MinSSLVersion : TTaurusTLSSSLVersion;
+ {$ENDIF}
+Begin
+ Result := Nil;
+ {$IFDEF USE_TAURUS_TLS}
+ If vUseTaurus Then
+ Begin
+ If SSLv2 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(SSLv2);
+ If SSLv23 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(SSLv23);
+ If SSLv3 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(SSLv3);
+ If TLSv1 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(TLSv1);
+ If TLSv1_1 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(TLSv1_1);
+ If TLSv1_2 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(TLSv1_2);
+ If TLSv1_3 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(TLSv1_3);
+ Result := @MinSSLVersion;
+ End
+ Else
+ Begin
+ If aSSLMethod = SSLv2 Then
+ SSLVersion := sslvSSLv2;
+ If aSSLMethod = SSLv23 Then
+ SSLVersion := sslvSSLv23;
+ If aSSLMethod = SSLv3 Then
+ SSLVersion := sslvSSLv3;
+ If aSSLMethod = TLSv1 Then
+ SSLVersion := sslvTLSv1;
+ If aSSLMethod = TLSv1_1 Then
+ SSLVersion := sslvTLSv1_1;
+ If aSSLMethod = TLSv1_2 Then
+ SSLVersion := sslvTLSv1_2;
+ If aSSLMethod = TLSv1_3 Then
+ Raise Exception.Create('Indy no have TLS 1.3 Support...');
+ Result := @SSLVersion;
+ End;
+ {$ELSE}
+ If aSSLMethod = SSLv2 Then
+ SSLVersion := sslvSSLv2;
+ If aSSLMethod = SSLv23 Then
+ SSLVersion := sslvSSLv23;
+ If aSSLMethod = SSLv3 Then
+ SSLVersion := sslvSSLv3;
+ If aSSLMethod = TLSv1 Then
+ SSLVersion := sslvTLSv1;
+ If aSSLMethod = TLSv1_1 Then
+ SSLVersion := sslvTLSv1_1;
+ If aSSLMethod = TLSv1_2 Then
+ SSLVersion := sslvTLSv1_2;
+ If aSSLMethod = TLSv1_3 Then
+ Raise Exception.Create('Indy no have TLS 1.3 Support...');
+ Result := @SSLVersion;
+ {$ENDIF}
+End;
+
+Function TRESTDWIdServicePooler.GetSSlVersions : Pointer;
+Var
+ bSSLVersions : TIdSSLVersions;
+ {$IFDEF USE_TAURUS_TLS}
+ MinSSLVersion : TTaurusTLSSSLVersion;
+ {$ENDIF}
+Begin
+ bSSLVersions := [];
+ {$IFDEF USE_TAURUS_TLS}
+ If vUseTaurus Then
+ Begin
+ If SSLv2 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(SSLv2);
+ If SSLv23 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(SSLv23);
+ If SSLv3 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(SSLv3);
+ If TLSv1 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(TLSv1);
+ If TLSv1_1 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(TLSv1_1);
+ If TLSv1_2 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(TLSv1_2);
+ If TLSv1_3 in aSSLVersions Then
+ MinSSLVersion := TTaurusTLSSSLVersion(TLSv1_3);
+ Result := @MinSSLVersion;
+ End
+ Else
+ Begin
+ If SSLv2 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvSSLv2];
+ If SSLv23 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvSSLv23];
+ If SSLv3 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvSSLv3];
+ If TLSv1 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvTLSv1];
+ If TLSv1_1 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvTLSv1_1];
+ If TLSv1_2 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvTLSv1_2];
+ If TLSv1_3 in aSSLVersions Then
+ Raise Exception.Create('Indy no have TLS 1.3 Support...');
+ Result := @SSLVersions;
+ End;
+ {$ELSE}
+ If SSLv2 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvSSLv2];
+ If SSLv23 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvSSLv23];
+ If SSLv3 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvSSLv3];
+ If TLSv1 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvTLSv1];
+ If TLSv1_1 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvTLSv1_1];
+ If TLSv1_2 in aSSLVersions Then
+ bSSLVersions := bSSLVersions + [sslvTLSv1_2];
+ If TLSv1_3 in aSSLVersions Then
+ Raise Exception.Create('Indy no have TLS 1.3 Support...');
+ Result := @bSSLVersions;
+ {$ENDIF}
+End;
+
{ TRESTDWIdClientPooler }
@@ -3687,6 +4008,21 @@ procedure TRESTDWIdClientPooler.Abort;
Inherited;
End;
+Function TRESTDWIdClientPooler.GetSSlMode : Integer;
+Begin
+ Result := 0;
+End;
+
+Function TRESTDWIdClientPooler.GetSSlVersion : Integer;
+Begin
+ Result := 0;
+End;
+
+Function TRESTDWIdClientPooler.GetSSlVersions : TRESTDWVersionsBase;
+Begin
+ Result := Nil;
+End;
+
function TRESTDWIdClientPooler.IsServerLive(Aip: String; Aport: Integer;
AMessageErro: String): Boolean;
var
@@ -3729,6 +4065,8 @@ function TRESTDWIdClientPooler.IsServerLive(Aip: String; Aport: Integer;
aEncoding : TEncodeSelect;
aAccessTag : String;
aAuthenticationOptions : TRESTDWClientAuthOptionParams);
+Var
+ vRESTDWVersionsBase : TRESTDWVersionsBase;
Begin
{$IFNDEF RESTDWLAZARUS}
{$IFNDEF FPC}
@@ -3737,8 +4075,22 @@ function TRESTDWIdClientPooler.IsServerLive(Aip: String; Aport: Integer;
{$ENDIF}
If (UseSSL) Then
Begin
- HttpRequest.CertMode := vSSLMode;
- HttpRequest.SSLVersions := PIdSSLVersions(@SSLVersions)^;
+ vRESTDWVersionsBase := GetSSlVersions;
+ {$IFDEF USE_TAURUS_TLS}
+ If vUseTaurus Then
+ Begin
+ End
+ Else
+ Begin
+ HttpRequest.CertMode := TRESTDWSSLMode(GetSSlMode);//vSSLMode;
+ HttpRequest.SSLVersions := TRESTDWSSLVersions(Pointer(@vRESTDWVersionsBase)^);
+ HttpRequest.CertFile := ASSLCertFile;
+ HttpRequest.KeyFile := ASSLPrivateKeyFile;
+ HttpRequest.RootCertFile := vASSLRootCertFile;
+// HttpRequest.CipherList := vCipherList;
+ End;
+ {$ELSE}
+ {$ENDIF}
End;
End;
@@ -4635,7 +4987,7 @@ function TRESTDWIdClientPooler.IsServerLive(Aip: String; Aport: Integer;
FreeAndNil(HttpRequest);
HttpRequest := TRESTDWIdClientREST.Create(Nil);
If (TypeRequest = trHttps) Then
- HttpRequest.SSLVersions := PIdSSLVersions(@SSLVersions)^;
+ HttpRequest.SSLVersions := SSLVersions;//PIdSSLVersions(@SSLVersions)^;
HttpRequest.UserAgent := UserAgent;
SetCharsetRequest(HttpRequest, Encoding);
SetParams(ProxyOptions, RequestTimeout, ConnectTimeout, AuthenticationOptions);
@@ -4644,11 +4996,9 @@ function TRESTDWIdClientPooler.IsServerLive(Aip: String; Aport: Integer;
If BinaryRequest Then
If HttpRequest.DefaultCustomHeader.IndexOfName('binaryrequest') = -1 Then
HttpRequest.DefaultCustomHeader.Add('binaryrequest=true');
-
If aBinaryCompatibleMode Then
If HttpRequest.DefaultCustomHeader.IndexOfName('BinaryCompatibleMode') = -1 Then
HttpRequest.DefaultCustomHeader.Add('BinaryCompatibleMode=true');
-
LastErrorMessage := '';
LastErrorCode := -1;
Try
@@ -4803,6 +5153,21 @@ destructor TRESTDWIdPoolerList.Destroy;
{ TRESTDWIdProxyRequest }
+Function TRESTDWIdProxyRequest.GetSSlVersion : Integer;
+Begin
+ Result := 0;
+End;
+
+Function TRESTDWIdProxyRequest.GetSSlVersions : TRESTDWVersionsBase;
+Begin
+ Result := Nil;
+End;
+
+Function TRESTDWIdProxyRequest.GetSSlMode : Integer;
+Begin
+ Result := 0;
+End;
+
Procedure TRESTDWIdProxyRequest.aCommandGet(AContext : TIdContext;
ARequestInfo : TIdHTTPRequestInfo;
AResponseInfo : TIdHTTPResponseInfo);
@@ -5003,6 +5368,10 @@ destructor TRESTDWIdPoolerList.Destroy;
HTTPServer := TIdHTTPServer.Create(Nil);
ClientHttpBase := TRESTDWClientHttpBase;
lHandler := TIdServerIOHandlerSSLOpenSSL.Create(Nil);
+ {$IFDEF USE_TAURUS_TLS}
+ vUseTaurus := False;
+ {$ENDIF}
+
{$IFDEF FPC}
HTTPServer.OnQuerySSLPort := @IdHTTPServerQuerySSLPort;
HTTPServer.OnCommandGet := @aCommandGet;
@@ -5125,6 +5494,8 @@ procedure TRESTDWIdProxyRequest.OnParseAuthentication(AContext : TIdCont
End;
procedure TRESTDWIdProxyRequest.SetActive(Value : Boolean);
+Var
+ vRESTDWVersionsBase : TRESTDWVersionsBase;
Begin
If (Value) And
(Not (HTTPServer.Active)) Then
@@ -5134,26 +5505,56 @@ procedure TRESTDWIdProxyRequest.SetActive(Value : Boolean);
Try
If (ASSLPrivateKeyFile <> '') And
- (ASSLPrivateKeyPassword <> '') And
+// (ASSLPrivateKeyPassword <> '') And
(ASSLCertFile <> '') Then
Begin
- lHandler.SSLOptions.Method := aSSLMethod;
- lHandler.SSLOptions.SSLVersions := PIdSSLVersions(@SSLVersions)^;
- {$IFDEF FPC}
- lHandler.OnGetPassword := @GetSSLPassword;
- lHandler.OnVerifyPeer := @SSLVerifyPeer;
+ vRESTDWVersionsBase := GetSSlVersions;
+ {$IFDEF USE_TAURUS_TLS}
+ If vUseTaurus Then
+ Begin
+ End
+ Else
+ Begin
+ //TODO SSL
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.Method := TIdSSLVersion(GetSSlVersion);//aSSLMethod;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.SSLVersions := TIdSSLVersions(Pointer(@vRESTDWVersionsBase)^);
+// PRESTDWSSLVersions(@SSLVersions)^;
+ {$IFDEF FPC}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnGetPassword := @GetSSLPassword;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnVerifyPeer := @SSLVerifyPeer;
+ {$ELSE}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnGetPassword := GetSSLPassword;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnVerifyPeer := SSLVerifyPeer;
+ {$ENDIF}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.CertFile := ASSLCertFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.KeyFile := ASSLPrivateKeyFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.VerifyMode := vSSLVerifyMode;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.VerifyDepth := vSSLVerifyDepth;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.RootCertFile := vASSLRootCertFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.Mode := TIdSSLMode(GetSSlMode);//vSSLMode;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.CipherList := vCipherList;
+ HTTPServer.IOHandler := TIdServerIOHandlerSSLOpenSSL(lHandler);
+ End;
{$ELSE}
- lHandler.OnGetPassword := GetSSLPassword;
- lHandler.OnVerifyPeer := SSLVerifyPeer;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.Method := TIdSSLVersion(GetSSlVersion);//aSSLMethod;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.SSLVersions := TIdSSLVersions(Pointer(@vRESTDWVersionsBase)^);
+// PRESTDWSSLVersions(@SSLVersions)^;
+ {$IFDEF FPC}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnGetPassword := @GetSSLPassword;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnVerifyPeer := @SSLVerifyPeer;
+ {$ELSE}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnGetPassword := GetSSLPassword;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).OnVerifyPeer := SSLVerifyPeer;
+ {$ENDIF}
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.CertFile := ASSLCertFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.KeyFile := ASSLPrivateKeyFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.VerifyMode := vSSLVerifyMode;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.VerifyDepth := vSSLVerifyDepth;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.RootCertFile := vASSLRootCertFile;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.Mode := TIdSSLMode(GetSSlMode);//vSSLMode;
+ TIdServerIOHandlerSSLOpenSSL(lHandler).SSLOptions.CipherList := vCipherList;
+ HTTPServer.IOHandler := TIdServerIOHandlerSSLOpenSSL(lHandler);
{$ENDIF}
- lHandler.SSLOptions.CertFile := ASSLCertFile;
- lHandler.SSLOptions.KeyFile := ASSLPrivateKeyFile;
- lHandler.SSLOptions.VerifyMode := vSSLVerifyMode;
- lHandler.SSLOptions.VerifyDepth := vSSLVerifyDepth;
- lHandler.SSLOptions.RootCertFile := vASSLRootCertFile;
- lHandler.SSLOptions.Mode := vSSLMode;
- lHandler.SSLOptions.CipherList := vCipherList;
- HTTPServer.IOHandler := lHandler;
End
Else
HTTPServer.IOHandler := Nil;
@@ -5165,7 +5566,7 @@ procedure TRESTDWIdProxyRequest.SetActive(Value : Boolean);
With HTTPServer.Bindings.Add do
Begin
IP := ServerIPVersionConfig.IPv4Address;
- IPVersion := Id_IPv4;
+ IPVersion := TIdIpVersion(Id_IPv4);
Port := ServicePort;
End;
End;
@@ -5175,7 +5576,7 @@ procedure TRESTDWIdProxyRequest.SetActive(Value : Boolean);
With HTTPServer.Bindings.Add do
Begin
IP := ServerIPVersionConfig.IPv6Address;
- IPVersion := Id_IPv6;
+ IPVersion := TIdIpVersion(Id_IPv6);
Port := ServicePort;
End;
End;
diff --git a/CORE/Source/utils/JSON/uRESTDWJSONInterface.pas b/CORE/Source/utils/JSON/uRESTDWJSONInterface.pas
index a74f6130..76e6dfbf 100644
--- a/CORE/Source/utils/JSON/uRESTDWJSONInterface.pas
+++ b/CORE/Source/utils/JSON/uRESTDWJSONInterface.pas
@@ -28,7 +28,7 @@ interface
{$ENDIF}
Uses
SysUtils, Classes, Variants,
- {$IFDEF RESTDWFMX} system.json, {$ELSE} uRESTDWJSON, {$ENDIF}
+ {$IFNDEF FPC} system.json, {$ELSE} uRESTDWJSON, {$ENDIF}
uRESTDWConsts;
Type
@@ -115,8 +115,7 @@ implementation
result := stringreplace(Astr, Asubstr, '', [rfReplaceAll, rfIgnoreCase]);
End;
-{$IFDEF RESTDWFMX}
-
+{$IFNDEF FPC}
Function GetElementJSON(bArray: TJSONObject; Value: String): String;
Var
I: Integer;
@@ -140,7 +139,7 @@ implementation
Function TRESTDWJSONInterfaceObject.OpenArray(key: String) : TRESTDWJSONInterfaceArray;
Var
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
vEIndex: Integer;
aJSONObject: TJSONObject;
{$ENDIF}
@@ -148,7 +147,7 @@ implementation
aJSONArray : TJSONArray;
Begin
result := TRESTDWJSONInterfaceArray.Create;
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
If TJSONObject(JSONObject).ClassName = 'TJSONObject' Then
Begin
aJSONObject := TJSONObject.ParseJSONValue(TJSONObject(JSONObject).ToJSON) as TJSONObject;
@@ -172,7 +171,7 @@ implementation
Function TRESTDWJSONInterfaceObject.OpenArray(Index: Integer)
: TRESTDWJSONInterfaceArray;
-{$IFDEF RESTDWFMX}
+{$IFNDEF FPC}
Var
vEIndex: Integer;
aJSONObject: TJSONObject;
@@ -182,7 +181,7 @@ implementation
result := TRESTDWJSONInterfaceArray.Create;
If Assigned(vJSONObject) Then
FreeAndNil(vJSONObject);
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
If TJSONObject(JSONObject).ClassName = 'TJSONObject' Then
Begin
aJSONObject := TJSONObject.ParseJSONValue(TJSONObject(JSONObject).ToJSON)
@@ -226,7 +225,7 @@ implementation
result := 0;
If vJSONObject = Nil then
Exit;
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
result := TJSONArray(vJSONObject).Size;
{$ELSE}
If TJSONObject(vJSONObject).ClassName = 'TJSONObject' Then
@@ -242,7 +241,7 @@ implementation
Function TRESTDWJSONInterfaceArray.GetObject(Index: Integer)
: TRESTDWJSONInterfaceBase;
Var
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
aJSONObject : TJSONArray;
aJSONValue : TJSONValue;
{$ELSE}
@@ -255,7 +254,7 @@ implementation
vClassName := TJSONObject(vJSONObject).ClassName;
If (Uppercase(TJSONObject(vJSONObject).ClassName) = Uppercase('TJSONArray')) Then
Begin
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
aJSONValue := TJSONObject.ParseJSONValue(TJSONObject(JSONObject).Get(Index).ToJSON);
If aJSONValue is TJSONObject Then
result.vJSONObject := TJSONBaseClass(aJSONValue as TJSONObject)
@@ -289,7 +288,7 @@ implementation
Else If (Uppercase(TJSONObject(vJSONObject).ClassName)
= Uppercase('TJSONObject')) Then
Begin
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
result.vJSONObject := TJSONBaseClass
(TJSONObject.ParseJSONValue(TJSONObject(vJSONObject).Get(Index)
.JSONValue.ToJSON) as TJSONArray);
@@ -322,7 +321,7 @@ implementation
Begin
If Assigned(vJSONObject) Then
FreeAndNil(vJSONObject);
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
If JSONValue[InitStrPos] = '[' then
vJSONObject := TJSONBaseClass(TJSONObject.ParseJSONValue(JSONValue) as TJSONArray)
Else If JSONValue[InitStrPos] = '{' then
@@ -351,7 +350,7 @@ implementation
Var
I: Integer;
vElementName, vClassName: String;
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
aJSONObject: TJSONObject;
vValueJSON: String;
{$ELSE}
@@ -366,7 +365,7 @@ implementation
Exit;
End;
vClassName := TJSONObject(vJSONObject).ClassName;
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
If (Uppercase(vClassName) = Uppercase('TRESTDWJSONInterfaceObject')) Or
(Uppercase(vClassName) = Uppercase('TJSONObject')) Or
(Uppercase(vClassName) = Uppercase('TRESTDWJSONInterfaceBase')) Then
@@ -509,32 +508,31 @@ implementation
Function TRESTDWJSONInterfaceObject.GetPair(Index: Integer): TRESTDWJSONPair;
Var
vElementName, vClassName: String;
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
aJSONObject: TJSONObject;
vValueJSON: String;
{$ELSE}
cNames : TJSONArray;
{$ENDIF}
Begin
- result.isnull := False;
- result.Value := 'null';
- If vJSONObject = Nil Then
+ result.isnull := False;
+ result.Value := 'null';
+ If vJSONObject = Nil Then
Begin
- result.isnull := True;
- Exit;
+ result.isnull := True;
+ Exit;
End;
vClassName := TJSONObject(vJSONObject).ClassName;
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
If (Uppercase(vClassName) = Uppercase('TRESTDWJSONInterfaceObject')) Or
- (Uppercase(vClassName) = Uppercase('TJSONObject')) Or
- (Uppercase(vClassName) = Uppercase('TRESTDWJSONInterfaceBase')) Then
- Begin
+ (Uppercase(vClassName) = Uppercase('TJSONObject')) Or
+ (Uppercase(vClassName) = Uppercase('TRESTDWJSONInterfaceBase')) Then
+ Begin
If vClassName <> '_String' Then
- Begin
+ Begin
If (TJSONObject(vJSONObject).Count > index) Then
Begin
- result.Name := removestr(TJSONObject(vJSONObject).Pairs[index]
- .JsonString.Value, '"');
+ result.Name := removestr(TJSONObject(vJSONObject).Pairs[index].JsonString.Value, '"');
If TJSONObject(vJSONObject).Pairs[index].JSONValue is TJSONObject Then
Begin
result.ClassName := 'TJSONObject';
@@ -542,8 +540,7 @@ implementation
.JSONValue.toString;
// removestr(TJSONObject(vJSONObject).Pairs[index].JsonValue.tostring, '"');
If (vValueJSON = '') Or (Trim(vValueJSON) = '""') then
- result.Value := TJSONObject(vJSONObject).Pairs[index]
- .JSONValue.Value
+ result.Value := TJSONObject(vJSONObject).Pairs[index].JSONValue.Value
else
result.Value := vValueJSON;
End
@@ -558,36 +555,51 @@ implementation
else
result.Value := vValueJSON;
End;
- End;
- End
+ End;
+ End
Else
- Begin
+ Begin
result.Value := TJSONObject(vJSONObject).Pairs[index].JSONValue.Value;
// removestr(TJSONObject(vJSONObject).Pairs[index].JsonValue.tostring, '"');
- result.ClassName := TJSONObject(vJSONObject).Pairs[index]
- .JSONValue.ClassName;
- End;
- End
+ result.ClassName := TJSONObject(vJSONObject).Pairs[index].JSONValue.ClassName;
+ End;
+ End
Else If Uppercase(vClassName) = Uppercase('TJSONArray') Then
- Begin
- aJSONObject := TJSONObject.ParseJSONValue(TJSONObject(vJSONObject)
- .Get(index).ToJSON) as TJSONObject;
- result.Name := removestr(aJSONObject.Value, '"');
- If (aJSONObject.toString = '') Or (Trim(aJSONObject.toString) = '""') then
- result.Value := ''
+ Begin
+ vClassName := TJSONObject(vJSONObject).Get(index).classname;
+ If Uppercase(vClassName) = Uppercase('TJSONArray') Then
+ Begin
+ aJSONObject := TJSONObject.ParseJSONValue(TJSONObject(vJSONObject).Get(index).ToJSON) as TJSONObject;
+ result.Name := removestr(aJSONObject.Value, '"');
+ If (aJSONObject.toString = '') Or (Trim(aJSONObject.toString) = '""') then
+ result.Value := ''
+ Else
+ result.Value := aJSONObject.toString;
+ result.ClassName := 'TJSONArray';
+ FreeAndNil(aJSONObject);
+ End
Else
- result.Value := aJSONObject.toString;
- result.ClassName := 'TJSONArray';
- FreeAndNil(aJSONObject);
- End
+ Begin
+ result.Name := '';
+ vValueJSON := TJSONObject(vJSONObject).Get(index).tostring;
+ result.Value := removestr(vValueJSON, '""');
+ If vClassName = 'NULL' Then
+ result.ClassName := 'TJSONValue'
+ Else
+ result.ClassName := vClassName;
+ End;
+ End
Else
- Begin
+ Begin
result.Name := '';
result.Value := TJSONValue(vJSONObject).Value;
If (result.Value = '') Or (Trim(result.Value) = '""') then
- result.Value := TJSONObject(vJSONObject).ToJSON;
- result.ClassName := 'TJSONValue';
- End;
+ result.Value := removestr(TJSONObject(vJSONObject).ToJSON, '"');
+ If vClassName = 'NULL' Then
+ result.ClassName := 'TJSONValue'
+ Else
+ result.ClassName := vClassName;
+ End;
{$ELSE}
If (Uppercase(vClassName) = Uppercase('TRESTDWJSONInterfaceObject')) Or
(Uppercase(vClassName) = Uppercase('TJSONObject')) Or
@@ -619,10 +631,10 @@ implementation
If cNames <> Nil Then
FreeAndNil(cNames);
End
- Else
+ Else
Begin
- result.Value := TJSONObject(vJSONObject).toString;
- result.ClassName := TJSONObject(vJSONObject).ClassName;
+ result.Value := TJSONObject(vJSONObject).toString;
+ result.ClassName := TJSONObject(vJSONObject).ClassName;
End;
End
Else If Uppercase(vClassName) = Uppercase('TJSONArray') Then
@@ -647,27 +659,41 @@ implementation
End
Else
Begin
- vClassName := TJSONArray(vJSONObject).optJSONObject(index).ClassName;
- result.ClassName := 'TJSONArray';
- cNames := TJSONObject(TJSONArray(vJSONObject).optJSONObject(index)).names;
- If (cNames.length > 0) And (Uppercase(vClassName) = Uppercase('TJSONArray')) Then
- Begin
- If (cNames.length > index) Then
- Begin
- result.Name := cNames.Get(index).toString;
- result.Value := TJSONObject(TJSONArray(vJSONObject).optJSONObject(index)).Get(result.Name).toString;
- End;
- End
- Else
+ If Not Assigned(TJSONArray(vJSONObject).optJSONObject(index)) Then
Begin
+ vClassName := TJSONArray(vJSONObject).get(index).ClassName;
+ If vClassName = 'NULL' Then
+ result.ClassName := 'tjsonstring';
result.Name := TJSONArray(vJSONObject).Get(index).toString;
- If (Trim(result.Name) = '') Or
+ If (Trim(result.Name) = '') Or (UpperCase(Trim(result.Name)) = 'NULL') Or
((Pos('{', result.Name) > 0) Or (Pos('[', result.Name) > 0)) Then
result.Name := 'arrayobj' + IntToStr(Index);
result.Value := TJSONArray(vJSONObject).opt(Index).toString;
+ End
+ Else
+ Begin
+ vClassName := TJSONArray(vJSONObject).optJSONObject(index).ClassName;
+ result.ClassName := 'TJSONArray';
+ cNames := TJSONObject(TJSONArray(vJSONObject).optJSONObject(index)).names;
+ If (cNames.length > 0) And (Uppercase(vClassName) = Uppercase('TJSONArray')) Then
+ Begin
+ If (cNames.length > index) Then
+ Begin
+ result.Name := cNames.Get(index).toString;
+ result.Value := TJSONObject(TJSONArray(vJSONObject).optJSONObject(index)).Get(result.Name).toString;
+ End;
+ End
+ Else
+ Begin
+ result.Name := TJSONArray(vJSONObject).Get(index).toString;
+ If (Trim(result.Name) = '') Or
+ ((Pos('{', result.Name) > 0) Or (Pos('[', result.Name) > 0)) Then
+ result.Name := 'arrayobj' + IntToStr(Index);
+ result.Value := TJSONArray(vJSONObject).opt(Index).toString;
+ End;
+ If Assigned(cNames) Then
+ FreeAndNil(cNames);
End;
- If Assigned(cNames) Then
- FreeAndNil(cNames);
End;
End
Else
@@ -679,7 +705,7 @@ implementation
If Trim(result.ClassName) = '' Then
result.ClassName := vClassName;
// Correção para null value
- result.isnull := (result.Value = 'null') or (Result.Value = '');
+ result.isnull := ((result.Value = 'null') or (Result.Value = ''));
If result.isnull Then
result.Value := '';
End;
@@ -693,7 +719,7 @@ implementation
result := 0;
If vJSONObject = Nil Then
Exit;
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
If vJSONObject <> Nil Then
result := TJSONObject(vJSONObject).Count;
{$ELSE}
@@ -820,18 +846,18 @@ constructor TRESTDWJSONInterfaceBase.Create(ParentJSON: TJSONBaseClass);
End;
function TRESTDWJSONInterfaceBase.PairCount: Integer;
-{$IFNDEF RESTDWFMX}
+{$IFDEF FPC}
Var
cNames : TJSONArray;
{$ENDIF}
begin
- {$IFDEF RESTDWFMX}
+ {$IFNDEF FPC}
result := TJSONObject(vJSONObject).Count;
- {$ELSE}
- cNames := TJSONObject(vJSONObject).names;
- result := cNames.length;
- FreeAndNil(cNames);
- {$ENDIF}
+ {$ELSE}
+ cNames := TJSONObject(vJSONObject).names;
+ result := cNames.length;
+ FreeAndNil(cNames);
+ {$ENDIF}
end;
end.
diff --git a/CORE/Source/utils/uRESTDWOpenSslLib.pas b/CORE/Source/utils/uRESTDWOpenSslLib.pas
index 5d51f81b..60dd24f7 100644
--- a/CORE/Source/utils/uRESTDWOpenSslLib.pas
+++ b/CORE/Source/utils/uRESTDWOpenSslLib.pas
@@ -22498,7 +22498,7 @@ function LoadCrypto : boolean;
{$IFDEF FPC}
Pointer(OpenSSL_version_num) := GetProcAddress(RESTDW_CRYPYO_DLL_Handle, 'OpenSSL_version_num');
{$ELSE}
- OpenSSL_version_num := GetProcAddress(RESTDW_CRYPYO_DLL_Handle, 'OpenSSL_version_num');
+ // OpenSSL_version_num := GetProcAddress(RESTDW_CRYPYO_DLL_Handle, 'OpenSSL_version_num');
{$ENDIF}
if @OpenSSL_version_num = nil then begin
FreeLibrary(RESTDW_CRYPYO_DLL_Handle);