使用Firedac在REST上使用ApplyUpdates

时间:2015-07-01 13:44:15

标签: json rest delphi datasnap firedac

我的项目使用带有FireDac的REST服务器。

我有一个泛型函数可以生成所有选择但是当我尝试ApplyUpdates时如果没有。没有消息,没有崩溃,只是继续前进,数据没有反映到数据库中。

我的代码:

function TServerMethods.ApplyUpdates(banco, tabela : String; const DeltaList: TFDJSONDeltas; var Mensagem : String) : Boolean; 
var 
  LApply : IFDJSONDeltasApplyUpdates; 
  Query : TFDQuery; 
begin 
  mensagem := ''; 
  result := false; 
  try 
    try 
      LApply := TFDJSONDeltasApplyUpdates.Create(DeltaList); 
      Query := CriaQuery(banco,Tabela); 
      Query.Open(); 
      LApply.ApplyUpdates(banco + '.' + tabela, Query.Command); 
      if LApply.Errors.Count > 0 then 
        raise Exception.Create(LApply.Errors.Strings.ToString); 
      result := true; 
    except 
      on E:Exception do 
      begin 
        mensagem := 'Ocorreu um Erro na atualização: ' + #13#10 + E.Message; 
      end; 
    end; 
  finally 

  end; 

end; 

GetDeltas函数(生成DeltaList的函数):

function GetDeltas(Banco, Tabela : String; MemTable : TFDMemTable) : TFDJSONDeltas;
begin
  if MemTable.State in [dsInsert, dsEdit] then
    MemTable.Post;
  result := TFDJSONDeltas.Create;
  TFDJSONDeltasWriter.ListAdd(result, MemTable);
end;

我的“CriaQuery”功能:

function TServerMethods.CriaQuery(Database : String; Tabela : String = '') : TFDQuery;
var
  FieldName : Boolean;
  i : Integer;
begin
  result := TFDQuery.Create(self);
  result.Connection := Connection;
  result.FetchOptions.AutoFetchAll := afAll;
  result.name := 'Qry' + Database + tabela;
  result.SQL.Clear;
  FieldName := false;
  if Trim(Tabela) <> '' then
  begin
    result.SQL := MontaSQL(database + '.' + tabela);
    result.SQL.Add(' and 1 = 0');
    result.Open();
    QryCampos.First;
    result.IndexFieldNames := result.Fields[1].FieldName;
    for i := 0 to result.Fields.Count-1 do
    begin
      if (UPPERCASE(Copy(result.Fields[i].FieldName, Length(result.Fields[i].FieldName)-1,2)) = 'ID') and
         (not FieldName) then
      begin
        result.Fields[i].ProviderFlags := [pfInUpdate, pfInWhere, pfInKey];
        FieldName := true;
      end
      else
        result.Fields[i].ProviderFlags := [pfInUpdate];
    end;
    result.Close;
    result.SQL.Delete(result.SQL.Count-1);
  end;
end;

生成组件绑定的函数:

procedure LinkaComponente(Campo : TField; Dono : TFmxObject; Classe : String);
var
  BindSource : TBindSourceDB;
  BindingList : TBindingsList;
  Link : TLinkControlToField;
begin
  if Dono is TForm then
  begin
    BindSource := TBindSourceDB.Create(Dono);
  end
  else
  begin
    BindSource := TBindSourceDB.Create(Dono.Owner);
  end;
  BindingList := TBindingsList.Create(BindSource.Owner);
  Link := TLinkControlToField.Create(BindSource.Owner);
  BindSource.DataSet := Campo.DataSet;

  if Classe = 'TCheckBox' then
  begin
    Link.Control := Dono.FindComponent(Campo.FieldName);
    Link.CustomFormat := 'ToStr(%s) <> "N"';
    Link.CustomParse  := 'IfThen(%s,"S","N")';
  end
  else if Classe = 'TFrameF2' then
  begin
    Link.Control := (Dono.FindComponent('Frame' + Campo.FieldName) as TFrameF2).edtFK;
  end
  else
    Link.Control := Dono.FindComponent(Campo.FieldName);
  Link.DataSource := BindSource;
  Link.FieldName := Campo.FieldName;
  Link.Active := true;
end;

我调用applyUpdates函数的那一刻:

procedure TDMPadrao.DMApplyUpdates;
var
  Deltas : TFDJSONDeltas;
  Mensagem : String;
begin
  //repetir esses comando para todas as MemTables do DM na sua ordem de dependencia
  //       tabelas pai antes de tabelas filhas...
  try
    Deltas := GetDeltas(banco, tabela, FDMemTable);
  except
    on E:Exception do
    begin
      FDMemTable.Edit;
      MostraMensagemBasica('Ocorreu um Erro na atualização:' + #13#10 + E.Message);
      abort;
    end;
  end;
  if not DMClient.ServerMethodsClient.ApplyUpdates(banco, tabela, Deltas, Mensagem) then
  begin
    FDMemTable.Edit;
    MostraMensagemBasica(Mensagem);
    abort;
  end;
end;

我读书时一切正常。我只是在调用ApplyUpdates函数时遇到问题

感谢。

1 个答案:

答案 0 :(得分:1)

我遇到了类似的问题,我解决了在ApplyUpdates之前将表名传递给Query.UpdateOptions.UpdateTableName。

  • 你在里面做什么&#34; CriaQuery&#34;?
  • 您的Delphi版本是什么?

这是我的工作代码,我在Delphi XE7 e XE7 Update 1中进行了测试:

procedure TDBDM.ApplyDeltas(const ADeltaList: TFDJSONDeltas; const TableName: string);
var
  JSONDeltas: IFDJSONDeltasApplyUpdates;
  Query: TFDQuery;
begin
  JSONDeltas := TFDJSONDeltasApplyUpdates.Create(ADeltaList);
  Query := CreateQuery(TableName);
  try
    Query.UpdateOptions.UpdateTableName := TableName;
    JSONDeltas.ApplyUpdates(0, Query.Command);

    if JSONDeltas.Errors.Count > 0 then
    begin
      raise Exception.Create(JSONDeltas.Errors.Strings.Text);
    end;
  finally
    Query.Free;
  end;
end;

备注

  • 与您的代码不同,不会调用Query.Open。​​
  • TFDMemTable.CachedUpdates 必须为 True

编辑:添加了客户端代码以applyUpdates

我在TFDMemTable.AfterPost事件中调用此方法。

    const
      CustomerTableName = 'CUSTOMER';

    procedure TCustomersDataModuleClient.ApplyUpdates;
    var
      Deltas: TFDJSONDeltas;
    begin
      Deltas := TFDJSONDeltas.Create;
      TFDJSONDeltasWriter.ListAdd(Deltas, CustomerTableName, CustomersMemTable);
      RestClientModule.CustomersMethodsClient.ApplyUpdates(Deltas);
      CustomersMemTable.CommitUpdates;
    end;