pfgdbsave.pas

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

unit pfgDbSave;
{**************************************************************************}
{* pfgDbSave Unit                                                         *}
{*                                                                        *}
{* This unit implements the saving and loading of Palm PDB files. It also *}
{* provides a public interface method that takes in a database handle,    *}
{* and uses the database saving functionality of the object to create an  *}
{* image of the database as a file.                                       *}
{*                                                                        *}
{* Copyright (C) 2000 - 2002 by Paul Gilbert, All Rights Reserved         *}
{**************************************************************************}

interface

{$I pfgPalmConduits.inc}

uses Classes, SysUtils, pfgPalmMisc, Db, pfgPalmDb;

type
  TDbOpenMode = (dbReadOnly, dbWriteOnly, dbReadWrite);

  TpfgPalmDbFile = class
  private
    // General properties
    FFilename: string;
    FOpenMode: TDbOpenMode;
    FModified: Boolean;
    FAppInfo: TpfgModifiedMemoryStream;
    FSortInfo: TpfgModifiedMemoryStream;
    FRecordList: TList;

    // Database flags
    FDbName: string;
    FAttributes: Word;
    FVersion: Word;
    FCreationDate: TDateTime;
    FModificationDate: TDateTime;
    FLastBackupDate: TDateTime;
    FModificationNumber: LongWord;
    FDbType: LongWord;
    FCreator: LongWord;
    FUniqueIDSeed: LongWord;

    // Property access methods
    function GetModified: Boolean;
    procedure SetModified(Value: Boolean);
    function GetRecordCount: Integer;
    procedure SetRecordCount(Value: Integer);

    // Internal methods
    procedure Read;
    procedure Write;
  public
    constructor Create(AFilename: string; AOpenMode: TDbOpenMode);
    destructor Destroy; override;
    procedure Flush;
    procedure SetRecord(Index: Integer; Attributes: Byte; ID: LongWord;
      Category: Shortint; Data: Pointer; DataSize: Integer);
    procedure GetRecord(Index: Integer; out Attributes: Byte; out ID: LongWord;
      out Category: Shortint; out Data: Pointer; out DataSize: Integer);

    // Properties
    property DbName: string read FDbName write FDbName;
    property Attributes: Word read FAttributes write FAttributes;
    property Version: Word read FVersion write FVersion;
    property CreationDate: TDateTime read FCreationDate write FCreationDate;
    property ModificationDate: TDateTime read FModificationDate write
      FModificationDate;
    property LastBackupDate: TDateTime read FLastBackupDate write
      FLastBackupDate;
    property ModificationNumber: LongWord read FModificationNumber write
      FModificationNumber;
    property DbType: LongWord read FDbType write FDbType;
    property Creator: LongWord read FCreator write FCreator;
    property UniqueIDSeed: LongWord read FUniqueIDSeed write FUniqueIdSeed;
    property AppInfo: TpfgModifiedMemoryStream read FAppInfo;
    property SortInfo: TpfgModifiedMemoryStream read FSortInfo;

    property Modified: Boolean read GetModified write SetModified;
    property RecordCount: Integer read GetRecordCount write SetRecordCount;
  end;

  EPDBError = class(Exception);

  TExportTableOptions = record
    DbName: string;
    Attributes: Word;
    Version: Integer;
    CreationDate, ModificationDate, LastBackupDate: TDateTime;
    ModificationNumber: Integer;
    DbType: Integer;
    CreatorId: Integer;
    UniqueIdSeed: Integer;
    RemoteOptions: TpfgPalmRemoteTableOptions
  end;

// AssignFieldDefs
// Sets up the field definitions of the Palm table to closely match that
// of the passed DataSet

procedure AssignFieldDefs(t: TpfgPalmRemoteTable; DataSet: TDataSet);

// ExportDatabaseToFile
// These two methods use the TpfgPalmDbFile class to create images of Palm
// databases on the local computer. The first variation takes in an active
// handle to a Palm database to replicate, and the other takes in a DataSet
// whose contents should be replicated

procedure ExportDatabaseToFile(Handle: Byte; Filename: string); overload;

procedure ExportDatabaseToFile(DataSet: TDataSet; Filename: string;
  AppInfo, SortInfo: TMemoryStream; Options: TExportTableOptions);
overload;

resourcestring
  SMultipleRecordListError = 'The PDB read system cannot support PDB files ' +
    'that contain multiple linked record lists';
  SInvalidDate = 'The specified date "%s" is outside the valid date range';

implementation

uses pfgSyncMgr, pfgPalmSyncError, Dialogs;

const
  DB_NAMELEN = 32;
  eRecAttrDeleted  = $80;
  eRecAttrArchived = $08;

