pfgpalmdb.pas

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

unit pfgPalmDb;
{**************************************************************************}
{* pfgPalmDb Unit                                                         *}
{*                                                                        *}
{* This unit implements the database component, TpfgPalmRemoteTable.      *}
{* It provides similar properties to a standard TTable component,         *}
{* allowing records to be manipulated in tables located on a Palm.        *}
{*                                                                        *}
{* Copyright (C) 2000 - 2002 by Paul Gilbert, All Rights Reserved         *}
{**************************************************************************}

interface

{$I pfgPalmConduits.inc}

{$IFDEF PFG_DELPHI6_UP}
uses Classes, SysUtils, pfgWTypes, pfgPalmMisc, Variants;
{$ELSE}
uses Classes, SysUtils, pfgWTypes, pfgPalmMisc;
{$ENDIF}

type
  // Palm Field Types:
  //   Byte     - Single byte value
  //   Word     - 2 byte value
  //   Long     - 4 byte long value
  //   Int64    - 8 byte long value
  //   Date     - DateType value
  //   Time     - TimeType value
  //   DateTime - DateTimeType value
  //   String   - string. Can be fixed length [via Size] or null terminated
  //   Single   - 4 byte single precision 'float' value
  //   Double   - 8 byte double precision 'double' type
  //   Custom   - Custom data structure [Size specifies length]
  TpfgPalmFieldType = (ptByte, ptWord, ptDate, ptTime, ptDateTime,
    ptLong, ptString, ptInt64, ptSingle, ptDouble, ptCustom);

  // Palm table options:
  //  opShowSecret  - If set, only shows secret records
  //  opArchived    - If set, only shows archived records
  //  opModified    - If set, only shows modified recods
  // opStringsAlign - If set, specifies that a field following a string field
  //                  (unless that field is itself a string field) should
  //                  be aligned to the specified alignment boundary.
  //                  The default is to ignore alignment after strings
  // opNumAlign     - If set, specifies that 2 and 4 byte numbers should be
  //                  aligned to an even word boundary
  TpfgPalmRemoteTableOption = (opShowSecret, opArchived, opModified,
    opStringsAlign, opNumAlign);
  TpfgPalmRemoteTableOptions = set of TpfgPalmRemoteTableOption;

  // Local table options:
  //  opUseRecordID - When creating a new table, insert a "RecordID" field
  //  opUseFlags    - When creating a new table, insert a "Flags" field
  //  opUseCategory - When creating a new table, insert a "Category" field
  TpfgPalmLocalTableOption = (opUseRecordID, opUseFlags, opUseCategory);
  TpfgPalmLocalTableOptions = set of TpfgPalmLocalTableOption;

  // Remote table flags [Martin Casatti]
  TpfgPalmRemoteTableFlag = (tfAppInfoDirty,tfBackupDB,tfOkToInstallNewer,
    tfCopyPrevention,tfResetAfterInstall);
  TpfgPalmRemoteTableFlags = set of TpfgPalmRemoteTableFlag;

  TpfgPalmDataSetState = (psInactive, psBrowse, psEdit, psInsert);

  TpfgPalmReadFieldEvent = procedure (Sender: TObject; pData: Pointer;
    DataSize: Integer; FieldIndex: Integer; var DataPos: LongWord;
      out Data: string) of object;

  TpfgPalmWriteFieldEvent = procedure (Sender: TObject; FieldIndex: Integer;
    DataPos: Integer; out Data: Variant) of object;

const
  CARD_NUM = 0;             // Default card used for database operations
  MaxRecordSize = 65000;    // Maximum size for a record or AppInfo block
  PalmFieldSize: Array [ptByte..ptCustom] of Integer =
    (1, 2, 2, 2, 14, 4, -1, 8, 4, 8, -1); // Field sizes

