Chapter 14 - Project CdsDelta |
Project Structure
| CdsDelta.dpr |
program CdsDelta;
uses
Forms,
CdsDeltaForm in 'CdsDeltaForm.pas' ,
CdsDeltaDm in 'CdsDeltaDm.pas' ,
Reconc in 'Reconc.pas' ;
begin
Application.Initialize;
Application.CreateForm(TDmCds, DmCds);
Application.CreateForm(TFormCds, FormCds);
Application.Run;
end.
| CdsDeltaForm.pas |
unit CdsDeltaForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBClient, Grids, DBGrids, StdCtrls, ExtCtrls, ComCtrls, MConnect,
MidasCon;
type
TFormCds = class(TForm)
DataSource1: TDataSource;
Panel1: TPanel;
ButtonUpdate: TButton;
ButtonDelta: TButton;
ButtonUndo: TButton;
PageControl1: TPageControl;
TabSheetData: TTabSheet;
TabSheetDelta: TTabSheet;
DBGrid2: TDBGrid;
DataSource2: TDataSource;
DBGrid1: TDBGrid;
procedure ButtonUpdateClick(Sender: TObject);
procedure ButtonDeltaClick(Sender: TObject);
procedure ButtonUndoClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure PageControl1Change(Sender: TObject);
private
public
end;
var
FormCds: TFormCds;
implementation
uses
TypInfo, Reconc, CdsDeltaDm;
procedure TFormCds.ButtonUpdateClick(Sender: TObject);
begin
DmCds.cdsEmployee.ApplyUpdates (-1);
PageControl1.ActivePage := TabSheetData;
TabSheetDelta.TabVisible := False;
end;
procedure TFormCds.ButtonDeltaClick(Sender: TObject);
begin
if DmCds.cdsEmployee.ChangeCount > 0 then
begin
DmCds.cdsDelta.Data := DmCds.cdsEmployee.Delta;
DmCds.cdsDelta.Open;
TabSheetDelta.TabVisible := True;
PageControl1.ActivePage := TabSheetDelta;
end
else
begin
TabSheetDelta.TabVisible := False;
ShowMessage ('No udpates in log');
end;
end;
procedure TFormCds.ButtonUndoClick(Sender: TObject);
begin
DmCds.cdsEmployee.UndoLastChange (True);
end;
procedure TFormCds.FormCreate(Sender: TObject);
begin
DmCds.cdsEmployee.Open;
TabSheetDelta.TabVisible := False;
end;
procedure TFormCds.PageControl1Change(Sender: TObject);
begin
if PageControl1.ActivePage = TabSheetDelta then
if DmCds.cdsEmployee.ChangeCount > 0 then
DmCds.cdsDelta.Data := DmCds.cdsEmployee.Delta
else
begin
TabSheetDelta.TabVisible := False;
PageControl1.ActivePage := TabSheetData;
end;
end;
end.
| CdsDeltaDm.pas |
unit CdsDeltaDm;
interface
uses
SysUtils, Classes, FMTBcd, DBXpress, DB, SqlExpr, DBClient, Provider;
type
TDmCds = class(TDataModule)
cdsEmployee: TClientDataSet;
cdsDelta: TClientDataSet;
SQLConnection: TSQLConnection;
EmplData: TSQLDataSet;
EmplProvider: TDataSetProvider;
cdsDeltaStatus: TStringField;
cdsEmployeeStatus: TStringField;
cdsEmployeeDEPT_NO: TStringField;
cdsEmployeeEMP_NO: TSmallintField;
cdsEmployeeFIRST_NAME: TStringField;
cdsEmployeeLAST_NAME: TStringField;
cdsEmployeeSALARY: TBCDField;
cdsEmployeePHONE_EXT: TStringField;
cdsDeltaDEPT_NO: TStringField;
cdsDeltaEMP_NO: TSmallintField;
cdsDeltaFIRST_NAME: TStringField;
cdsDeltaLAST_NAME: TStringField;
cdsDeltaSALARY: TBCDField;
cdsDeltaPHONE_EXT: TStringField;
procedure CalcStatusField(DataSet: TDataSet);
procedure cdsEmployeeReconcileError(DataSet: TCustomClientDataSet;
E: EReconcileError; UpdateKind: TUpdateKind;
var Action: TReconcileAction);
private
public
end;
var
DmCds: TDmCds;
implementation
uses
TypInfo, Reconc;
procedure TDmCds.CalcStatusField(DataSet: TDataSet);
begin
DataSet.FieldByName('Status').AsString :=
GetEnumName (TypeInfo(TUpdateStatus),
Integer ((DataSet as TClientDataSet).UpdateStatus));
end;
procedure TDmCds.cdsEmployeeReconcileError(
DataSet: TCustomClientDataSet; E: EReconcileError;
UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
Action := HandleReconcileError(DataSet, UpdateKind, E);
end;
end.
| Reconc.pas |
unit Reconc;
interface
uses
SysUtils, Windows, Variants, Messages, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, DB, DBClient, Provider, ExtCtrls;
const
ActionStr: array[TReconcileAction] of string = ('Skip', 'Abort', 'Merge',
'Correct', 'Cancel', 'Refresh');
UpdateKindStr: array[TUpdateKind] of string = ('Modified', 'Inserted',
'Deleted');
SCaption = 'Update Error - %s';
SUnchanged = '<Unchanged>';
SBinary = '(Binary)';
SFieldName = 'Field Name';
SOriginal = 'Original Value';
SConflict = 'Conflicting Value';
SValue = ' Value';
SNoData = '<No Records>';
SNew = 'New';
type
TReconcileErrorForm = class(TForm)
UpdateType: TLabel;
UpdateData: TStringGrid;
ActionGroup: TRadioGroup;
CancelBtn: TButton;
OKBtn: TButton;
ConflictsOnly: TCheckBox;
IconImage: TImage;
ErrorMsg: TMemo;
ChangedOnly: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure UpdateDataSetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: string);
procedure DisplayFieldValues(Sender: TObject);
procedure UpdateDataSelectCell(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
private
FDataSet: TDataSet;
FError: EReconcileError;
FUpdateKind: TUpdateKind;
FDataFields: TList;
FCurColIdx: Integer;
FNewColIdx: Integer;
FOldColIdx: Integer;
procedure AdjustColumnWidths;
procedure InitDataFields;
procedure InitUpdateData(HasCurValues: Boolean);
procedure InitReconcileActions;
procedure SetFieldValues(DataSet: TDataSet);
public
constructor CreateForm(DataSet: TDataSet; UpdateKind: TUpdateKind;
Error: EReconcileError);
end;
function HandleReconcileError(DataSet: TDataSet; UpdateKind: TUpdateKind;
ReconcileError: EReconcileError): TReconcileAction;
implementation
type
PFieldData = ^TFieldData;
TFieldData = record
Field: TField;
NewValue: string;
OldValue: string;
CurValue: string;
EditValue: string;
Edited: Boolean;
end;
function HandleReconcileError(DataSet: TDataSet; UpdateKind: TUpdateKind;
ReconcileError: EReconcileError): TReconcileAction;
var
UpdateForm: TReconcileErrorForm;
begin
UpdateForm := TReconcileErrorForm.CreateForm(DataSet, UpdateKind, ReconcileError);
with UpdateForm do
try
if ShowModal = mrOK then
begin
Result := TReconcileAction(ActionGroup.Items.Objects[ActionGroup.ItemIndex]);
if Result = raCorrect then SetFieldValues(DataSet);
end else
Result := raAbort;
finally
Free;
end;
end;
function VarToString(V: Variant; DataType: TFieldType): string;
const
BinaryDataTypes: set of TFieldType = [ftBytes, ftVarBytes, ftBlob,
ftGraphic..ftCursor];
begin
try
if VarIsClear(V) then
Result := SUnchanged
else if DataType in BinaryDataTypes then
Result := SBinary
else
Result := VarToStr(V);
except
on E: Exception do
Result := E.Message;
end;
end;
constructor TReconcileErrorForm.CreateForm(DataSet: TDataSet;
UpdateKind: TUpdateKind; Error: EReconcileError);
begin
FDataSet := DataSet;
FUpdateKind := UpdateKind;
FError := Error;
inherited Create(Application);
end;
procedure TReconcileErrorForm.InitDataFields;
var
I: Integer;
FD: PFieldData;
V: Variant;
HasCurValues: Boolean;
begin
HasCurValues := False;
for I := 0 to FDataSet.FieldCount - 1 do
with FDataset.Fields[I] do
begin
if (FieldKind <> fkData) then Continue;
FD := New(PFieldData);
try
FD.Field := FDataset.Fields[I];
FD.Edited := False;
if FUpdateKind <> ukDelete then
FD.NewValue := VarToString(NewValue, DataType);
V := CurValue;
if not VarIsClear(V) then HasCurValues := True;
FD.CurValue := VarToString(CurValue, DataType);
if FUpdateKind <> ukInsert then
FD.OldValue := VarToString(OldValue, DataType);
FDataFields.Add(FD);
except
Dispose(FD);
raise;
end;
end;
InitUpdateData(HasCurValues);
end;
procedure TReconcileErrorForm.InitUpdateData(HasCurValues: Boolean);
var
FColCount: Integer;
begin
FColCount := 1;
UpdateData.ColCount := 4;
UpdateData.Cells[0,0] := SFieldName;
if FUpdateKind <> ukDelete then
begin
FNewColIdx := FColCount;
Inc(FColCount);
UpdateData.Cells[FNewColIdx,0] := UpdateKindStr[FUpdateKind] + SValue;
end else
begin
FOldColIdx := FColCount;
Inc(FColCount);
UpdateData.Cells[FOldColIdx,0] := SOriginal;
end;
if HasCurValues then
begin
FCurColIdx := FColCount;
Inc(FColCount);
UpdateData.Cells[FCurColIdx,0] := SConflict;
end;
if FUpdateKind = ukModify then
begin
FOldColIdx := FColCount;
Inc(FColCount);
UpdateData.Cells[FOldColIdx,0] := SOriginal;
end;
UpdateData.ColCount := FColCount;
end;
procedure TReconcileErrorForm.InitReconcileActions;
procedure AddAction(Action: TReconcileAction);
begin
ActionGroup.Items.AddObject(ActionStr[Action], TObject(Action));
end;
begin
AddAction(raSkip);
AddAction(raCancel);
AddAction(raCorrect);
if FCurColIdx > 0 then
begin
AddAction(raRefresh);
AddAction(raMerge);
end;
ActionGroup.ItemIndex := 0;
end;
procedure TReconcileErrorForm.DisplayFieldValues(Sender: TObject);
var
I: Integer;
CurRow: Integer;
Action: TReconcileAction;
begin
if not Visible then Exit;
Action := TReconcileAction(ActionGroup.Items.Objects[ActionGroup.ItemIndex]);
UpdateData.Col := 1;
UpdateData.Row := 1;
CurRow := 1;
UpdateData.RowCount := 2;
UpdateData.Cells[0, CurRow] := SNoData;
for I := 1 to UpdateData.ColCount - 1 do
UpdateData.Cells[I, CurRow] := '';
for I := 0 to FDataFields.Count - 1 do
with PFieldData(FDataFields[I])^ do
begin
if ConflictsOnly.Checked and (CurValue = SUnChanged) then Continue;
if ChangedOnly.Checked and (NewValue = SUnChanged) then Continue;
UpdateData.RowCount := CurRow + 1;
UpdateData.Cells[0, CurRow] := Field.DisplayName;
if FNewColIdx > 0 then
begin
case Action of
raCancel, raRefresh:
UpdateData.Cells[FNewColIdx, CurRow] := SUnChanged;
raCorrect:
if Edited then
UpdateData.Cells[FNewColIdx, CurRow] := EditValue else
UpdateData.Cells[FNewColIdx, CurRow] := NewValue;
else
UpdateData.Cells[FNewColIdx, CurRow] := NewValue;
end;
UpdateData.Objects[FNewColIdx, CurRow] := FDataFields[I];
end;
if FCurColIdx > 0 then
UpdateData.Cells[FCurColIdx, CurRow] := CurValue;
if FOldColIdx > 0 then
if (Action in [raMerge, raRefresh]) and (CurValue <> SUnchanged) then
UpdateData.Cells[FOldColIdx, CurRow] := CurValue else
UpdateData.Cells[FOldColIdx, CurRow] := OldValue;
Inc(CurRow);
end;
AdjustColumnWidths;
end;
procedure TReconcileErrorForm.SetFieldValues(DataSet: TDataSet);
var
I: Integer;
begin
for I := 0 to FDataFields.Count - 1 do
with PFieldData(FDataFields[I])^ do
if Edited then Field.NewValue := EditValue;
end;
procedure TReconcileErrorForm.AdjustColumnWidths;
var
NewWidth, I: integer;
begin
with UpdateData do
begin
NewWidth := (ClientWidth - ColWidths[0]) div (ColCount - 1);
for I := 1 to ColCount - 1 do
ColWidths[I] := NewWidth - 1;
end;
end;
procedure TReconcileErrorForm.FormCreate(Sender: TObject);
begin
if FDataSet = nil then Exit;
FDataFields := TList.Create;
InitDataFields;
Caption := Format(SCaption, [FDataSet.Name]);
UpdateType.Caption := UpdateKindStr[FUpdateKind];
ErrorMsg.Text := FError.Message;
if FError.Context <> '' then
ErrorMsg.Lines.Add(FError.Context);
ConflictsOnly.Enabled := FCurColIdx > 0;
ConflictsOnly.Checked := ConflictsOnly.Enabled;
ChangedOnly.Enabled := FNewColIdx > 0;
InitReconcileActions;
UpdateData.DefaultRowHeight := UpdateData.Canvas.TextHeight('SWgjp') + 7;
end;
procedure TReconcileErrorForm.FormDestroy(Sender: TObject);
var
I: Integer;
begin
if Assigned(FDataFields) then
begin
for I := 0 to FDataFields.Count - 1 do
Dispose(PFieldData(FDataFields[I]));
FDataFields.Destroy;
end;
end;
procedure TReconcileErrorForm.UpdateDataSetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: string);
begin
PFieldData(UpdateData.Objects[ACol, ARow]).EditValue := Value;
PFieldData(UpdateData.Objects[ACol, ARow]).Edited := True;
end;
procedure TReconcileErrorForm.UpdateDataSelectCell(Sender: TObject; Col,
Row: Integer; var CanSelect: Boolean);
begin
if (Col = FNewColIdx) and
(TReconcileAction(ActionGroup.Items.Objects[ActionGroup.ItemIndex]) = raCorrect) then
UpdateData.Options := UpdateData.Options + [goEditing] else
UpdateData.Options := UpdateData.Options - [goEditing];
end;
end.
| CdsDeltaForm.dfm |
object FormCds: TFormCds
Left = 207
Top = 126
Width = 514
Height = 278
Caption = 'Client 3 Tier'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 506
Height = 41
Align = alTop
TabOrder = 0
object ButtonUpdate: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Caption = 'Update'
TabOrder = 0
OnClick = ButtonUpdateClick
end
object ButtonDelta: TButton
Left = 88
Top = 8
Width = 75
Height = 25
Caption = 'Show Delta'
TabOrder = 1
OnClick = ButtonDeltaClick
end
object ButtonUndo: TButton
Left = 168
Top = 8
Width = 75
Height = 25
Caption = 'Undo'
TabOrder = 2
OnClick = ButtonUndoClick
end
end
object PageControl1: TPageControl
Left = 0
Top = 41
Width = 506
Height = 210
ActivePage = TabSheetData
Align = alClient
TabIndex = 0
TabOrder = 1
OnChange = PageControl1Change
object TabSheetData: TTabSheet
Caption = 'Data'
object DBGrid1: TDBGrid
Left = 0
Top = 0
Width = 498
Height = 182
Align = alClient
DataSource = DataSource1
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
end
object TabSheetDelta: TTabSheet
Caption = 'Delta'
ImageIndex = 1
object DBGrid2: TDBGrid
Left = 0
Top = 0
Width = 498
Height = 182
Align = alClient
DataSource = DataSource2
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
end
end
object DataSource1: TDataSource
DataSet = DmCds.cdsEmployee
Left = 72
Top = 184
end
object DataSource2: TDataSource
AutoEdit = False
DataSet = DmCds.cdsDelta
Left = 144
Top = 184
end
end
| CdsDeltaDm.dfm |
object DmCds: TDmCds
OldCreateOrder = False
Left = 285
Top = 428
Height = 182
Width = 510
object cdsEmployee: TClientDataSet
Aggregates = <>
PacketRecords = 5
Params = <>
ProviderName = 'EmplProvider'
OnCalcFields = CalcStatusField
OnReconcileError = cdsEmployeeReconcileError
Left = 64
Top = 88
object cdsEmployeeStatus: TStringField
FieldKind = fkCalculated
FieldName = 'Status'
Calculated = True
end
object cdsEmployeeDEPT_NO: TStringField
FieldName = 'DEPT_NO'
Required = True
FixedChar = True
Size = 3
end
object cdsEmployeeEMP_NO: TSmallintField
FieldName = 'EMP_NO'
Required = True
end
object cdsEmployeeFIRST_NAME: TStringField
FieldName = 'FIRST_NAME'
Required = True
Size = 15
end
object cdsEmployeeLAST_NAME: TStringField
FieldName = 'LAST_NAME'
Required = True
end
object cdsEmployeeSALARY: TBCDField
FieldName = 'SALARY'
Required = True
Precision = 15
Size = 2
end
object cdsEmployeePHONE_EXT: TStringField
FieldName = 'PHONE_EXT'
Size = 4
end
end
object cdsDelta: TClientDataSet
Aggregates = <>
Params = <>
ReadOnly = True
OnCalcFields = CalcStatusField
Left = 166
Top = 87
object cdsDeltaStatus: TStringField
FieldKind = fkCalculated
FieldName = 'Status'
Calculated = True
end
object cdsDeltaDEPT_NO: TStringField
FieldName = 'DEPT_NO'
Required = True
FixedChar = True
Size = 3
end
object cdsDeltaEMP_NO: TSmallintField
FieldName = 'EMP_NO'
Required = True
end
object cdsDeltaFIRST_NAME: TStringField
FieldName = 'FIRST_NAME'
Required = True
Size = 15
end
object cdsDeltaLAST_NAME: TStringField
FieldName = 'LAST_NAME'
Required = True
end
object cdsDeltaSALARY: TBCDField
FieldName = 'SALARY'
Required = True
Precision = 15
Size = 2
end
object cdsDeltaPHONE_EXT: TStringField
FieldName = 'PHONE_EXT'
Size = 4
end
end
object SQLConnection: TSQLConnection
Connected = True
ConnectionName = 'IBLocal'
DriverName = 'Interbase'
GetDriverFunc = 'getSQLDriverINTERBASE'
LibraryName = 'dbexpint.dll'
LoginPrompt = False
Params.Strings = (
'BlobSize=-1'
'CommitRetain=False'
'Database=c:\program files\interbase corp\interbase6\examples\dat' +
'abase\employee.gdb'
'DriverName=Interbase'
'LocaleCode=0x0000'
'Password=masterkey'
'RoleName=RoleName'
'ServerCharSet=ASCII'
'SQLDialect=1'
'Interbase TransIsolation=ReadCommited'
'User_Name=sysdba'
'WaitOnLocks=True')
VendorLib = 'GDS32.DLL'
Left = 32
Top = 16
end
object EmplData: TSQLDataSet
SQLConnection = SQLConnection
CommandText =
'select DEPT_NO, EMP_NO, FIRST_NAME, LAST_NAME, SALARY, PHONE_EXT' +
' from EMPLOYEE'
Params = <>
Left = 112
Top = 16
end
object EmplProvider: TDataSetProvider
DataSet = EmplData
Constraints = True
Left = 192
Top = 16
end
end
| Reconc.dfm |
object ReconcileErrorForm: TReconcileErrorForm
Left = 289
Top = 225
BorderStyle = bsDialog
Caption = 'Update Error'
ClientHeight = 311
ClientWidth = 527
Color = clBtnFace
ParentFont = True
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = DisplayFieldValues
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 57
Top = 13
Width = 65
Height = 13
Caption = 'Update Type:'
end
object UpdateType: TLabel
Left = 134
Top = 13
Width = 49
Height = 13
Caption = 'Modified'
Font.Charset = DEFAULT_CHARSET
Font.Color = clBlack
Font.Height = -11
Font.Name = 'Default'
Font.Style = [fsBold]
ParentFont = False
end
object Label3: TLabel
Left = 57
Top = 33
Width = 71
Height = 13
Caption = 'Error Message:'
end
object IconImage: TImage
Left = 12
Top = 12
Width = 34
Height = 34
Picture.Data =
end
object UpdateData: TStringGrid
Left = 9
Top = 140
Width = 504
Height = 131
ColCount = 4
DefaultColWidth = 119
RowCount = 2
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goThumbTracking]
TabOrder = 1
OnSelectCell = UpdateDataSelectCell
OnSetEditText = UpdateDataSetEditText
end
object ActionGroup: TRadioGroup
Left = 410
Top = 10
Width = 102
Height = 113
Caption = ' Reconcile Action '
TabOrder = 0
OnClick = DisplayFieldValues
end
object CancelBtn: TButton
Left = 438
Top = 281
Width = 75
Height = 25
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 5
end
object OKBtn: TButton
Left = 350
Top = 281
Width = 75
Height = 25
Caption = 'OK'
Default = True
ModalResult = 1
TabOrder = 4
end
object ConflictsOnly: TCheckBox
Left = 11
Top = 282
Width = 153
Height = 17
Caption = 'Show conflicting fields only'
TabOrder = 2
OnClick = DisplayFieldValues
end
object ErrorMsg: TMemo
Left = 56
Top = 52
Width = 342
Height = 71
TabStop = False
Color = clBtnFace
ReadOnly = True
TabOrder = 6
end
object ChangedOnly: TCheckBox
Left = 185
Top = 282
Width = 141
Height = 17
Caption = 'Show changed fields only'
TabOrder = 3
OnClick = DisplayFieldValues
end
end
|
|