type
  LocalID = LongWord;

  TDatabaseHdrType = packed record
    name: Array [0..DB_NAMELEN-1] of Char;   // name of database
    attributes: Word;                        // database attributes
    version: Word;                           // version of database

    creationDate: LongWord;                  // creation date of database
    modificationDate: LongWord;              // latest modification date
    lastBackupDate: LongWord;                // latest backup date
    modificationNumber: LongWord;            // modification number of database

    appInfoID: LocalID;                      // application specific info
    sortInfoID: LocalID;                     // app specific sorting info

    dbType: LongWord;                        // database type
    creator: LongWord;                       // database creator

    uniqueIDSeed: LongWord;                  // used to generate unique IDs

    // Record list
    nextRecordListID: LocalID;               // local chunkID of next list
    numRecords: Word;                        // number of records in this list
    // first record
  end;

  TDbRecordListEntry = packed record
    DataOffset: LongWord;                    // Offset to start of data
    Attributes: Byte;                        // Attributes byte for record
    UniqueId: Array [0..2] of Byte;          // Unique Id for record
  end;
  PDbRecordListEntry = ^TDbRecordListEntry;

  TMemRecordListEntry = record
    Data: Pointer;
    DataSize: Integer;
    Attributes: Byte;
    UniqueId: LongWord;
  end;
  PMemRecordListEntry = ^TMemRecordListEntry;

{**************************************************************************}
{* Helper functions                                                       *}
{*                                                                        *}
{**************************************************************************}

const
  SecondsInDay = 60*60*24;
  SecondsInMinute = 60;
  SecondsInHour = 60*60;
  MaxRecordSize = 65000;    // Maximum size for a AppInfo/SortInfo block

// PalmLongTimeToDateTime
// Converts a longword Palm date/time (representing the number of seconds
// since midnight 1/1/1970) to a TDateTime variable. Note that the input
// should be first re-ordered for little endian

function PalmLongTimeToDateTime(Value: LongWord): TDateTime;
var
  NumDays: Integer;
  VTemp, hours, minutes, seconds: LongWord;
begin
  if Value = 0 then Result := 0
  else
  begin
    // Calculate the number of days (from 1/1/1970), and the time of day
    NumDays := Value div SecondsInDay;
    VTemp := Value mod SecondsInDay;
    hours := VTemp div SecondsInHour;
    VTemp := VTemp mod SecondsInHour;
    minutes := VTemp div SecondsInMinute;
    seconds := VTemp mod SecondsInMinute;

    // Encode final result
    Result := EncodeDate(1970, 1, 1) + NumDays +
              EncodeTime(hours, minutes, seconds, 0);
  end;
end;

// DateTimeToPalmLongTime
// Converts a Windows TDateTime variable to a longword Palm date/time value,
// which represents the number of seconds since 1/1/1970. Note that the
// output is still in little-endian format

function DateTimeToPalmLongTime(Value: TDateTime): LongWord;
var
  day, month, year: Word;
  hour, minute, second, ms: Word;
begin
  if Value = 0 then Result := 0
  else
  begin
    DecodeDate(Value, year, month, day);
    DecodeTime(Value, hour, minute, second, ms);

    // Make sure the date is in range
    if year < 1970 then raise EPDBError.CreateFmt(SInvalidDate,
      [DateTimeToStr(Value)]);

    Result := (Trunc(Value - EncodeDate(1970, 1, 1)) * SecondsInDay) +
              (hour * SecondsInHour) + (minute * SecondsInMinute) +
              second;
  end;
end;

// Reverseal functions
// These are quick mnunemics wrapping calls to the ReverseVal method

function RLW(Value: LongWord): LongWord;
begin
  Result := ReverseVal(Value, sizeof(LongWord));
end;
function RW(Value: Word): Word;
begin
  Result := ReverseVal(Value, sizeof(Word));
end;

{**************************************************************************}
{* TpfgPalmDbFile class                                                      *}
{*                                                                        *}
{**************************************************************************}

constructor TpfgPalmDbFile.Create(AFilename: string; AOpenMode: TDbOpenMode);
begin
  FRecordList := TList.Create;
  FAppInfo := TpfgModifiedMemoryStream.Create;
  FSortInfo := TpfgModifiedMemoryStream.Create;

  FFilename := AFilename;
  FOpenMode := AOpenMode;
  if AOpenMode = dbReadOnly then Read;
end;

destructor TpfgPalmDbFile.Destroy;
begin
  Flush;

  RecordCount := 0;

  FRecordList.Free;
  FAppInfo.Free;
  FSortInfo.Free;
  inherited;
end;

function TpfgPalmDbFile.GetModified: Boolean;
begin
  Result := FModified or FAppInfo.Modified or FSortInfo.Modified;
end;

procedure TpfgPalmDbFile.SetModified(Value: Boolean);
begin
  FModified := Value;
  if not Value then
  begin
    FAppInfo.Modified := False;
    FSortInfo.Modified := False;
  end;
end;