type
  TpfgPalmFieldDef = class;
  TpfgPalmFieldDefs = class;
  TpfgPalmField = class;
  TpfgPalmFields = class;
  TpfgPalmTable = class;


  TpfgPalmFieldDef = class(TCollectionItem)
  private
    FFieldName: string;
    FDataType: TpfgPalmFieldType;
    FSize: Integer;

    procedure SetFieldName(AFieldName: string);
    procedure SetDataType(ADataType: TpfgPalmFieldType);
    procedure SetSize(ASize: Integer);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property FieldName: string read FFieldName write SetFieldName;
    property DataType: TpfgPalmFieldType read FDataType write SetDataType;
    property Size: Integer read FSize write SetSize;
  end;

  TpfgPalmFieldDefs = class(TCollection)
  private
    FOwner: TpfgPalmTable;
    FAlignment: LongWord;
    FStrictFields: Boolean;
  protected
    function GetSItem(Index: Integer): TpfgPalmFieldDef; virtual;
    procedure SetSItem(Index: Integer; Value: TpfgPalmFieldDef); virtual;
    procedure SetAlignment(AAlignment: LongWord); virtual;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(AOwner: TpfgPalmTable); reintroduce;

    function GetOwner: TPersistent; override;
    function Add: TpfgPalmFieldDef; overload;
    function Add(AFieldName: string; ADataType: TpfgPalmFieldType; Size: Integer = 0):
      TpfgPalmFieldDef; overload;
    function Insert(Index: Integer): TpfgPalmFieldDef;

    property Items[Index: Integer]: TpfgPalmFieldDef read
      GetSItem write SetSItem; default;
  published
    property Alignment: LongWord read FAlignment write SetAlignment;
    property StrictFields: Boolean read FStrictFields write FStrictFields;
  end;

  TpfgPalmField = class
  private
    FIndex: Integer;
    FOwner: TpfgPalmFields;

    function GetTable: TpfgPalmTable;
    function GetFieldName: string;
    function GetAsBoolean: Boolean;
    function GetAsDateTime: TDateTime;
    function GetAsFloat: Double;
    function GetAsInteger: Integer;
    function GetAsInt64: Int64;
    function GetAsString: string;
    function GetAsVariant: Variant;
    procedure SetAsBoolean(Value: Boolean);
    procedure SetAsDateTime(Value: TDateTime);
    procedure SetAsFloat(Value: Double);
    procedure SetAsInteger(Value: Integer);
    procedure SetAsInt64(Value: Int64);
    procedure SetAsString(Value: string);
    procedure SetAsVariant(Value: Variant);
    function GetIsNull: Boolean;
  public
    constructor Create(AOwner: TpfgPalmFields; AIndex: Integer);
    procedure Clear;

    property Owner: TpfgPalmFields read FOwner;
    property Table: TpfgPalmTable read GetTable;
    property Index: Integer read FIndex;
    property FieldName: string read GetFieldName;

    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsFloat: Double read GetAsFloat write SetAsFloat;
    property AsInteger: Integer read GetAsInteger write SetAsInteger;
    property AsInt64: Int64 read GetAsInt64 write SetAsInt64;
    property AsString: string read GetAsString write SetAsString;
    property AsVariant: Variant read GetAsVariant write SetAsVariant;
    property IsNull: Boolean read GetIsNull;
  end;

  TpfgPalmFields = class(TPersistent)
  private
    FFields: Array of TpfgPalmField;
    FOwner: TpfgPalmTable;

    function GetCount: Integer;
    function GetItem(Index: Integer): TpfgPalmField;
    procedure SetItem(Index: Integer; AField: TpfgPalmField);
    function GetFlags: Byte;
    procedure SetFlags(AFlags: Byte);
    function GetRecordID: LongWord;
    procedure SetRecordID(AID: LongWord);
    function GetCategory: Shortint;
    procedure SetCategory(ACategory: Shortint);
    function GetIsEmpty: Boolean;
  public
    constructor Create(AOwner: TpfgPalmTable);
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    procedure Update;

    property Owner: TpfgPalmTable read FOwner;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TpfgPalmField read GetItem write SetItem; default;
    property Flags: Byte read GetFlags write SetFlags;
    property RecordID: LongWord read GetRecordID write SetRecordID;
    property Category: Shortint read GetCategory write SetCategory;
    property IsEmpty: Boolean read GetIsEmpty;
  end;


  TpfgPalmTable = class(TComponent)
  private
    FFieldDefs: TpfgPalmFieldDefs;
    FFields: TpfgPalmFields;
    FReadOnly: Boolean;

    // Event handler method pointers
    FOnBeforeClose, FOnAfterClose: TNotifyEvent;
    FOnBeforeOpen, FOnAfterOpen: TNotifyEvent;
    FOnBeforeRecChange, FOnAfterRecChange: TNotifyEvent;
    FOnBeforeEdit, FOnAfterEdit: TNotifyEvent;
    FOnBeforeInsert, FOnAfterInsert: TNotifyEvent;
    FOnBeforePost, FOnAfterPost: TNotifyEvent;
    FOnBeforeCancel, FOnAfterCancel: TNotifyEvent;
    FOnBeforeDelete, FOnAfterDelete: TNotifyEvent;
    FOnBeforeTableCreate, FOnAfterTableCreate: TNotifyEvent;
    FOnReadField: TpfgPalmReadFieldEvent;
    FOnWriteField: TpfgPalmWriteFieldEvent;

    procedure SetFieldDefs(AFieldDefs: TpfgPalmFieldDefs);
    procedure SetFields(AFields: TpfgPalmFields);
    function GetFieldCount: Integer;
  protected
    { Interfacing methods for sub-objects }
    procedure FieldDefChanged; virtual;
    function GetFieldValue(Index: Integer): Variant; virtual; abstract;
    procedure SetFieldValue(Index: Integer; Value: Variant); virtual; abstract;
    function GetRecordFlags: Byte; virtual; abstract;
    procedure SetRecordFlags(AFlags: Byte); virtual; abstract;
    function GetRecordID: LongWord; virtual; abstract;
    procedure SetRecordID(Value: LongWord); virtual; abstract;
    function GetRecordCategory: Shortint; virtual; abstract;
    procedure SetRecordCategory(ACategory: Shortint); virtual; abstract;
    function GetIsEmpty: Boolean; virtual; abstract;

    // Event handler execution methods
    procedure DoBeforeClose; dynamic;
    procedure DoAfterClose; dynamic;
    procedure DoBeforeOpen; dynamic;
    procedure DoAfterOpen; dynamic;
    procedure DoBeforeRecChange; dynamic;
    procedure DoAfterRecChange; dynamic;
    procedure DoBeforeEdit; dynamic;
    procedure DoAfterEdit; dynamic;
    procedure DoBeforeInsert; dynamic;
    procedure DoAfterInsert; dynamic;
    procedure DoBeforePost; dynamic;
    procedure DoAfterPost; dynamic;
    procedure DoBeforeCancel; dynamic;
    procedure DoAfterCancel; dynamic;
    procedure DoBeforeDelete; dynamic;
    procedure DoAfterDelete; dynamic;
    procedure DoBeforeTableCreate; dynamic;
    procedure DoAfterTableCreate; dynamic;

    procedure DoReadField(pData: Pointer; DataSize: Integer;
      FieldIndex: Integer; var DataPos: LongWord; out Data: string); dynamic;
    procedure DoWriteField(FieldIndex: Integer; DataPos: Integer;
      out Data: Variant); dynamic;

    // Property handler methods
    function GetActive: Boolean; virtual; abstract;
    procedure SetActive(AActive: Boolean); virtual; abstract;
    function GetTableName: string; virtual; abstract;
    procedure SetTableName(AName: string); virtual; abstract;
    function GetReadOnly: Boolean; virtual;
    procedure SetReadOnly(AReadOnly: Boolean); virtual;
    function GetState: TpfgPalmDataSetState; virtual; abstract;
    function GetRecordCount: Integer; virtual; abstract;
    function GetRecNum: Integer; virtual; abstract;
    procedure SetRecNum(ARecNum: Integer); virtual; abstract;
    function GetBOF: Boolean; virtual; abstract;
    function GetEOF: Boolean; virtual; abstract;
  published
    // Properties
    property FieldDefs: TpfgPalmFieldDefs read FFieldDefs write SetFieldDefs;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
    property TableName: string read GetTableName write SetTableName;

    // Events
    property OnBeforeClose: TNotifyEvent read FOnBeforeClose write FOnBeforeClose;
    property OnAfterClose: TNotifyEvent read FOnAfterClose write FOnAfterClose;
    property OnBeforeOpen: TNotifyEvent read FOnBeforeOpen write FOnBeforeOpen;
    property OnAfterOpen: TNotifyEvent read FOnAfterOpen write FOnAfterOpen;
    property OnBeforeRecChange: TNotifyEvent read FOnBeforeRecChange
      write FOnBeforeRecChange;
    property OnAfterRecChange: TNotifyEvent read FOnAfterRecChange
      write FOnAfterRecChange;
    property OnBeforeEdit: TNotifyEvent read FOnBeforeEdit write FOnBeforeEdit;
     property OnAfterEdit: TNotifyEvent read FOnAfterEdit write FOnAfterEdit;
    property OnBeforeInsert: TNotifyEvent read FOnBeforeInsert write FOnBeforeInsert;
    property OnAfterInsert: TNotifyEvent read FOnAfterInsert write FOnAfterInsert;
    property OnBeforePost: TNotifyEvent read FOnBeforePost write FOnBeforePost;
    property OnAfterPost: TNotifyEvent read FOnAfterPost write FOnAfterPost;
    property OnBeforeCancel: TNotifyEvent read FOnBeforeCancel write FOnBeforeCancel;
    property OnAfterCancel: TNotifyEvent read FOnAftercancel write FOnAfterCancel;
    property OnBeforeTableCreate: TNotifyEvent read FOnBeforeTableCreate write FOnBeforeTableCreate;
    property OnAfterTableCreate: TNotifyEvent read FOnAfterTableCreate write FOnAfterTableCreate;

    property OnReadField: TpfgPalmReadFieldEvent read FOnReadField write FOnReadField;
    property OnWriteField: TpfgPalmWriteFieldEvent read FOnWriteField write FonWriteField;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Open; virtual;
    procedure Close; virtual;
    function FindField(FieldName: string): TpfgPalmField; virtual;
    function FieldByName(FieldName: string): TpfgPalmField; virtual;
    function Exists: Boolean; virtual;

    procedure EmptyTable; virtual; abstract;
    procedure CreateTable; virtual; abstract;
    procedure DeleteTable; virtual; abstract;
    procedure First; virtual; abstract;
    procedure Last; virtual; abstract;
    procedure Next; virtual; abstract;
    procedure Prior; virtual; abstract;
    procedure Edit; virtual; abstract;
    procedure Append; virtual; abstract;
    procedure Insert; virtual; abstract;
    procedure Post; virtual; abstract;
    procedure Cancel; virtual; abstract;
    procedure Delete; virtual; abstract;

    // Public runtime properties
    property Fields: TpfgPalmFields read FFields write SetFields;
    property FieldCount: Integer read GetFieldCount;
    property Active: Boolean read GetActive write SetActive;
    property State: TpfgPalmDataSetState read GetState;
    property RecordCount: Integer read GetRecordCount;
    property BOF: Boolean read GetBOF;
    property EOF: Boolean read GetEOF;
  end;

  TpfgPalmRemoteTable = class(TpfgPalmTable)
  private
    FCreatorID: string;
    FTableName: string;
    FTableType: string;
    FVersion: Word;
    FHandle: Byte;
    FOptions: TpfgPalmRemoteTableOptions;
    FAppInfo: TpfgModifiedMemoryStream;
    FCategoryFilter: Integer;
    FState: TpfgPalmDataSetState;
