pfgpalmdb.pas

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

    procedure Cancel; override;
    procedure Delete; override;
    function Exists: Boolean; override;
    procedure DeleteById(ARecID: LongWord); virtual;
    function LocateById(ARecID: LongWord): Boolean; virtual;
    procedure PurgeTable; virtual;
    procedure SaveToFile(Filename: string);

    procedure PublicLocalToRemoteRecord(out pData: Pointer; out Size: LongWord);

    // Public run-time properties
    property Handle: Byte read FHandle write SetHandle stored False;
    property AppInfo: TpfgModifiedMemoryStream read GetAppInfo write SetAppInfo stored False;
//    property DbRecord: Pointer read FRecord;
    property RecNum: Integer read GetRecNum write SetRecNum;
    property dbFlags: TpfgPalmRemoteTableFlags read FdbFlags write SetDbFlags;
  published
    property CreatorID: string read FCreatorID write SetCreatorID;
    property TableType: string read FTableType write SetTableType;
    property Version: Word read FVersion write SetVersion;
    property Options: TpfgPalmRemoteTableOptions read GetOptions write SetOptions;
    property CategoryFilter: Shortint read GetCategoryFilter write SetCategoryFilter;
    property CardNum: Word read FCardNum write FCardNum;
    property DbSaving: Boolean read FDbSaving write SetDbSaving;
  end;


  TpfgPalmBatchMove = class(TComponent)
  private
    FSource: TpfgPalmTable;
    FDestination: TpfgPalmTable;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    procedure Execute;
  published
    property Source: TpfgPalmTable read FSource write FSource;
    property Destination: TpfgPalmTable read FDestination write FDestination;
  end;


  { Exceptions }

  EPalmDBError = class(Exception);

  ENotImplError = class(Exception);

  EFeatureNotAvailable = class(Exception);

var
  // This variable is automatically set by the TpfgPalmComponent when it is
  // used
  ConduitCreatorID: string = '';

procedure Register;

resourcestring
  // Shared resource strings (those which are referenced by the
  // pfgPalmLocalDb.pas file)
  SActiveError = 'The operation requires the table to be closed';

implementation

uses Windows, pfgSyncMgr, pfgPalmSyncError, pfgDbSave;

resourcestring
  // Internal resource strings
  SFieldDefsError = 'Created FieldDefs did not have a table owner';
  STableTypeError = 'The TableType "%s" is invalid';
  SNotActiveError = 'The operation requires the table to be open';
  SReadOnlyError = 'The database is read only';
  SRuntimeError = 'The operation is only allowed at runtime';
  SEditModeError = 'Cannot perform this operation whilst in edit mode';
  SCategoryError = 'The category number "%d" is invalid';
  SInvalidRecNumError = 'The Record Number "%d" could not be found';
  SFieldCountMismatchError = 'The number of fields in the two field objects ' +
    'did not match';
//  SNoActiveRecordError = 'There is no currently active record';
  SFieldMappingError = 'A mapped field went beyond the end of the physical ' +
    'record structure';
  SRecNotFound = 'The operation requires an active record';
  SFieldNotFound = 'The specified field "%s" was not found';
  SSrcDestMissingError = 'Source or Destination missing in BatchMove';
  //SRecordIDRemoteError = 'RecordID cannot be set for a remote table';

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


{**************************************************************************}
{* TpfgPalmFieldDefs class                                                   *}
{*                                                                        *}
{**************************************************************************}

constructor TpfgPalmFieldDefs.Create(AOwner: TpfgPalmTable);
begin
  inherited Create(TpfgPalmFieldDef);
  FOwner := AOwner;
  FAlignment := 0;  // Default to no alignment
  FStrictFields := True; // Palm records must map to field definitions exactly 
  
  if not Assigned(AOwner) then raise EPalmDBError.Create(SFieldDefsError);
end;

function TpfgPalmFieldDefs.GetSItem(Index: Integer): TpfgPalmFieldDef;
begin
  Result := inherited Items[Index] as TpfgPalmFieldDef;
