Rafael Pasa

Nesse artigo vou mostrar como é fácil transformar dados recebidos via JSON e inseri-los em um ClientDatSet. Vale ressaltar que o JSON que vamos tratar não é um JSON gerado pelo Delphi, o que seria muito mais fácil de fazer usando a classe TJsonMarschal eTJsonUnMarschal.
Para Começar vamos criar um projeto novo “DataSnap REST Application”
Nas opções que seguem escola “VCL Stand-alone Application” avance, escolha uma porta valida (8080 por padrão, mas pode mudar se quiser) avance de novo, na tela seguinte deixe como está e avance novamente, marque a opção TDSServerModule, e por ultimo defina onde vai salvar o projeto.
Agora vamos codificar o projeto, na “ServerMethodsUnit1” declare os seguintes métodos

  TServerMethods1 = class(TDSServerModule)
    cdsEmpresa: TClientDataSet;
  private
    { Private declarations }
    procedure JsonParaCds(_ACds: TClientDataSet; _AJson: TJSONValue);
    function CdsParaJson(_ACds: TClientDataSet): TJSONArray;
  public
    { Public declarations }
    procedure InserirRegistro(_AJson: TJSONValue);
    function BuscarRegistros: TJSONArray;
  end;

Dentro do Server Modulo adicione um ClientDatSet, de o nome a ele de cdsEmpresa e associe a tabela customer das base de exemplos em que vem junto como delphi, geralmente está no caminho “c:\Program Files (x86)\Common Files\CodeGear Shared\Data\customer.xml”. Adicione todos os fileds no Fields Editor do Client.
Agora vamos codificar a mágica. De um Ctrl+Shift+C na classe para gerar a implementação do método.
Primeiro o método InserirRegistro que vai receber o Json com as informações que devem ser gravadas no XML.
Claro que poderia ser feito uma base em firebird pra salvar os dados, mas assim é mais simples.

procedure TServerMethods1.InserirRegistro(_AJson: TJSONValue);
begin
  cdsEmpresa.Insert;
  JsonParaCds(cdsEmpresa, _AJson);
  cdsEmpresa.Post;
  cdsEmpresa.SaveToFile('C:\customer.xml', dfXML); // salva um arquivo xml
end;

Agora o método que joga o json para o ClientDataSet

procedure TServerMethods1.JsonParaCds(_ACds: TClientDataSet; _AJson: TJSONValue);
var
  AJsonObject, AJsonSubObj: TJSONObject;
  AJsonPair, AJsonSubPair: TJSONPair;
  AJsonArray: TJSONArray;
  J, I: Integer;
  AField: TField;
begin
  AJsonObject := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(_AJson.ToString), 0) as TJSONObject;
  AJsonPair := AJsonObject.Get(0);
  AJsonArray := (AJsonPair.JsonValue as TJSONArray);
  for I := 0 to AJsonArray.Size - 1 do
  begin
    AJsonSubObj := TJSONObject(AJsonArray.Get(I));
    for J := 0 to AJsonSubObj.Size - 1 do
    begin
      AJsonSubPair := AJsonSubObj.Get(J);
      AField := _ACds.FindField(AJsonSubPair.JsonString.Value);
      if Assigned(AField) then
        AField.Value := AJsonSubPair.JsonValue.Value;
    end;
  end;
end;

Vamos ao método que BuscarRegistros

function TServerMethods1.BuscarRegistros: TJSONArray;
begin
  if not cdsEmpresa.Active then
    cdsEmpresa.CreateDataSet;
  Result := CdsParaJson(cdsEmpresa);
end;

E por ultimo e não menos importante o método que converte o CDS para um Json

function TServerMethods1.CdsParaJson(_ACds: TClientDataSet): TJSONArray;
var
  AJsonObject: TJSONObject;
  I: Integer;
begin
  Result := TJSONArray.Create;
  _ACds.First;
  while not _ACds.Eof do
  begin
    AJsonObject := TJSONObject.Create;
    for I := 0 to _ACds.FieldCount - 1 do
    begin
      AJsonObject.AddPair(_ACds.Fields[I].FieldName, _ACds.Fields[I].AsString);
    end;
    Result.AddElement(AJsonObject);
    _ACds.Next;
  end;
end;

Para testar o codigo execute o servidor.
Clic em Start;
Clic em OpenBrowser
Na pagina que se abre clique em Server Functions;
Expanda o botão a esquerda de “TServerMethods1″
Depois expanda o botão a esquerda de “BuscarRegistros” e clic em executar;
Após isso deve vir varios registros em formato Json no rodapé da pagina. esse são os dados que estão no clientDatSet;

Para inserir um registro expanda o botão a esquerda de “InserirRegistro”;
Coloque a seguinte linha no campo que aparece

{"result":[{"CustNo":"98989898","Company":"Rafael Pasa","Addr1":"Av Brasil","Addr2":"951","City":"Maravilha ","State":"SC","Zip":"94766-1234","Country":"BR","Phone":"808-555-0269","FAX":"808-555-0278","TaxRate":"8,5","Contact":"Rafael Pasa","LastInvoiceDate":"02/02/1995 01:05:03"}]}

E clic em executar
Depois abra o arquivo “c:\customer.xml” e procure por Rafael Pasa veras que foi inserido no client e salvo no XML.

Segue abaixo o fonte completo.
rafaelpasa.com.br/JsonToCDS.zip

Abraço

Em um de meus projetos tive uma necessidade de alimentar uma classe com informações de um clientDataSet, o projeto tinha uma interface do tipo WebService, assim um enviava um objeto do tip VO(Value Object) para o webService e quem consumia o serviço, teria a classe pronta. Só que teria que fazer isso para centenas de Client, então implementei um recuso de exportação e importação entre client e oobjeto.