//    FRecord: Pointer;
//    FRecordSize: Integer;
    FRecNum: Integer;
    FBOF, FEOF: Boolean;
    FdbFlags: TpfgPalmRemoteTableFlags;
    FRecordFlags: Byte;
    FRecordID: LongWord;
    FRecordCategory: Shortint;
    FData: TStringList;
    FRecordEmpty: Boolean;
    FCardNum: Word;
    FRecordSaved: Boolean;
    FDbSaving: Boolean; // Flag used during exporting datasets to files

    // Internal methods
    procedure OpenDatabase;
    procedure CloseDatabase;
    procedure GetNextRecord;
    procedure PostRecord;
    procedure DeleteRecord(ARecID: LongWord);
    procedure InitRecord;
    procedure RemoteRecordToLocal(const pData: Pointer; Size: LongWord);
    procedure LocalToRemoteRecord(out pData: Pointer; out Size: LongWord);
    function GetDbFlagsField: Byte;
  protected
    // Embedded object interface methods
    procedure FieldDefChanged; override;
    function GetFieldValue(Index: Integer): Variant; override;
    procedure SetFieldValue(Index: Integer; Value: Variant); override;
    function GetRecordFlags: Byte; override;
    procedure SetRecordFlags(AFlags: Byte); override;
    function GetRecordID: LongWord; override;
    procedure SetRecordID(Value: LongWord); override;
    function GetRecordCategory: Shortint; override;
    procedure SetRecordCategory(ACategory: Shortint); override;
    function GetIsEmpty: Boolean; override;

    // Property handler methods
    procedure SetHandle(AHandle: Byte);
    function GetActive: Boolean; override;
    procedure SetActive(AActive: Boolean); override;
    function GetTableName: string; override;
    procedure SetTableName(AName: string); override;
    procedure SetCreatorID(AID: string); virtual;
    procedure SetTableType(AType: string); virtual;
    procedure SetVersion(AVersion: Word); virtual;
    function GetOptions: TpfgPalmRemoteTableOptions; virtual;
    procedure SetOptions(AOptions: TpfgPalmRemoteTableOptions); virtual;
    function GetAppInfo: TpfgModifiedMemoryStream; virtual;
    procedure SetAppInfo(AInfo: TpfgModifiedMemoryStream); virtual;
    function GetCategoryFilter: Shortint; virtual;
    procedure SetCategoryFilter(ACategory: Shortint); virtual;
    function GetState: TpfgPalmDataSetState; override;
    function GetRecordCount: Integer; override;
    function GetRecNum: Integer; override;
    procedure SetRecNum(ARecNum: Integer); override;
    function GetBOF: Boolean; override;
    function GetEOF: Boolean; override;
    procedure SetDbFlags(Value: TpfgPalmRemoteTableFlags); virtual;
    procedure SetDbSaving(Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure EmptyTable; override;
    procedure CreateTable; override;
    procedure DeleteTable; override;
    procedure First; override;
    procedure Last; override;
    procedure Next; override;
    procedure Prior; override;
    procedure Edit; override;
    procedure Append; override;
    procedure Insert; override;
    procedure Post; override;