pfgpalmsynccomponent.pas

delphi编写与Palm数据交换管道连接程序。

unit pfgPalmSyncComponent;
{
PEL 2001-05-18
moved
    DefaultCompareRecord(
to public so that it can be called from users OnComparerecord !

PEL 2001-05-28
Changes in Syncfast and SyncSlow
In first readtrough of Palm-records they cannot be modified
because the recordindex is reset for some reason
and as a result only half the records are read out to the PC :-)
temporary ? solution is to NOT modify the palm records until
stage two , when copying data back from PC-to palm !

PEL 2001-07-17
Changes in Syncfast and SyncSlow
records deleted on palm are not copied to PC in the first readthru
are later deleted , all at once by calling PurgeTable

Changes in DoDeletePalm
It now only sets the deleted attribute
- the record will be deleted later by calling PurgeTable

PEL 2001-08-30
Misplaced ".next" - on the wrong side of an "end;"
ment that the syncing could end up in endless loop :-)
}
interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  Db,
  pfgPalmDb,
  pfgSyncMgr,
  pfgPalmComp;

type
  TRecordAction = (CopyToPalm, CopyToPC, DeletePalmPC, DoNothing);
type
  TOnCompareRecord = function(Sender: TObject;
    const Props: TpfgSyncProperties; const PalmFlags, PCFlags: byte): TRecordAction
  of object;
type
  TOnBeforeSync = function(Sender: TObject;
    const Props: TpfgSyncProperties): integer of object;
type
  TOnBeforeLocalList = procedure(Sender: TObject;
    const Props: TpfgSyncProperties) of object;
type
  TOnFindLocalRecordID = function(Sender: TObject;
    RecordID: DWORD): Boolean of object;
type
  TGetLocalAttribs = function(Sender: TObject): Byte of object;
  TSetLocalAttribs = procedure(Sender: TObject; const value: Byte) of object;
type
  TGetLocalRecId = function(Sender: TObject): DWORD of object;
  TSetLocalRecId = procedure(Sender: TObject; const value: DWORD) of object;
type
  TGetLocalCatId = function(Sender: TObject): shortint of object;
  TSetLocalCatId = procedure(Sender: TObject; const value: shortint) of object;
type
  TOnErrorMessage = procedure(Sender: TObject; const ErrorMessage: string) of
    object;
type
  TOnEmptyLocalTable = procedure(DataSet: TDataSet) of object;

