Y
yyccmm
Unregistered / Unconfirmed
GUEST, unregistred user!
李维D5多层应用系统篇中3-20多表数据更新的例子,过不去,特来此请教还请各位关照!
或给个三层中多表数据更新的例子谢谢!
unit urdmMultiTablesUpdateServer;
interface
uses
Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
DBClient, PMultiTablesUpdateServer_TLB, StdVcl, Provider, DBTables, Db, Dialogs,variants;
type
TMultiTablesUpdateServer = class(TRemoteDataModule, IMultiTablesUpdateServer)
Database1: TDatabase;
quryMultiJoin: TQuery;
usEmployee: TUpdateSQL;
usOrders: TUpdateSQL;
usCustomers: TUpdateSQL;
qUpdateCustomers: TQuery;
qUpdateOrders: TQuery;
qUpdateEmployee: TQuery;
qdEmployee: TQuery;
qdOrder: TQuery;
qdCustomer: TQuery;
dspmultijoins: TDataSetProvider;
procedure dspMultiJoinsBeforeUpdateRecord(Sender: TObject;
SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind;
var Applied: Boolean);
procedure dspMultiJoinsUpdateData(Sender: TObject;
DataSet: TClientDataSet);
procedure dspMultiJoinsUpdateError(Sender: TObject;
DataSet: TClientDataSet; E: EUpdateError; UpdateKind: TUpdateKind;
var Response: TResolverResponse);
procedure RemoteDataModuleCreate(Sender: TObject);
procedure RemoteDataModuleDestroy(Sender: TObject);
procedure dspmultijoins1BeforeUpdateRecord(Sender: TObject;
SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
UpdateKind: TUpdateKind; var Applied: Boolean);
procedure dspmultijoins1UpdateData(Sender: TObject;
DataSet: TCustomClientDataSet);
procedure dspmultijoins1UpdateError(Sender: TObject;
DataSet: TCustomClientDataSet; E: EUpdateError;
UpdateKind: TUpdateKind; var Response: TResolverResponse);
private
{ Private declarations }
procedure SetParams(FUpdateSQL : TUpdateSQL; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
procedure UpdateOrder(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
procedure UpdateCustomer(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
procedure UpdateEmployee(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
procedure AssignFieldValue(DeltaDS: TClientDataSet; aQuery : TQuery; const sField, sID : string);
protected
class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
public
{ Public declarations }
end;
implementation
uses fMultiTablesUpdateServer;
{$R *.DFM}
procedure TMultiTablesUpdateServer.SetParams(FUpdateSQL : TUpdateSQL; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
var
I: Integer;
Old: Boolean;
Param: TParam;
PName: string;
Field: TField;
Value: Variant;
begin
if not Assigned(FUpdateSQL.DataSet) then
Exit;
with FUpdateSQL.Query[UpdateKind] do
begin
for I := 0 to Params.Count - 1 do
begin
Param := Params;
PName := Param.Name;
Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0;
if Old then
System.Delete(PName, 1, 4);
Field := DeltaDS.FindField(PName);
if not Assigned(Field) then
Continue;
if Old then
Param.AssignFieldValue(Field, Field.OldValue)
else
begin
Value := Field.NewValue;
if VarIsEmpty(Value) then
Value := Field.OldValue;
Param.AssignFieldValue(Field, Value);
end;
end;
end;
end;
procedure TMultiTablesUpdateServer.AssignFieldValue(DeltaDS: TClientDataSet; aQuery : TQuery; const sField, sID : string);
var
aField : TField;
Value: Variant;
begin
aField := DeltaDS.FieldByName(sField);
Value := aField.NewValue;
if VarIsEmpty(Value) then
aQuery.ParamByName(sID).Value := aField.OldValue
else
aQuery.ParamByName(sID).Value := Value;
end;
procedure TMultiTablesUpdateServer.UpdateOrder(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
case UpdateKind of
ukModify :
begin
AssignFieldValue(DeltaDS, qUpdateOrders, 'AMOUNTPAID', 'ID1');
qUpdateOrders.ParamByName('ID2').AsFloat := DeltaDS.FieldByName('ORDERNO').OldValue;
qUpdateOrders.ExecSQL;
end;
ukDelete :
begin
qdOrder.ParamByName('ID1').AsFloat := DeltaDS.FieldByName('ORDERNO').AsFloat;
qdOrder.ExecSQL;
end;
end;
end;
procedure TMultiTablesUpdateServer.UpdateCustomer(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
case UpdateKind of
ukModify :
begin
AssignFieldValue(DeltaDS, qUpdateCustomers, 'COMPANY', 'ID1');
AssignFieldValue(DeltaDS, qUpdateCustomers, 'CITY', 'ID2');
AssignFieldValue(DeltaDS, qUpdateCustomers, 'COUNTRY', 'ID3');
qUpdateCustomers.ParamByName('ID4').AsFloat := DeltaDS.FieldByName('CustNo').OldValue;
qUpdateCustomers.ExecSQL;
end;
ukDelete :
begin
qdCustomer.ParamByName('ID1').AsFloat := DeltaDS.FieldByName('CustNo').AsFloat;
qdCustomer.ExecSQL;
end;
end;
end;
procedure TMultiTablesUpdateServer.UpdateEmployee(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
case UpdateKind of
ukModify :
begin
AssignFieldValue(DeltaDS, qUpdateEmployee, 'LASTNAME', 'ID1');
AssignFieldValue(DeltaDS, qUpdateEmployee, 'FIRSTNAME', 'ID2');
AssignFieldValue(DeltaDS, qUpdateEmployee, 'PHONEEXT', 'ID3');
AssignFieldValue(DeltaDS, qUpdateEmployee, 'HIREDATE', 'ID4');
AssignFieldValue(DeltaDS, qUpdateEmployee, 'SALARY', 'ID5');
qUpdateEmployee.ParamByName('ID6').AsInteger := DeltaDS.FieldByName('EMPNO').OldValue;
qUpdateEmployee.ExecSQL;
end;
ukDelete :
begin
qdCustomer.ParamByName('ID1').AsInteger := DeltaDS.FieldByName('EMPNO').AsInteger;
qdCustomer.ExecSQL;
end;
end;
end;
class procedure TMultiTablesUpdateServer.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
if Register then
begin
inherited UpdateRegistry(Register, ClassID, ProgID);
EnableSocketTransport(ClassID);
EnableWebTransport(ClassID);
end else
begin
DisableSocketTransport(ClassID);
DisableWebTransport(ClassID);
inherited UpdateRegistry(Register, ClassID, ProgID);
end;
end;
procedure TMultiTablesUpdateServer.RemoteDataModuleCreate(Sender: TObject);
begin
qUpdateCustomers.Prepare;
qUpdateOrders.Prepare;
qUpdateEmployee.Prepare;
qdCustomer.Prepare;
qdOrder.Prepare;
qdEmployee.Prepare;
end;
procedure TMultiTablesUpdateServer.RemoteDataModuleDestroy(
Sender: TObject);
begin
qUpdateCustomers.UnPrepare;
qUpdateOrders.UnPrepare;
qUpdateEmployee.UnPrepare;
qdCustomer.UnPrepare;
qdOrder.UnPrepare;
qdEmployee.UnPrepare;
end;
procedure TMultiTablesUpdateServer.dspmultijoins1BeforeUpdateRecord(
Sender: TObject; SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
UpdateKind: TUpdateKind; var Applied: Boolean);
begin
quryMultiJoin.UpdateObject := usCustomers;
//************************************************
SetParams(usCustomers, DeltaDS, UpdateKind);
//[Error] urdmMultiTablesUpdateServer.pas(214): Incompatible types: 'TClientDataSet' and 'TCustomClientDataSet'
//*************************************************
usCustomers.ExecSQL(UpdateKind);
quryMultiJoin.UpdateObject := usOrders;
SetParams(usOrders, DeltaDS, UpdateKind);
usOrders.Apply(UpdateKind);
quryMultiJoin.UpdateObject := usEmployee;
SetParams(usEmployee, DeltaDS, UpdateKind);
usEmployee.Apply(UpdateKind);
{ UpdateCustomer(DeltaDS, UpdateKind);
UpdateOrder(DeltaDS, UpdateKind);
UpdateEmployee(DeltaDS, UpdateKind);}
Applied := True;
end;
procedure TMultiTablesUpdateServer.dspmultijoins1UpdateData(
Sender: TObject; DataSet: TCustomClientDataSet);
var
iCount, iCount1 : Integer;
sOld, sNew : string;
begin
Form1.ClientDataSet1.Data := DataSet.Data;
for iCount1 := 0 to DataSet.FieldCount - 1 do
begin
Form1.StringGrid1.Cells[iCount1, 0] := DataSet.Fields[iCount1].FieldName;
end;
for iCount := 0 to DataSet.RecordCount - 1 do
begin
for iCount1 := 0 to DataSet.FieldCount - 1 do
begin
if (not VarIsEmpty(DataSet.Fields[iCount1].OldValue)) then
sOld := VarToStr(DataSet.Fields[iCount1].OldValue)
else
sOld := 'NULL';
if (not VarIsEmpty(DataSet.Fields[iCount1].NewValue)) then
sNew := VarToStr(DataSet.Fields[iCount1].NewValue)
else
sNew := 'NULL';
Form1.StringGrid1.Cells[iCount1, iCount + 1] := sOld + '/' + sNew;
end;
end;
for iCount1 := 0 to DataSet.FieldCount - 1 do
begin
Form1.StringGrid2.Cells[iCount1, 0] := DataSet.Fields[iCount1].FieldName;
end;
for iCount := 0 to DataSet.RecordCount - 1 do
begin
for iCount1 := 0 to DataSet.FieldCount - 1 do
begin
if (pfInUpdate in DataSet.Fields[iCount1].ProviderFlags) then
Form1.StringGrid2.Cells[iCount1, iCount + 1] := Form1.StringGrid2.Cells[iCount1, iCount + 1] + 'pfInUpdate';
if (pfInWhere in DataSet.Fields[iCount1].ProviderFlags) then
Form1.StringGrid2.Cells[iCount1, iCount + 1] := Form1.StringGrid2.Cells[iCount1, iCount + 1] + 'pfInWhere';
if (pfInKey in DataSet.Fields[iCount1].ProviderFlags) then
Form1.StringGrid2.Cells[iCount1, iCount + 1] := Form1.StringGrid2.Cells[iCount1, iCount + 1] + 'pfInKey';
if (pfHidden in DataSet.Fields[iCount1].ProviderFlags) then
Form1.StringGrid2.Cells[iCount1, iCount + 1] := Form1.StringGrid2.Cells[iCount1, iCount + 1] + 'pfHidden';
end;
end;
end;
procedure TMultiTablesUpdateServer.dspmultijoins1UpdateError(
Sender: TObject; DataSet: TCustomClientDataSet; E: EUpdateError;
UpdateKind: TUpdateKind; var Response: TResolverResponse);
begin
ShowMessage(E.Context);
ShowMessage(E.Message);
end;
initialization
TComponentFactory.Create(ComServer, TMultiTablesUpdateServer,
Class_MultiTablesUpdateServer, ciMultiInstance, tmApartment);
end.
或给个三层中多表数据更新的例子谢谢!
unit urdmMultiTablesUpdateServer;
interface
uses
Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
DBClient, PMultiTablesUpdateServer_TLB, StdVcl, Provider, DBTables, Db, Dialogs,variants;
type
TMultiTablesUpdateServer = class(TRemoteDataModule, IMultiTablesUpdateServer)
Database1: TDatabase;
quryMultiJoin: TQuery;
usEmployee: TUpdateSQL;
usOrders: TUpdateSQL;
usCustomers: TUpdateSQL;
qUpdateCustomers: TQuery;
qUpdateOrders: TQuery;
qUpdateEmployee: TQuery;
qdEmployee: TQuery;
qdOrder: TQuery;
qdCustomer: TQuery;
dspmultijoins: TDataSetProvider;
procedure dspMultiJoinsBeforeUpdateRecord(Sender: TObject;
SourceDS: TDataSet; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind;
var Applied: Boolean);
procedure dspMultiJoinsUpdateData(Sender: TObject;
DataSet: TClientDataSet);
procedure dspMultiJoinsUpdateError(Sender: TObject;
DataSet: TClientDataSet; E: EUpdateError; UpdateKind: TUpdateKind;
var Response: TResolverResponse);
procedure RemoteDataModuleCreate(Sender: TObject);
procedure RemoteDataModuleDestroy(Sender: TObject);
procedure dspmultijoins1BeforeUpdateRecord(Sender: TObject;
SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
UpdateKind: TUpdateKind; var Applied: Boolean);
procedure dspmultijoins1UpdateData(Sender: TObject;
DataSet: TCustomClientDataSet);
procedure dspmultijoins1UpdateError(Sender: TObject;
DataSet: TCustomClientDataSet; E: EUpdateError;
UpdateKind: TUpdateKind; var Response: TResolverResponse);
private
{ Private declarations }
procedure SetParams(FUpdateSQL : TUpdateSQL; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
procedure UpdateOrder(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
procedure UpdateCustomer(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
procedure UpdateEmployee(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
procedure AssignFieldValue(DeltaDS: TClientDataSet; aQuery : TQuery; const sField, sID : string);
protected
class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
public
{ Public declarations }
end;
implementation
uses fMultiTablesUpdateServer;
{$R *.DFM}
procedure TMultiTablesUpdateServer.SetParams(FUpdateSQL : TUpdateSQL; DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
var
I: Integer;
Old: Boolean;
Param: TParam;
PName: string;
Field: TField;
Value: Variant;
begin
if not Assigned(FUpdateSQL.DataSet) then
Exit;
with FUpdateSQL.Query[UpdateKind] do
begin
for I := 0 to Params.Count - 1 do
begin
Param := Params;
PName := Param.Name;
Old := CompareText(Copy(PName, 1, 4), 'OLD_') = 0;
if Old then
System.Delete(PName, 1, 4);
Field := DeltaDS.FindField(PName);
if not Assigned(Field) then
Continue;
if Old then
Param.AssignFieldValue(Field, Field.OldValue)
else
begin
Value := Field.NewValue;
if VarIsEmpty(Value) then
Value := Field.OldValue;
Param.AssignFieldValue(Field, Value);
end;
end;
end;
end;
procedure TMultiTablesUpdateServer.AssignFieldValue(DeltaDS: TClientDataSet; aQuery : TQuery; const sField, sID : string);
var
aField : TField;
Value: Variant;
begin
aField := DeltaDS.FieldByName(sField);
Value := aField.NewValue;
if VarIsEmpty(Value) then
aQuery.ParamByName(sID).Value := aField.OldValue
else
aQuery.ParamByName(sID).Value := Value;
end;
procedure TMultiTablesUpdateServer.UpdateOrder(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
case UpdateKind of
ukModify :
begin
AssignFieldValue(DeltaDS, qUpdateOrders, 'AMOUNTPAID', 'ID1');
qUpdateOrders.ParamByName('ID2').AsFloat := DeltaDS.FieldByName('ORDERNO').OldValue;
qUpdateOrders.ExecSQL;
end;
ukDelete :
begin
qdOrder.ParamByName('ID1').AsFloat := DeltaDS.FieldByName('ORDERNO').AsFloat;
qdOrder.ExecSQL;
end;
end;
end;
procedure TMultiTablesUpdateServer.UpdateCustomer(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
case UpdateKind of
ukModify :
begin
AssignFieldValue(DeltaDS, qUpdateCustomers, 'COMPANY', 'ID1');
AssignFieldValue(DeltaDS, qUpdateCustomers, 'CITY', 'ID2');
AssignFieldValue(DeltaDS, qUpdateCustomers, 'COUNTRY', 'ID3');
qUpdateCustomers.ParamByName('ID4').AsFloat := DeltaDS.FieldByName('CustNo').OldValue;
qUpdateCustomers.ExecSQL;
end;
ukDelete :
begin
qdCustomer.ParamByName('ID1').AsFloat := DeltaDS.FieldByName('CustNo').AsFloat;
qdCustomer.ExecSQL;
end;
end;
end;
procedure TMultiTablesUpdateServer.UpdateEmployee(DeltaDS: TClientDataSet; UpdateKind: TUpdateKind);
begin
case UpdateKind of
ukModify :
begin
AssignFieldValue(DeltaDS, qUpdateEmployee, 'LASTNAME', 'ID1');
AssignFieldValue(DeltaDS, qUpdateEmployee, 'FIRSTNAME', 'ID2');
AssignFieldValue(DeltaDS, qUpdateEmployee, 'PHONEEXT', 'ID3');
AssignFieldValue(DeltaDS, qUpdateEmployee, 'HIREDATE', 'ID4');
AssignFieldValue(DeltaDS, qUpdateEmployee, 'SALARY', 'ID5');
qUpdateEmployee.ParamByName('ID6').AsInteger := DeltaDS.FieldByName('EMPNO').OldValue;
qUpdateEmployee.ExecSQL;
end;
ukDelete :
begin
qdCustomer.ParamByName('ID1').AsInteger := DeltaDS.FieldByName('EMPNO').AsInteger;
qdCustomer.ExecSQL;
end;
end;
end;
class procedure TMultiTablesUpdateServer.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
if Register then
begin
inherited UpdateRegistry(Register, ClassID, ProgID);
EnableSocketTransport(ClassID);
EnableWebTransport(ClassID);
end else
begin
DisableSocketTransport(ClassID);
DisableWebTransport(ClassID);
inherited UpdateRegistry(Register, ClassID, ProgID);
end;
end;
procedure TMultiTablesUpdateServer.RemoteDataModuleCreate(Sender: TObject);
begin
qUpdateCustomers.Prepare;
qUpdateOrders.Prepare;
qUpdateEmployee.Prepare;
qdCustomer.Prepare;
qdOrder.Prepare;
qdEmployee.Prepare;
end;
procedure TMultiTablesUpdateServer.RemoteDataModuleDestroy(
Sender: TObject);
begin
qUpdateCustomers.UnPrepare;
qUpdateOrders.UnPrepare;
qUpdateEmployee.UnPrepare;
qdCustomer.UnPrepare;
qdOrder.UnPrepare;
qdEmployee.UnPrepare;
end;
procedure TMultiTablesUpdateServer.dspmultijoins1BeforeUpdateRecord(
Sender: TObject; SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
UpdateKind: TUpdateKind; var Applied: Boolean);
begin
quryMultiJoin.UpdateObject := usCustomers;
//************************************************
SetParams(usCustomers, DeltaDS, UpdateKind);
//[Error] urdmMultiTablesUpdateServer.pas(214): Incompatible types: 'TClientDataSet' and 'TCustomClientDataSet'
//*************************************************
usCustomers.ExecSQL(UpdateKind);
quryMultiJoin.UpdateObject := usOrders;
SetParams(usOrders, DeltaDS, UpdateKind);
usOrders.Apply(UpdateKind);
quryMultiJoin.UpdateObject := usEmployee;
SetParams(usEmployee, DeltaDS, UpdateKind);
usEmployee.Apply(UpdateKind);
{ UpdateCustomer(DeltaDS, UpdateKind);
UpdateOrder(DeltaDS, UpdateKind);
UpdateEmployee(DeltaDS, UpdateKind);}
Applied := True;
end;
procedure TMultiTablesUpdateServer.dspmultijoins1UpdateData(
Sender: TObject; DataSet: TCustomClientDataSet);
var
iCount, iCount1 : Integer;
sOld, sNew : string;
begin
Form1.ClientDataSet1.Data := DataSet.Data;
for iCount1 := 0 to DataSet.FieldCount - 1 do
begin
Form1.StringGrid1.Cells[iCount1, 0] := DataSet.Fields[iCount1].FieldName;
end;
for iCount := 0 to DataSet.RecordCount - 1 do
begin
for iCount1 := 0 to DataSet.FieldCount - 1 do
begin
if (not VarIsEmpty(DataSet.Fields[iCount1].OldValue)) then
sOld := VarToStr(DataSet.Fields[iCount1].OldValue)
else
sOld := 'NULL';
if (not VarIsEmpty(DataSet.Fields[iCount1].NewValue)) then
sNew := VarToStr(DataSet.Fields[iCount1].NewValue)
else
sNew := 'NULL';
Form1.StringGrid1.Cells[iCount1, iCount + 1] := sOld + '/' + sNew;
end;
end;
for iCount1 := 0 to DataSet.FieldCount - 1 do
begin
Form1.StringGrid2.Cells[iCount1, 0] := DataSet.Fields[iCount1].FieldName;
end;
for iCount := 0 to DataSet.RecordCount - 1 do
begin
for iCount1 := 0 to DataSet.FieldCount - 1 do
begin
if (pfInUpdate in DataSet.Fields[iCount1].ProviderFlags) then
Form1.StringGrid2.Cells[iCount1, iCount + 1] := Form1.StringGrid2.Cells[iCount1, iCount + 1] + 'pfInUpdate';
if (pfInWhere in DataSet.Fields[iCount1].ProviderFlags) then
Form1.StringGrid2.Cells[iCount1, iCount + 1] := Form1.StringGrid2.Cells[iCount1, iCount + 1] + 'pfInWhere';
if (pfInKey in DataSet.Fields[iCount1].ProviderFlags) then
Form1.StringGrid2.Cells[iCount1, iCount + 1] := Form1.StringGrid2.Cells[iCount1, iCount + 1] + 'pfInKey';
if (pfHidden in DataSet.Fields[iCount1].ProviderFlags) then
Form1.StringGrid2.Cells[iCount1, iCount + 1] := Form1.StringGrid2.Cells[iCount1, iCount + 1] + 'pfHidden';
end;
end;
end;
procedure TMultiTablesUpdateServer.dspmultijoins1UpdateError(
Sender: TObject; DataSet: TCustomClientDataSet; E: EUpdateError;
UpdateKind: TUpdateKind; var Response: TResolverResponse);
begin
ShowMessage(E.Context);
ShowMessage(E.Message);
end;
initialization
TComponentFactory.Create(ComServer, TMultiTablesUpdateServer,
Class_MultiTablesUpdateServer, ciMultiInstance, tmApartment);
end.