function TpfgPalmDbFile.GetRecordCount: Integer;
begin
  Result := FRecordList.Count;
end;

procedure TpfgPalmDbFile.SetRecordCount(Value: Integer);
var
  ctr: Integer;
  p: PMemRecordListEntry;
begin
  // If expanding list, then add on enough entries
  while (RecordCount < Value) do
  begin
    New(p);
    FillChar(p^, sizeof(TMemRecordListEntry), 0);
    FRecordList.Add(p);
  end;

  // If contracting the list, then reduce the number of entries
  if Value < RecordCount then
    for ctr := RecordCount-1 downto Value do
    begin
      with PMemRecordListEntry(FRecordList[ctr])^ do
        if Assigned(Data) then Dispose(Data);
      Dispose(FRecordList[ctr]);
      FRecordList.Delete(ctr);
    end;
end;

// Flush
// Wrapper for the internal Write method

procedure TpfgPalmDbFile.Flush;
begin
  if FOpenMode <> dbReadOnly then Write;
end;

// Read
// Reads the contents of a PDB file into the object

procedure TpfgPalmDbFile.Read;
var
  f: File of Byte;
  header: TDatabaseHdrType;
  TotalSize, AIOffset, AISize, SIOffset, SISize: LongWord;
  Offset: LongWord;
  RecordHeaders, PrevRecord, p: PDbRecordListEntry;
  ctr: Integer;
  PrevIndex: Integer;
  pRec: PMemRecordListEntry;
  DataSize: Integer;

  procedure ReadDataBlock(Stream: TpfgModifiedMemoryStream; Offset, Size: LongWord);
  var
    pData: PChar;
  begin
    GetMem(pData, Size);
    try
      BlockRead(f, pData^, Size);
      Stream.Clear;
      Stream.Write(pData^, Size);

    finally
      Dispose(pData);
    end;
  end;

  function ReadData(Offset, Size: LongWord): Pointer;
  var
    p: PChar;
  begin
    GetMem(p, Size);
    Seek(f, Offset);
    BlockRead(f, p^, Size);
    Result := p;
  end;

begin
  AssignFile(f, FFilename);
  Reset(f);
  try
    TotalSize := FileSize(f);

    // Parse the header data
    BlockRead(f, header, sizeof(TDatabaseHdrType));
    FDbName := StrPas(header.name);
    FAttributes := RW(header.attributes);
    FVersion := RW(header.version);
    FCreationDate := PalmLongTimeToDateTime(RLW(header.creationDate));
    FModificationDate := PalmLongTimeToDateTime(RLW(header.modificationDate));
    FLastBackupDate := PalmLongTimeToDateTime(RLW(header.lastBackupDate));
    FModificationNumber := RLW(header.modificationNumber);
    FDbType := RLW(header.dbType);
    FCreator := RLW(header.creator);
    FUniqueIdSeed := RLW(header.uniqueIDSeed);

    AIOffset := RLW(header.appInfoID);
    SIOffset := RLW(header.sortInfoID);
    AISize := 0; SISize := 0;

    if RLW(header.nextRecordListID) <> 0 then
      raise EPDBError.Create(SMultipleRecordListError);

    // Process the record list
    RecordCount := RW(header.numRecords);
    DataSize := sizeof(TDbRecordListEntry)*RecordCount + sizeof(Word);
    GetMem(RecordHeaders, DataSize);
    try
      BlockRead(f, RecordHeaders^, DataSize);
      p := RecordHeaders;

      // Firstly calculate the size of the AppInfo and SortInfo blocks. We do
      // it now, because we need to know the offset of the first record.
      Offset := RLW(p^.DataOffset);
      if AIOffset <> 0 then
      begin
        if SIOffset <> 0 then AISize := SIOffset - AIOffset
        else if Offset <> 0 then AISize := Offset - AIOffset
        else AISize := TotalSize - AIOffset;
      end;
      if SIOffset <> 0 then
      begin
        if Offset <> 0 then SISize := Offset - SIOffset
        else SISize := TotalSize - SIOffset;
      end;

      // Read in the actual data for AppInfo and SortInfo
      if AIOffset <> 0 then ReadDataBlock(FAppInfo, AIOffset, AISize);
      if SIOffset <> 0 then ReadDataBlock(FSortInfo, SIOffset, SISize);

      // Loop through the record list and read in the header and record
      // data block for each record
      PrevIndex := -1;
      PrevRecord := nil;
      for ctr := 0 to RecordCount-1 do
      begin
        with PMemRecordListEntry(FRecordList[ctr])^ do
        begin
          Attributes := p^.Attributes;
          UniqueID := (p^.UniqueID[0] shl 16) + (p^.UniqueID[1] shl 8) +
                      p^.UniqueID[2];
          Data := nil;
          DataSize := 0;

          if p^.DataOffset <> 0 then