type
  TpfgPalmSyncComponent = class(TComponent)
  private
    FLocalDataSet: TDataSet;
    FpfgPalmRemoteTable: TpfgPalmRemoteTable;
    FSyncProperties: TpfgSyncProperties;
    FOnCompareRecord: TOnCompareRecord;
    FOnBeforeSync: TOnBeforeSync;
    FOnFindLocalRecordID: TOnFindLocalRecordID;
    FOnErrorMessage: TOnErrorMessage;
    FOnBeforeLocalList: TOnBeforeLocalList;

    FGetLocalCatId: TGetLocalCatId;
    FSetLocalCatId: TSetLocalCatId;

    FSetLocalRecId: TSetLocalRecId;
    FGetLocalRecId: TGetLocalRecId;

    FLocalCategoryField: TNumericField;
    FLocalRecIdField: TNumericField;
    FLocalDeletedField: TBooleanField;
    FLocalDirtyField: TBooleanField;
    FLocalAttribsField: TNumericField;

    FGetLocalAttribs: TGetLocalAttribs;
    FSetLocalAttribs: TSetLocalAttribs;
    FAllowCreatePalmTable: boolean;
    FOnEmptyLocalTable: TOnEmptyLocalTable;

    procedure SetLocalDataSet(const Value: TDataSet);
    procedure SetSyncProperties(const Value: TpfgSyncProperties);
    procedure SetOnCompareRecord(const Value: TOnCompareRecord);
    procedure SetpfgPalmRemoteTable(const Value: TpfgPalmRemoteTable);
    procedure SetOnBeforeSync(const Value: TOnBeforeSync);
    procedure SetOnFindLocalRecordID(const Value: TOnFindLocalRecordID);
    function compare_and_act(const maskattr: byte): TRecordAction;
    procedure SetGetLocalAttribs(const Value: TGetLocalAttribs);
    procedure SetSetLocalAttribs(const Value: TSetLocalAttribs);
    procedure SetGetLocalCatId(const Value: TGetLocalCatId);
    procedure SetGetLocalRecId(const Value: TGetLocalRecId);
    procedure SetSetLocalCatId(const Value: TSetLocalCatId);
    procedure SetSetLocalRecId(const Value: TSetLocalRecId);
    procedure SendErrorMsg(const s: string);
    procedure SetOnErrorMessage(const Value: TOnErrorMessage);
    procedure SetOnBeforeLocalList(const Value: TOnBeforeLocalList);
    procedure SetLocalCategoryField(const Value: TNumericField);
    procedure SetLocalRecIdField(const Value: TNumericField);
    procedure SetLocalDeletedField(const Value: TBooleanField);
    procedure SetLocalDirtyField(const Value: TBooleanField);
    procedure SetLocalAttribsField(const Value: TNumericField);
    procedure SetAllowCreatePalmTable(const Value: boolean);
    procedure SetOnEmptyLocalTable(const Value: TOnEmptyLocalTable);
    { Private declarations }
  protected
    { Protected declarations }
    function CompareRecord(const PalmFlags, PCFlags: byte): TRecordAction;
    procedure DoBeforeLocalList;
    function SyncFast: integer;
    function SyncSlow: integer;
    function SyncHHtoPC: integer;
    function SyncPCtoHH: integer;
    function SyncBackup: integer;
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    function DoCopyToPC: integer;

    function DoCopyToPalm: integer;
    function DoDeletePalm: integer;
    function DoDeletePC: integer;
    function DoGetLocalAttribs: byte;
    procedure DoSetLocalAttribs(const value: byte);
    function DoGetLocalCatId: shortint;
    procedure DoSetLocalCatId(const value: shortint);
    function DoGetLocalRecId: dword;
    procedure DoSetLocalRecId(const value: dword);
    procedure DoEmptyLocalTable;
  public
    { Public declarations }
    property SyncProperties: TpfgSyncProperties read FSyncProperties write
    SetSyncProperties;
    function Sync: integer;
      overload;
    function Sync(SyncProps: TpfgSyncProperties): integer; overload;
    procedure CheckObligatoryAssignments;
    function DefaultCompareRecord(const PalmFlags, PCFlags: byte):
    TRecordAction;
  published
    { Published declarations }
    property pfgPalmRemoteTable: TpfgPalmRemoteTable read FpfgPalmRemoteTable
    write SetpfgPalmRemoteTable;
{ the table on the Palm you want to sync}
    property LocalDataSet: TDataSet read FLocalDataSet write SetLocalDataSet;
{ the dataset on the PC you want to sync}
    property AllowCreatePalmTable: boolean read FAllowCreatePalmTable write SetAllowCreatePalmTable;

    property OnCompareRecord: TOnCompareRecord read FOnCompareRecord write
    SetOnCompareRecord;
{ If you want to do your own comparing of records ( overrides the default compare method )}
    property OnBeforeSync: TOnBeforeSync read FOnBeforeSync write
    SetOnBeforeSync;
{ called before syncing - set up of tables etc}
    property OnBeforeLocalList: TOnBeforeLocalList read FOnBeforeLocalList write
    SetOnBeforeLocalList;
{ called before a listing of all PC- records is done
  use it to set SQL to something like "Select * from table" if you have s}
    property OnFindLocalRecordID: TOnFindLocalRecordID read FOnFindLocalRecordID
    write SetOnFindLocalRecordID;
{}
    property GetLocalAttribs: TGetLocalAttribs read FGetLocalAttribs write
    SetGetLocalAttribs;
{}
    property SetLocalAttribs: TSetLocalAttribs read FSetLocalAttribs write
    SetSetLocalAttribs;
{}
    property LocalDirtyField: TBooleanField read FLocalDirtyField write
    SetLocalDirtyField;
    property LocalDeletedField: TBooleanField read FLocalDeletedField write
    SetLocalDeletedField;
    property LocalAttribsField: TNumericField read FLocalAttribsField write
    SetLocalAttribsField;

    property LocalRecIdField: TNumericField read FLocalRecIdField write
    SetLocalRecIdField;
{}
    property GetLocalRecId: TGetLocalRecId read FGetLocalRecId write
    SetGetLocalRecId;
{}
    property SetLocalRecId: TSetLocalRecId read FSetLocalRecId write
    SetSetLocalRecId;
{}
    property LocalCategoryField: TNumericField read FLocalCategoryField write
    SetLocalCategoryField;
{}
    property GetLocalCatId: TGetLocalCatId read FGetLocalCatId write
    SetGetLocalCatId;
{}
    property SetLocalCatId: TSetLocalCatId read FSetLocalCatId write
    SetSetLocalCatId;
{}
    property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write
    SetOnErrorMessage;
{Called on errors - can be used if you want to send messages to log file}

    property OnEmptyLocalTable: TOnEmptyLocalTable read FOnEmptyLocalTable write SetOnEmptyLocalTable;

  end;

procedure Register;
{.$R *.res}

//const
//  eRecAttrUpdateCheck = $01;

function IsDirty(const Flags: integer): boolean;
function IsDeleted(const Flags: integer): boolean;
function MakeAttribute(const Dirty, Deleted: boolean): integer;



implementation
uses
{.$define debugmsg}
{$IFDEF debugmsg}
  debugit,
  typinfo,
{$ENDIF}
  pfgPalmSyncError,
  pfgPalmMisc;

