datamodule.pas

Delphi Kylix Database Development 附书代码

unit DataModule;

interface

uses
  SysUtils, Classes, SConnect, DB, DBClient, MConnect, Dialogs;

type
  TDM = class(TDataModule)
    SocketConnection1: TSocketConnection;
    cdsContacts: TClientDataSet;
    cdsTodos: TClientDataSet;
    cdsContactsCONTACTID: TIntegerField;
    cdsContactsFIRST: TStringField;
    cdsContactsLAST: TStringField;
    cdsContactsDEAR: TStringField;
    cdsContactsTITLE: TStringField;
    cdsContactsCOMPANYNAME: TStringField;
    cdsContactsADDRESS1: TStringField;
    cdsContactsADDRESS2: TStringField;
    cdsContactsCITY: TStringField;
    cdsContactsSTATE: TStringField;
    cdsContactsPOSTALCODE: TStringField;
    cdsContactsCOUNTRY: TStringField;
    cdsContactsPHONE: TStringField;
    cdsContactsFAX: TStringField;
    cdsContactsCELLULAR: TStringField;
    cdsContactsPAGER: TStringField;
    cdsContactsEMAIL: TStringField;
    cdsContactsIMAGE: TBlobField;
    cdsContactsNOTES: TMemoField;
    cdsContactssqlTodos: TDataSetField;
    cdsTodosTODOID: TIntegerField;
    cdsTodosCONTACTID: TIntegerField;
    cdsTodosDESCRIPTION: TStringField;
    cdsTodosSCHEDULED: TSQLTimeStampField;
    cdsTodosCOMPLETED: TSQLTimeStampField;
    cdsContactsFullName: TStringField;
    procedure DataModuleCreate(Sender: TObject);
    procedure SocketConnection1BeforeConnect(Sender: TObject);
    procedure cdsContactsReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure cdsContactsCalcFields(DataSet: TDataSet);
    procedure DataModuleDestroy(Sender: TObject);
    procedure cdsContactsNewRecord(DataSet: TDataSet);
    procedure cdsTodosNewRecord(DataSet: TDataSet);
  private
    { Private declarations }
  public
    { Public declarations }
    function GetNextID(DataSet: TCustomClientDataSet;
      const PrimaryKey: string): Integer;
  end;

var
  DM: TDM;

implementation

uses RecErrorForm;

resourcestring
  SConnectCaption = 'Database Server';
  SConnectPrompt  = 'Server:';

{$R *.dfm}

procedure TDM.DataModuleCreate(Sender: TObject);
begin
  cdsContacts.Open;
end;

procedure TDM.DataModuleDestroy(Sender: TObject);
begin
  cdsContacts.Close;
  SocketConnection1.Close;
end;

// Dataset events

procedure TDM.cdsContactsNewRecord(DataSet: TDataSet);
begin
  DataSet.FieldByName('CONTACTID').AsInteger :=
    GetNextID(DataSet as TCustomClientDataSet, 'CONTACTID');
end;

procedure TDM.cdsContactsCalcFields(DataSet: TDataSet);
begin
  DataSet.FieldByName('FullName').AsString :=
    DataSet.FieldByName('FIRST').AsString + ' ' +
    DataSet.FieldByName('LAST').AsString;
end;

procedure TDM.cdsContactsReconcileError(DataSet: TCustomClientDataSet;
  E: EReconcileError; UpdateKind: TUpdateKind;
  var Action: TReconcileAction);
begin
  Action := HandleReconcileError(DataSet, UpdateKind, E);
end;

procedure TDM.cdsTodosNewRecord(DataSet: TDataSet);
begin
  DataSet.FieldByName('TODOID').AsInteger :=
    GetNextID(DataSet as TCustomClientDataSet, 'TODOID');
end;

function TDM.GetNextID(DataSet: TCustomClientDataSet;
  const PrimaryKey: string): Integer;
var
  CloneDS: TClientDataSet;
begin
  CloneDS := TClientDataSet.Create(nil);
  try
    CloneDS.CloneCursor(DataSet, False);
    CloneDS.IndexFieldNames := PrimaryKey;
    CloneDS.First;
    if CloneDS.FieldByName(PrimaryKey).AsInteger > 0 then
      Result := -1
    else
      Result := CloneDS.FieldByName(PrimaryKey).AsInteger - 1;
  finally
    CloneDS.Free;
  end;
end;

// Connection events

procedure TDM.SocketConnection1BeforeConnect(Sender: TObject);
var
  Server: string;
begin
  if InputQuery(SConnectCaption, SConnectPrompt, Server) then
    SocketConnection1.Address := Server;
end;

end.