使用 Firedac 在 REST 上应用更新
ApplyUpdates on REST with 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 函数时遇到问题
谢谢。
我有类似的问题,我解决了在 ApplyUpdates 之前将 table 名称传递给 Query.UpdateOptions.UpdateTableName。
- 你在里面做吗"CriaQuery"?
- 你的 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;
我的项目使用带有 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 函数时遇到问题
谢谢。
我有类似的问题,我解决了在 ApplyUpdates 之前将 table 名称传递给 Query.UpdateOptions.UpdateTableName。
- 你在里面做吗"CriaQuery"?
- 你的 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;