Para isso se fez necessário a classe ter os mesmo nomes dos campos do client, não precisa ter todos somente os que fossem iguais seria exportados e importados.

Função que recebe um Tfields assim não ficamos limitado a TClientDataSet e também recebe o Objeto que qeremos alimentar. Veja o Código

procedure DataSetParaObjeto(const _AFields: TFields; _AObj: TObject);
var
  PropList: PPropList;
  PropListCount: byte;
  I: integer;
  AField: TField;
begin
  PropListCount := GetPropList(_AObj, PropList);
  for I := 0 to pred(PropListCount) do
  begin
    AField := _AFields.FindField(string(PropList[I].Name));
    if Assigned(AField) then
    begin
      if not _AFields.FieldByName(string(PropList[I].Name)).IsNull then
        SetPropValue(_AObj, string(PropList[I].Name), _AFields.FieldByName(string(PropList[I].Name)).AsVariant);
    end;
  end;
end;

E para fazer o contrario segue a função abaixo

procedure ObjetoParaDataSet(var _ADataSet: TDataSet; _AObj: TObject);
var
  PropList: PPropList;
  PropListCount: byte;
  I: integer;
AField: TField;
begin
  _ADataSet.Insert;
  PropListCount := GetPropList(_AObj, PropList);
  for I := 0 to pred(PropListCount) do
  begin
     AField := _AFields.FindField(string(PropList[I].Name));
     if Assigned(AField) then
      _ADataSet.FieldByName(string(PropList[I].Name)).Value := GetPropValue(_AObj, string(PropList[I].Name));
  end;
  _ADataSet.Post;
end;

Para facilitar mais ainda fiz um expert para o delphi que gera uma unit com a classe.
Assim não preciso escrever a classe VO.
Mas esse expert publico em outro post.

Depois de ler os post do Andreano Lanusse e  do Wiliam Zonta onde inclusive comentei os post, percebi que o método disponibilizado por ambos só permitia puiblicar classes e não ServerModules, ou seja, não tinha como disponibilizar um DataSetProvider para a aplicação cliente.

Com umas pequenas alterações no código de ambos, construimos o seguinte código que permite publicar metodos de uma classe e DataSetProviders de um ServerModule.

Vamos ao que imteressa:

Primeiro criamos uma nova classe herdada de TDsServerClass

Type
TmDsServerClass = class(TDSServerClass)
private
FPersistentClass: TPersistentClass;
FAdapter: Boolean;
procedure DSServerClassGetClass(_ADSServerClass: TDSServerClass;
         var _APersistentClass: TPersistentClass);
protected
function GetDSClass: TDSClass; override;
public
constructor Create(_AOwner: TComponent; _AServer: TDSCustomServer;
     _AClass: TPersistentClass; _ALifeCycle: String;
     _AAdapter: Boolean); reintroduce; overload;
end;

Repare o parametro “_AAdapter” é esse que diferencia se vamos ou não vamos publicar um DataSetProvider.
Agora declaramos a função que será chamada para fazer o registro:

procedure RegisterServerClasses(_AOwner: TComponent; _AServer: TDSServer; _AClass:   TPersistentClass; _ALifeCycle: String; _AAdapter: Boolean = True);

Agora implementamos cada metodo

constructor

constructor TmDsServerClass.Create(_AOwner: TComponent; _AServer: TDSCustomServer; _AClass: TPersistentClass; _ALifeCycle: String; _AAdapter: Boolean);
begin
  inherited Create(_AOwner);
  FPersistentClass := _AClass;
  Self.Server := _AServer;
  Self.LifeCycle := _ALifeCycle;
  FAdapter := _AAdapter;
  OnGetClass := DSServerClassGetClass;
end;

DSServerClassGetClass

procedure TmDsServerClass.DSServerClassGetClass(_ADSServerClass: TDSServerClass; var _APersistentClass: TPersistentClass);
begin
  _APersistentClass := FPersistentClass;
end;

Agora o metodo chave
GetDSClass

function TmDsServerClass.GetDSClass: TDSClass;
begin
  Result := TDSClass.Create(FPersistentClass, FAdapter);
  if FAdapter then
    Result := TDSClass.Create(TDSProviderDataModuleAdapter, Result)
end;

procedure RegisterServerClasses(_AOwner: TComponent; _AServer: TDSServer; _AClass: TPersistentClass; _ALifeCycle: String; _AAdapter: Boolean = True);
begin
  Assert(_AServer.Started = false, 'Não é possível adicionar classes com o servidor ativo');
  TmDsServerClass.Create(_AOwner, _AServer, _AClass, _ALifeCycle, _AAdapter);
end;

Agora basta chamar a função RegisterServerClasses
Lembrando que antes de registrar as classes deve-se para o servidor.
O correto é deixar o AutoStart do DsServer = False e depois de registrar ´chmara o metodo Start do DsServer;
Segueo código abaixo da chamada do metodo RegisterServerClasses

  // Classe que tera seus DataSetProviders Publicados
  RegisterServerClasses(Self, DSServer, TServermodule1, TDSLifeCycle.Session, True);
// Classe que tem apenas metodos e não publica nenhum datasetProviders
  RegisterServerClasses(Self, DSServer, TMinhaCLasse, TDSLifeCycle.Session, false);
  DSServer.Start;

É importante deichar claro que se a classe TMinhaClasse, não for descendente de TServerModule, e o parametro _AAdapter for passado como true, não tera seus metodos publicados.