end;

procedure TpfgPalmFieldDefs.SetSItem(Index: Integer; Value: TpfgPalmFieldDef);
begin
  inherited Items[Index] := Value;
end;

procedure TpfgPalmFieldDefs.SetAlignment(AAlignment: LongWord);
begin
  if AAlignment <> FAlignment then
  begin
    FAlignment := AAlignment;
    Update(nil);
  end;
end;

function TpfgPalmFieldDefs.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TpfgPalmFieldDefs.Add: TpfgPalmFieldDef;
begin
  Result := inherited Add as TpfgPalmFieldDef;
end;

function TpfgPalmFieldDefs.Add(AFieldName: string; ADataType: TpfgPalmFieldType;
  Size: Integer = 0): TpfgPalmFieldDef;
begin
  Result := Self.Add;
  Result.FieldName := AFieldName;
  Result.DataType := ADataType;
  Result.Size := Size;
end;

function TpfgPalmFieldDefs.Insert(Index: Integer): TpfgPalmFieldDef;
begin
  Result := inherited Insert(Index) as TpfgPalmFieldDef;
end;

procedure TpfgPalmFieldDefs.Update(Item: TCollectionItem);
begin
  FOwner.FieldDefChanged;
end;

{**************************************************************************}
{* TpfgPalmFieldDef class                                                    *}
{*                                                                        *}
{**************************************************************************}

constructor TpfgPalmFieldDef.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FDataType := ptWord;
  FSize := 0;
  FFieldName := '';
end;

procedure TpfgPalmFieldDef.Assign(Source: TPersistent);
var
  s: TpfgPalmFieldDef;
begin
  if Source is TpfgPalmFieldDef then
  begin
    s := TpfgPalmFieldDef(Source);
    FDataType := s.FDataType;
    FSize := s.FSize;
    FFieldName := s.FFieldName;
  end
  else
    inherited Assign(Source);
end;

procedure TpfgPalmFieldDef.SetFieldName(AFieldName: string);
begin
  if FFieldName <> AFieldName then
  begin
    FFieldName := AFieldName;
    Changed(False);
  end;
end;

procedure TpfgPalmFieldDef.SetDataType(ADataType: TpfgPalmFieldType);
begin
  if FDataType <> ADataType then
  begin
    FDataType := ADataType;
    Changed(False);
  end;
end;

procedure TpfgPalmFieldDef.SetSize(ASize: Integer);
begin
  if FSize <> ASize then
  begin
    FSize := ASize;
    Changed(False);
  end;
end;

function TpfgPalmFieldDef.GetDisplayName: string;
begin
  if FieldName = '' then Result := inherited GetDisplayName
  else Result := FieldName;
end;

{**************************************************************************}
{* TpfgPalmField class                                                       *}
{*                                                                        *}
{**************************************************************************}

constructor TpfgPalmField.Create(AOwner: TpfgPalmFields; AIndex: Integer);
begin
  inherited Create;
  FOwner := AOwner;
  FIndex := AIndex;
end;

function TpfgPalmField.GetTable: TpfgPalmTable;
begin
  Result := FOwner.Owner;
end;

function TpfgPalmField.GetFieldName: string;
begin
  // Return the field name of the field def at the same index
  Result := Table.FieldDefs[Index].FieldName;
end;

procedure TpfgPalmField.Clear;
begin
  SetAsString('');
end;

function TpfgPalmField.GetAsBoolean: Boolean;
begin
  Result := Self.AsInteger <> 0;
end;

function TpfgPalmField.GetAsDateTime: TDateTime;
begin
  Result := StrToDateTime(Self.AsString);
end;

function TpfgPalmField.GetAsFloat: Double;
begin
  Result := Table.GetFieldValue(FIndex);
end;

function TpfgPalmField.GetAsInteger: Integer;
var
  s: string;
begin
  s := Table.GetFieldValue(FIndex);
  if s = '' then Result := 0
  else Result := StrToInt(s);