procedure Register;
begin
  RegisterComponents('Palm Pilot', [TpfgPalmSyncComponent]);
end;

resourcestring
  // Internal resource strings
  SMustAssignMethod = 'You must assign a method to "%s.%s"';
  SMustAssignProperty = 'You must assign the property "%s.%s"';
  SMustAssignRecIDMethod =
    'You must assign either ;'#13 +
    'LocalRecIdField or '#13 +
    'GetLocalRecId and SetLocalRecId';
  SMustAssignAttribMethod =
    'You must assign either;'#13 +
    'LocalAttribsField or'#13 +
    'LocalDirtyField and LocalDeletedField or'#13 +
    'GetLocalAttribs and SetLocalAttribs';

function IsDirty(const Flags: integer): boolean;
begin
  result := (Flags and eRecAttrDirty) <> 0;
end;

function IsDeleted(const Flags: integer): boolean;
begin
  result := (Flags and eRecAttrDeleted) <> 0;
end;

function MakeAttribute(const Dirty, Deleted: boolean): integer;
begin
  result := 0;
  if Dirty then result := result or eRecAttrDirty;
  if Deleted then result := result or eRecAttrDeleted;
end;

{ TpfgPalmSyncComponent }

procedure TpfgPalmSyncComponent.SetLocalDataSet(const Value: TDataSet);
begin
  FLocalDataSet := Value;
end;

procedure TpfgPalmSyncComponent.SetpfgPalmRemoteTable(
  const Value: TpfgPalmRemoteTable);
begin
  FpfgPalmRemoteTable := Value;
end;

procedure TpfgPalmSyncComponent.SetSyncProperties(
  const Value: TpfgSyncProperties);
begin
  FSyncProperties := Value;
end;

function TpfgPalmSyncComponent.Sync(SyncProps: TpfgSyncProperties): integer;
begin
  SyncProperties := SyncProps;
  Result := Sync;
end;

procedure TpfgPalmSyncComponent.CheckObligatoryAssignments;
begin
  if not assigned(LocalDataSet) then
  begin
    raise exception.CreateFmt(SMustAssignProperty, [self.name, 'LocalDataSet']);
  end;
  if not assigned(pfgPalmRemoteTable) then
  begin
    raise exception.CreateFmt(SMustAssignProperty, [self.name,
      'pfgPalmRemoteTable']);
  end;

  if not assigned(LocalRecIdField) then
  begin
    if (not assigned(GetLocalRecId)) or (not assigned(SetLocalRecId)) then
    begin
      raise exception.Create(SMustAssignRecIDMethod);
    end;
  end;

  if not assigned(LocalAttribsField) then
  begin
    if (not assigned(LocalDirtyField)) or (not assigned(LocalDeletedField))
      then
    begin
      if (not assigned(GetLocalAttribs)) or (not assigned(SetLocalAttribs))
        then
      begin
        raise exception.Create(SMustAssignAttribMethod);
      end;
    end;
  end;
  if (@OnFindLocalRecordID = nil) then
  begin
    raise exception.CreateFmt(SMustAssignMethod, [self.name,
      'OnFindLocalRecordID']);
  end;
end;

function TpfgPalmSyncComponent.Sync: integer;
begin
  try
    CheckObligatoryAssignments;
    pfgPalmRemoteTable.CardNum := SyncProperties.m_CardNo;
    pfgPalmRemoteTable.CreatorID := CreatorIDToStr(SyncProperties.m_Creator);
    if assigned(FOnBeforeSync) then
    begin
      FOnBeforeSync(self, SyncProperties);
    end;

    case
      SyncProperties.m_SyncType of
      eFast: result := SyncFast;
      eSlow: result := SyncSlow;
      eHHtoPC: result := SyncHHtoPC;
      ePCtoHH: result := SyncPCtoHH;
//      eBackup: result := SyncBackup;
    else
      begin
        result := SyncFast;
      end;
    end;
  except
    on e: exception do
    begin
      SendErrorMsg(e.message + ' in ' + pfgPalmRemoteTable.TableName);
      result := -1;
    end;
  end;
end;

function TpfgPalmSyncComponent.SyncBackup: integer;
(*
eBackup Perform a backup of the databases
on the handheld to the desktop computer.
*)
begin
  result := 0;
end;

function TpfgPalmSyncComponent.SyncHHtoPC: integer;
(*
eHHtoPC Perform a restore from the handheld:
overwrite the desktop database
with the database from the handheld.
*)
begin
  DoEmptyLocalTable;
  result := syncslow;
end;

function TpfgPalmSyncComponent.SyncPCtoHH: integer;
(*
ePCtoHH Perform a restore from the desktop computer:
overwrite the database on the handheld
with the database on the desktop computer
*)
begin
  pfgPalmRemoteTable.EmptyTable;
  result := syncslow;
end;

function TpfgPalmSyncComponent.SyncSlow: integer;