urdmmultitablesupdateserver.pas

delphi多层应用系统 delphi多层应用系统

unit urdmMultiTablesUpdateServer;

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom, DataBkr,
  DBClient, PMultiTablesUpdateServer_TLB, StdVcl, Provider, DBTables, Db, Dialogs;

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);
  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[I];
      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.dspMultiJoinsBeforeUpdateRecord(
  Sender: TObject; SourceDS: TDataSet; DeltaDS: TClientDataSet;
  UpdateKind: TUpdateKind; var Applied: Boolean);
begin
  quryMultiJoin.UpdateObject := usCustomers;
  SetParams(usCustomers, DeltaDS, UpdateKind);
  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.dspMultiJoinsUpdateData(Sender: TObject;
  DataSet: TClientDataSet);
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.dspMultiJoinsUpdateError(
  Sender: TObject; DataSet: TClientDataSet; E: EUpdateError;
  UpdateKind: TUpdateKind; var Response: TResolverResponse);
begin
  ShowMessage(E.Context);
  ShowMessage(E.Message);
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;

initialization
  TComponentFactory.Create(ComServer, TMultiTablesUpdateServer,
    Class_MultiTablesUpdateServer, ciMultiInstance, tmApartment);
end.