end;

function TpfgPalmField.GetAsInt64: Int64;
var
  s: string;
begin
  // Since a variant can't hold an Int64, the value will be
  // returned as a string
  s := Table.GetFieldValue(FIndex);
  if s = '' then Result := 0
  else Result := StrToInt64(s);
end;

function TpfgPalmField.GetAsString: string;
begin
  Result := Table.GetFieldValue(FIndex);
end;

function TpfgPalmField.GetAsVariant: Variant;
begin
  Result := Table.GetFieldValue(FIndex);
end;

procedure TpfgPalmField.SetAsBoolean(Value: Boolean);
begin
  if Value then Table.SetFieldValue(FIndex, 1)
  else Table.SetFieldValue(FIndex, 0);
end;

procedure TpfgPalmField.SetAsDateTime(Value: TDateTime);
begin
  Table.SetFieldValue(FIndex, DateTimeToStr(Value));
end;

procedure TpfgPalmField.SetAsFloat(Value: Double);
begin
  Table.SetFieldValue(FIndex, Value);
end;

procedure TpfgPalmField.SetAsInteger(Value: Integer);
begin
  Table.SetFieldValue(FIndex, Value);
end;

procedure TpfgPalmField.SetAsInt64(Value: Int64);
begin
  // Pass as a string, since a variant can't hold an Int64
  Table.SetFieldValue(FIndex, IntToStr(Value));
end;

procedure TpfgPalmField.SetAsString(Value: string);
begin
  Table.SetFieldValue(FIndex, Value);
end;

procedure TpfgPalmField.SetAsVariant(Value: Variant);
begin
  Table.SetFieldValue(FIndex, Value);
end;

function TpfgPalmField.GetIsNull: Boolean;
begin
  Result := Self.AsString = '';
end;

{**************************************************************************}
{* TpfgPalmFields class                                                      *}
{*                                                                        *}
{**************************************************************************}

constructor TpfgPalmFields.Create(AOwner: TpfgPalmTable);
begin
  inherited Create;
  FOwner := AOwner;
  SetLength(FFields, 0);
end;

destructor TpfgPalmFields.Destroy;
begin
  Clear;
  inherited Destroy;
end;

// Assign
// Takes care of assigning the data from one set of fields to another. The
// number of fields must match

procedure TpfgPalmFields.Assign(Source: TPersistent);
var
  s: TpfgPalmFields;
  ctr: Integer;
begin
  if not (Source is TpfgPalmFields) then
    inherited Assign(Source)
  else
  begin
    s := TpfgPalmFields(Source);
    if s.Count <> Count then raise EPalmDbError.Create(SFieldCountMismatchError);

    for ctr := 0 to Count-1 do
      Items[ctr].AsVariant := s[ctr].AsVariant;

    try
      Flags := s.Flags;
    except
    end;
    try
      //RecordID := s.RecordID; unassigned for now
    except
    end;
    try
      Category := s.Category;
    except
    end;
  end;
end;

// Clear
// Clears the current field list

procedure TpfgPalmFields.Clear;
var
  ctr: Integer;
begin
  for ctr := 0 to Count-1 do
    FFields[ctr].Free;
  SetLength(FFields, 0);
end;

// Update
// Creates a field list based on the current field definition

procedure TpfgPalmFields.Update;
var
  ctr: Integer;
begin
  Clear;
  SetLength(FFields, Owner.FieldCount);
  for ctr := 0 to High(FFields) do
    FFields[ctr] := TpfgPalmField.Create(Self, ctr);
end;

// GetCount
// Returns the number of fields

function TpfgPalmFields.GetCount: Integer;
begin
  Result := Length(FFields);
end;

// GetItem
// Returns the item at the specified index

function TpfgPalmFields.GetItem(Index: Integer): TpfgPalmField;
begin
  Result := FFields[Index];
end;

// SetItem
// Copys the value of one field into another

procedure TpfgPalmFields.SetItem(Index: Integer; AField: TpfgPalmField);