diff --git a/src/DataSetUtils.pas b/src/DataSetUtils.pas index 8be93a0..53eb7cb 100644 --- a/src/DataSetUtils.pas +++ b/src/DataSetUtils.pas @@ -7,7 +7,7 @@ interface type TDataSetUtils = class public - class function CreateField(DataSet: TDataSet; FieldType: TFieldType; const FieldName: string = '';ASize: Integer=0): TField; + class function CreateField(DataSet: TDataSet; FieldType: TFieldType; const FieldName: string = '';ASize: Integer=0; const displayName: string=''): TField; class function CreateDataSetField(DataSet: TDataSet; const FieldName: string): TDataSetField; end; @@ -21,19 +21,21 @@ class function TDataSetUtils.CreateDataSetField(DataSet: TDataSet;const FieldNam end; class function TDataSetUtils.CreateField(DataSet: TDataSet; - FieldType: TFieldType; const FieldName: string; ASize: Integer): TField; + FieldType: TFieldType; const FieldName: string; ASize: Integer; const displayName: string): TField; begin Result:= DefaultFieldClasses[FieldType].Create(DataSet); Result.FieldName:= FieldName; if Result.FieldName = '' then Result.FieldName:= 'Field' + IntToStr(DataSet.FieldCount +1); + if(displayName <> '') then + result.DisplayLabel := displayName; Result.FieldKind := fkData; Result.DataSet:= DataSet; Result.Name:= DataSet.Name + Result.FieldName; Result.Size := ASize; if (FieldType = ftString) and (ASize <= 0) then - raise Exception.CreateFmt('Size não definido para o campo "%s".',[FieldName]); + raise Exception.CreateFmt('Size não definido para o campo "%s".',[FieldName]); end; end. diff --git a/src/JsonToDataSetConverter.pas b/src/JsonToDataSetConverter.pas index 305b6f7..1b19948 100644 --- a/src/JsonToDataSetConverter.pas +++ b/src/JsonToDataSetConverter.pas @@ -11,15 +11,17 @@ TJsonToDataSetConverter = class class procedure SetFieldValue(AField: TField; AValue: ISuperObject); class procedure ExtractFields(ADataSet: TDataSet; AObject: ISuperObject); + class procedure ExtractStructure(ADataSet: TDataSet; AObject: ISuperObject; tableNode, titleNode: string); class function SuperTypeToFieldType(ASuperType: TSuperType): TFieldType; class function SuperTypeToFieldSize(ASuperType: TSuperType): Integer; public - class procedure UnMarshalToDataSet(ADataSet: TDataSet; AJson: string);overload; - class procedure UnMarshalToDataSet(ADataSet: TDataSet; AObject: ISuperObject);overload; + class procedure UnMarshalToDataSet(ADataSet: TClientDataSet; AJson: string); + class procedure ToDataSet(ADataSet: TClientDataSet; AObject: ISuperObject); class function CreateDataSetMetadata(AJson: string): TClientDataSet; overload; class function CreateDataSetMetadata(AObject: ISuperObject): TClientDataSet; overload; + class function CreateDataSetMetadata(AObject: ISuperObject; table, structure: string): TClientDataSet; overload; end; implementation @@ -83,6 +85,26 @@ class function TJsonToDataSetConverter.CreateDataSetMetadata(AObject: ISuperObje Result.CreateDataSet; end; +class function TJsonToDataSetConverter.CreateDataSetMetadata(AObject: ISuperObject; table, structure: string): TClientDataSet; +var + vArray: TSuperArray; +begin + Result := TClientDataSet.Create(nil); + + if AObject.IsType(stArray) then + begin + vArray := AObject.O[table].AsArray; + + ExtractStructure(Result, AObject, table, structure); + end + else + begin + ExtractStructure(Result, AObject, table, structure); + end; + if Result.Fields.Count > 0 then + Result.CreateDataSet; +end; + class procedure TJsonToDataSetConverter.ExtractFields(ADataSet: TDataSet;AObject: ISuperObject); var vIterator: TSuperObjectIter; @@ -114,32 +136,75 @@ class procedure TJsonToDataSetConverter.ExtractFields(ADataSet: TDataSet;AObject end; end; +class procedure TJsonToDataSetConverter.ExtractStructure(ADataSet: TDataSet; AObject: ISuperObject; tableNode, titleNode: string); + +var + vIterator: TSuperObjectIter; + vNestedField: TDataSetField; + vArray: TSuperArray; + table: TSuperArray; + I: Integer; +begin + i:= 0; + table:= AObject.o[tableNode].AsArray; + if SuperObject.ObjectFindFirst(table[0], vIterator) then + begin + try + repeat + if (vIterator.val.IsType(stArray)) then + begin + vNestedField := TDataSetUtils.CreateDataSetField(ADataSet, vIterator.key); + + vArray := vIterator.val.AsArray; + if (vArray.Length > 0) then + begin + ExtractFields(vNestedField.NestedDataSet, vArray[0]); + end; + end + else + begin + TDataSetUtils.CreateField(ADataSet, SuperTypeToFieldType(vIterator.val.DataType), vIterator.key, + SuperTypeToFieldSize(vIterator.val.DataType), AObject.o[titleNode].S[vIterator.key]); + end; + until not SuperObject.ObjectFindNext(vIterator); + finally + SuperObject.ObjectFindClose(vIterator); + end; + end; + +end; + class procedure TJsonToDataSetConverter.SetFieldValue(AField: TField;AValue: ISuperObject); var vFieldName: string; - vNestedDataSet: TDataSet; + vNestedDataSet: TClientDataSet; begin - vFieldName := AField.FieldName; - case AField.DataType of - ftSmallint, ftInteger, ftWord, ftLargeint: AField.AsInteger := AValue.AsInteger; - ftFloat, ftCurrency, ftBCD, ftFMTBcd: AField.AsFloat := AValue.AsDouble; - ftBoolean: AField.AsBoolean := AValue.AsBoolean; - ftDate, ftTime, ftDateTime, ftTimeStamp: AField.AsDateTime := AValue.AsDouble; - ftDataSet: begin - vNestedDataSet := TDataSetField(AField).NestedDataSet; - - UnMarshalToDataSet(vNestedDataSet, AValue); - end; - else - AField.AsString := AValue.AsString; - end; + vFieldName := AField.FieldName; + if (AValue.IsType(stNull)) then + begin + vNestedDataSet := nil; + exit; + end; + case AField.DataType of + ftSmallint, ftInteger, ftWord, ftLargeint: AField.AsInteger := AValue.AsInteger; + ftFloat, ftCurrency, ftBCD, ftFMTBcd: AField.AsFloat := AValue.AsDouble; + ftBoolean: AField.AsBoolean := AValue.AsBoolean; + ftDate, ftTime, ftDateTime, ftTimeStamp: AField.AsDateTime := AValue.AsDouble; + ftDataSet: begin + vNestedDataSet := TClientDataSet( TDataSetField(AField).NestedDataSet); + + ToDataSet(vNestedDataSet, AValue); + end; + else + AField.AsString := AValue.AsString; + end; end; class function TJsonToDataSetConverter.SuperTypeToFieldSize(ASuperType: TSuperType): Integer; begin Result := 0; - if (ASuperType = stString) then + if (ASuperType = stNull) or (ASuperType = stString) then // Some fields return as null begin Result := 255; end; @@ -155,16 +220,19 @@ class function TJsonToDataSetConverter.SuperTypeToFieldType(ASuperType: TSuperTy stObject: Result := ftDataSet; stArray: Result := ftDataSet; stString: Result := ftString; + stNull: Result:= ftstring; // Rather than fail with an unknown type else Result := ftUnknown; end; end; -class procedure TJsonToDataSetConverter.UnMarshalToDataSet(ADataSet: TDataSet;AObject: ISuperObject); +class procedure TJsonToDataSetConverter.ToDataSet(ADataSet: TClientDataSet; AObject: ISuperObject); var i: Integer; vArray: TSuperArray; begin + if (ADataSet.FieldDefs.Count = 0) then // Check for whether any data is returned + EXIT; ADataSet.DisableControls; try if AObject.IsType(stArray) then @@ -187,13 +255,13 @@ class procedure TJsonToDataSetConverter.UnMarshalToDataSet(ADataSet: TDataSet;AO ADataSet.First; end; -class procedure TJsonToDataSetConverter.UnMarshalToDataSet(ADataSet: TDataSet; AJson: string); +class procedure TJsonToDataSetConverter.UnMarshalToDataSet(ADataSet: TClientDataSet; AJson: string); var AObject: ISuperObject; begin AObject := SuperObject.SO(AJson); - UnMarshalToDataSet(ADataSet, AObject); + ToDataSet(ADataSet, AObject); end; end. diff --git a/src/RestClient.pas b/src/RestClient.pas index b0fe1d5..0ea51ce 100644 --- a/src/RestClient.pas +++ b/src/RestClient.pas @@ -11,7 +11,7 @@ interface {$ELSE} Contnrs, OldRttiUnMarshal, {$ENDIF} - DB, JsonListAdapter; + DB, dbclient, JsonListAdapter; const DEFAULT_COOKIE_VERSION = 1; {Cookies using the default version correspond to RFC 2109.} @@ -46,7 +46,7 @@ TJsonListAdapter = class(TInterfacedObject, IJsonListAdapter) class function NewFrom(AList: TList; AItemClass: TClass): IJsonListAdapter; end; - TRestClient = class(TComponent) + TJsonRestClient = class(TComponent) private FHttpConnection: IHttpConnection; {$IFDEF USE_GENERICS} @@ -104,7 +104,10 @@ TRestClient = class(TComponent) property OnCustomCreateConnection: TCustomCreateConnection read FOnCustomCreateConnection write FOnCustomCreateConnection; property TimeOut: TTimeOut read FTimeOut; end; - + + type + TRestClient = TJsonRestClient deprecated 'Use TJsonRestClient'; + TCookie = class private FName: String; @@ -122,7 +125,7 @@ TCookie = class TResource = class private - FRestClient: TRestClient; + FRestClient: TJsonRestClient; // due to TRestClient Name collision FURL: string; FAcceptTypes: string; FContent: TMemoryStream; @@ -130,11 +133,11 @@ TResource = class FHeaders: TStrings; FAcceptedLanguages: string; - constructor Create(RestClient: TRestClient; URL: string); + constructor Create(RestClient: TJsonRestClient; URL: string); procedure SetContent(entity: TObject); + procedure SetJsonContent(json: string); public destructor Destroy; override; - function GetAcceptTypes: string; function GetURL: string; function GetContent: TStream; @@ -184,6 +187,9 @@ TResource = class function Post(Entity: TObject): T;overload; function Put(Entity: TObject): T;overload; function Patch(Entity: TObject): T;overload; + function PostJson(data: string; table: string; titles: string): TClientDataSet;overload; + function CreateDataset(data: string; table: string = ''; titles: string = ''): TClientDataSet; + function PostJson(data: string): string; overload; {$ELSE} function Get(AListClass, AItemClass: TClass): TObject;overload; function Post(Adapter: IJsonListAdapter): TObject;overload; @@ -200,14 +206,14 @@ TResource = class implementation uses StrUtils, Math, - {$IFDEF USE_SUPER_OBJECT} + //{$IFDEF USE_SUPER_OBJECT} // Super object proved superior to the Delphi Generics SuperObject, JsonToDataSetConverter, - {$ENDIF} + //{$ENDIF} HttpConnectionFactory; { TRestClient } -constructor TRestClient.Create(Owner: TComponent); +constructor TJsonRestClient.Create(Owner: TComponent); begin inherited; {$IFDEF USE_GENERICS} @@ -223,14 +229,14 @@ constructor TRestClient.Create(Owner: TComponent); FEnabledCompression := True; end; -destructor TRestClient.Destroy; +destructor TJsonRestClient.Destroy; begin FResources.Free; FHttpConnection := nil; inherited; end; -function TRestClient.DoCustomCreateConnection: IHttpConnection; +function TJsonRestClient.DoCustomCreateConnection: IHttpConnection; begin if Assigned(FOnCustomCreateConnection) then begin @@ -247,7 +253,7 @@ function TRestClient.DoCustomCreateConnection: IHttpConnection; end; end; -function TRestClient.DoRequest(Method: TRequestMethod; ResourceRequest: TResource; AHandler: TRestResponseHandler): String; +function TJsonRestClient.DoRequest(Method: TRequestMethod; ResourceRequest: TResource; AHandler: TRestResponseHandler): String; var vResponse: TStringStream; vUrl: String; @@ -319,38 +325,38 @@ function TRestClient.DoRequest(Method: TRequestMethod; ResourceRequest: TResourc end; {$IFDEF DELPHI_2009_UP} -procedure TRestClient.DoRequestFunc(Method: TRequestMethod; ResourceRequest: TResource; AHandler: TRestResponseHandlerFunc); +procedure TJsonRestClient.DoRequestFunc(Method: TRequestMethod; ResourceRequest: TResource; AHandler: TRestResponseHandlerFunc); begin FTempHandler := AHandler; DoRequest(Method, ResourceRequest, HandleAnonymousMethod); end; -procedure TRestClient.HandleAnonymousMethod(ResponseContent: TStream); +procedure TJsonRestClient.HandleAnonymousMethod(ResponseContent: TStream); begin FTempHandler(ResponseContent); FTempHandler := nil; end; {$ENDIF} -function TRestClient.GetOnConnectionLost: THTTPConnectionLostEvent; +function TJsonRestClient.GetOnConnectionLost: THTTPConnectionLostEvent; begin result := FHttpConnection.OnConnectionLost; end; -function TRestClient.GetOnError: THTTPErrorEvent; +function TJsonRestClient.GetOnError: THTTPErrorEvent; begin result := FHttpConnection.OnError; end; -function TRestClient.GetResponseCode: Integer; +function TJsonRestClient.GetResponseCode: Integer; begin CheckConnection; Result := FHttpConnection.ResponseCode; end; -procedure TRestClient.RecreateConnection; +procedure TJsonRestClient.RecreateConnection; begin if not (csDesigning in ComponentState) then begin @@ -366,7 +372,7 @@ procedure TRestClient.RecreateConnection; end; end; -procedure TRestClient.CheckConnection; +procedure TJsonRestClient.CheckConnection; begin if (FHttpConnection = nil) then begin @@ -374,19 +380,19 @@ procedure TRestClient.CheckConnection; end; end; -procedure TRestClient.Loaded; +procedure TJsonRestClient.Loaded; begin RecreateConnection; end; -function TRestClient.Resource(URL: String): TResource; +function TJsonRestClient.Resource(URL: String): TResource; begin Result := TResource.Create(Self, URL); FResources.Add(Result); end; -procedure TRestClient.SetConnectionType(const Value: THttpConnectionType); +procedure TJsonRestClient.SetConnectionType(const Value: THttpConnectionType); begin if (FConnectionType <> Value) then begin @@ -396,7 +402,7 @@ procedure TRestClient.SetConnectionType(const Value: THttpConnectionType); end; end; -procedure TRestClient.SetEnabledCompression(const Value: Boolean); +procedure TJsonRestClient.SetEnabledCompression(const Value: Boolean); begin if (FEnabledCompression <> Value) then begin @@ -409,18 +415,18 @@ procedure TRestClient.SetEnabledCompression(const Value: Boolean); end; end; -procedure TRestClient.SetOnConnectionLost( +procedure TJsonRestClient.SetOnConnectionLost( AConnectionLostEvent: THTTPConnectionLostEvent); begin FHttpConnection.OnConnectionLost := AConnectionLostEvent; end; -procedure TRestClient.SetOnError(AErrorEvent: THTTPErrorEvent); +procedure TJsonRestClient.SetOnError(AErrorEvent: THTTPErrorEvent); begin FHttpConnection.OnError := AErrorEvent; end; -function TRestClient.UnWrapConnection: IHttpConnection; +function TJsonRestClient.UnWrapConnection: IHttpConnection; begin Result := FHttpConnection; end; @@ -535,7 +541,7 @@ function TResource.ContentType(ContentType: String): TResource; Result := Self; end; -constructor TResource.Create(RestClient: TRestClient; URL: string); +constructor TResource.Create(RestClient: TJsonRestClient; URL: string); begin inherited Create; FRestClient := RestClient; @@ -636,6 +642,37 @@ function TResource.Post(Entity: TObject): T; Result := Default(T); end; +function TResource.PostJson(data: string; table: string; titles: string): TClientDataSet; +var + vResponse: string; + vJson: ISuperObject; +begin + SetJsonContent(data); + vResponse := FRestClient.DoRequest(METHOD_POST, Self); + Result := CreateDataset(vResponse, table, titles); +end; +function TResource.CreateDataset(data: string; table: string = ''; titles: string = ''): TClientDataSet; +var + vJson: ISuperObject; +begin + vJson := SuperObject.SO(data); + + Result := TJsonToDataSetConverter.CreateDataSetMetadata(vJson, table, titles); + + TJsonToDataSetConverter.ToDataSet(Result, vJson.O[table]); + +end; +function TResource.PostJson(data: string): string; +var + vResponse: string; + vJson: ISuperObject; +begin + SetJsonContent(data); + vResponse := FRestClient.DoRequest(METHOD_POST, Self); + Result := vResponse; +end; + + function TResource.Put(Entity: TObject): T; var vResponse: string; @@ -758,6 +795,19 @@ procedure TResource.SetContent(entity: TObject); end; end; +procedure TResource.SetJsonContent(json: string); +var + vStream: TStringStream; +begin + FContent.Clear; + vStream := TStringStream.Create(json); + try + vStream.Position := 0; + FContent.CopyFrom(vStream, vStream.Size); + finally + vStream.Free; + end; +end; function TResource.Put(Content: TStream): String; begin Content.Position := 0;