pfgdbsave.pas

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

          begin
            if Assigned(PrevRecord) then
            begin
              // Found the next record offset, so use it's offset against
              // that of the previously found record to calculate the size
              // for that previus record, and read it in
              pRec := PMemRecordListEntry(FRecordList[PrevIndex]);
              pRec^.DataSize := RLW(p^.DataOffset) - RLW(PrevRecord^.DataOffset);
              pRec^.Data := ReadData(RLW(PrevRecord^.DataOffset), pRec^.DataSize);
            end;

            PrevRecord := p;
            PrevIndex := ctr;
          end;
        end;

        Inc(p);  // Move to the next record
      end;

      // Handle any final record (which will go to the end of file)
      if PrevIndex <> -1 then
      begin
        pRec := PMemRecordListEntry(FRecordList[PrevIndex]);
        pRec^.DataSize := TotalSize - RLW(PrevRecord^.DataOffset);
        pRec^.Data :=ReadData(RLW(PrevRecord^.DataOffset), pRec^.DataSize);
      end;

    finally
      Dispose(RecordHeaders);
    end;
  finally
    CloseFile(f);
  end;
end;

// Write
// Writes out the contents of the object to a PDB file

procedure TpfgPalmDbFile.Write;
var
  f: File of Byte;
  header: TDatabaseHdrType;
  Offset: LongWord;
  RecordList, p: PDbRecordListEntry;
  ctr: Integer;
  pData: PChar;
  DataSize: Integer;

  // Writes the AppInfo or SortInfo block to file
  procedure WriteStream(Stream: TpfgModifiedMemoryStream);
  var
    pData: PChar;
  begin
    GetMem(pData, Stream.Size);
    try
      Stream.Position := 0;
      Stream.Read(pData^, Stream.Size);
      BlockWrite(f, pData^, Stream.Size);
    finally
      Dispose(pData);
    end;
  end;

begin
  AssignFile(f, FFilename);
  Rewrite(f);

  try
    // Setup the header data
    FillChar(header.name, 32, 0);
    StrPLCopy(header.name, FDbName, 31);
    header.attributes := RW(FAttributes);
    header.version := RW(FVersion);
    header.creationDate := RLW(DateTimeToPalmLongTime(FCreationDate));
    header.modificationDate := RLW(DateTimeToPalmLongTime(FModificationDate));
    header.lastBackupDate :=  RLW(DateTimeToPalmLongTime(FLastBackupDate));
    header.modificationNumber := RLW(FModificationNumber);
    header.dbType := RLW(FDbType);
    header.creator := RLW(FCreator);
    header.uniqueIDSeed := RLW(FUniqueIdSeed);
    header.nextRecordListID := 0; // No linked record list
    header.numRecords := RW(RecordCount);

    // Start of data area - accounting for the header, a single record list,
    // and the two-byte placeholder bytes at the end of the record list
    Offset := sizeof(TDatabaseHdrType) + RecordCount * sizeof(TDbRecordListEntry)
      + sizeof(Word);

    // Set offsets for AppInfo and SortInfo
    if FAppInfo.Size = 0 then header.appInfoID := 0
    else
    begin
      header.appInfoID := RLW(Offset);
      Inc(Offset, FAppInfo.Size);
    end;
    if FSortInfo.Size = 0 then header.sortInfoID := 0
    else
    begin
      header.sortInfoID := RLW(Offset);
      Inc(Offset, FSortInfo.Size);
    end;

    // Write out the header
    BlockWrite(f, header, sizeof(TDatabaseHdrType));

    // Write out the record list (if any)
    if RecordCount > 0 then
    begin
      DataSize := sizeof(TDbRecordListEntry) * RecordCount + sizeof(Word);
      GetMem(RecordList, DataSize);
      try
        FillChar(RecordList^, DataSize, 0);
        p := RecordList;
        for ctr := 0 to RecordCount-1 do
          with PMemRecordListEntry(FRecordList[ctr])^ do
          begin
            p^.Attributes := Attributes;
            p^.UniqueId[0] := UniqueId shr 16;
            p^.UniqueId[1] := (UniqueId shr 8) and $FF;
            p^.UniqueId[2] := UniqueId and $FF;

            if not Assigned(Data) then p^.DataOffset := 0
            else
            begin
              // Store the offset, and move offset to be ready for next record
              p^.DataOffset := RLW(Offset);
              Inc(Offset, DataSize);
            end;

            Inc(p);
          end;

        BlockWrite(f, RecordList^, DataSize);
      finally
        Dispose(RecordList);
      end;
    end;

    // Write out the AppInfo and SortInfo blocks if present
    if FAppInfo.Size > 0 then WriteStream(FAppInfo);
    if FSortInfo.Size > 0 then WriteStream(FSortInfo);

    // Write out each record block in turn
    for ctr := 0 to RecordCount-1 do
      with PMemRecordListEntry(FRecordList[ctr])^ do
      begin
        if Assigned(Data) then
        begin
          pData := Data;
          BlockWrite(f, pData^, DataSize);
        end;
      end;
  finally
    CloseFile(f);
  end;
end;

// SetRecord
// Sets the data for a record

procedure TpfgPalmDbFile.SetRecord(Index: Integer; Attributes: Byte;
  ID: LongWord; Category: Shortint; Data: Pointer; DataSize: Integer);
var
  p: PMemRecordListEntry;
begin
  p := PMemRecordListEntry(FRecordList[Index]);
  if Assigned(p^.Data) then Dispose(p^.Data);
  GetMem(p^.Data, DataSize);
  Move(Data^, p^.Data^, DataSize);

  p^.DataSize := DataSize;
  p^.UniqueId := ID;

  // Set up the attributes byte
  p^.Attributes := (Attributes and $F0) + (Category mod 16);
  if (Attributes and eRecAttrArchived) <> 0 then
    p^.Attributes := p^.Attributes or eRecAttrDeleted;
end;

// GetRecord
// Gets a reference to the data for a record

procedure TpfgPalmDbFile.GetRecord(Index: Integer; out Attributes: Byte;
  out ID: LongWord; out Category: Shortint; out Data: Pointer;
  out DataSize: Integer);
var
  p: PMemRecordListEntry;
begin
  p := PMemRecordListEntry(FRecordList[Index]);
  ID := p^.UniqueId;
  Data := p^.Data;
  DataSize := p^.DataSize;

  Category := p^.Attributes and $0F;
  Attributes := p^.Attributes and $F0;
  if ((Attributes and eRecAttrDeleted) <> 0) and Assigned(Data) then
    Attributes := Attributes and (not eRecAttrDeleted) or eRecAttrArchived;
end;

{**************************************************************************}
{* Support methods                                                        *}
{*                                                                        *}
{* These are suport methods for the public access methods                 *}
{**************************************************************************}

procedure LoadBlock(Handle: Byte; Stream: TpfgModifiedMemoryStream; IsAppInfo: Boolean);
var
  GenInfo: CDbGenInfo;
begin
  GetMem(GenInfo.m_pBytes, MaxRecordSize);
  try
    GenInfo.m_TotalBytes := MaxRecordSize;
    GenInfo.m_dwReserved := 0;

    if IsAppInfo then SyncReadDbAppInfoBlock(Handle, GenInfo)
    else SyncReadDbSortInfoBlock(Handle, GenInfo);

    // Store the read in data
    Stream.Clear;
    Stream.Write(GenInfo.m_pBytes^, GenInfo.m_BytesRead);
  finally
    Dispose(GenInfo.m_pBytes);
  end;
end;

{**************************************************************************}
{* Public methods                                                         *}
{*                                                                        *}
{**************************************************************************}

const
{$ifdef PFG_DELPHI4}
  FieldTypeStrs: Array [ftUnknown..ftDataSet] of string = (
    'ftUnknown', 'ftString', 'ftSmallint', 'ftInteger', 'ftWord', 'ftBoolean',
    'ftFloat', 'ftCurrency', 'ftBCD', 'ftDate', 'ftTime', 'ftDateTime',
    'ftBytes', 'ftVarBytes', 'ftAutoInc', 'ftBlob', 'ftMemo', 'ftGraphic',
    'ftFmtMemo', 'ftParadoxOle', 'ftDBaseOle', 'ftTypedBinary', 'ftCursor',
    'ftFixedChar', 'ftWideString', 'ftLargeInt', 'ftADT', 'ftArray',
    'ftReference', 'ftDataSet');
{$else}
  FieldTypeStrs: Array [ftUnknown..ftGuid] of string = (
    'ftUnknown', 'ftString', 'ftSmallint', 'ftInteger', 'ftWord', 'ftBoolean',
    'ftFloat', 'ftCurrency', 'ftBCD', 'ftDate', 'ftTime', 'ftDateTime',
    'ftBytes', 'ftVarBytes', 'ftAutoInc', 'ftBlob', 'ftMemo', 'ftGraphic',
    'ftFmtMemo', 'ftParadoxOle', 'ftDBaseOle', 'ftTypedBinary', 'ftCursor',
    'ftFixedChar', 'ftWideString', 'ftLargeInt', 'ftADT', 'ftArray',
    'ftReference', 'ftDataSet', 'ftOraBlob', 'ftOraClob', 'ftVariant',
    'ftInterface', 'ftIDispatch', 'ftGuid');
{$endif}

procedure AssignFieldDefs(t: TpfgPalmRemoteTable; DataSet: TDataSet);
var
  ctr: Integer;
begin
  t.FieldDefs.Clear;
  for ctr := 0 to DataSet.FieldDefs.Count-1 do
    with DataSet.FieldDefs[ctr] do
    begin
      case DataType of
        ftString, ftWideString: t.FieldDefs.Add(Name, ptString, Size);
        ftSmallint, ftWord: t.FieldDefs.Add(Name, ptWord);
        ftInteger, ftAutoInc: t.FieldDefs.Add(Name, ptLong);
        ftBoolean: t.FieldDefs.Add(Name, ptByte);
        ftCurrency, ftFloat: t.FieldDefs.Add(Name, ptDouble);
        ftDate: t.FieldDefs.Add(Name, ptDate);
        ftTime: t.FieldDefs.Add(Name, ptTime);
        ftDateTime: t.FieldDefs.Add(Name, ptDateTime);
        ftBytes, ftVarBytes, ftBlob: t.FieldDefs.Add(Name, ptCustom, Size);
        ftMemo, ftFmtMemo: t.FieldDefs.Add(Name, ptString, Size);
        ftLargeInt: t.FieldDefs.Add(Name, ptInt64);
      else
        raise Exception.Create(FieldTypeStrs[DataType] + ' is not supported');
      end;
    end;
end;


// ExportDatabaseToFile
// Exports the specified database file from the Palm to an image file on the
// local computer. Handle must be a handle to an open file.

procedure ExportDatabaseToFile(Handle: Byte; Filename: string);
var
  PDB: TpfgPalmDbFile;
  rParam: SyncReadOpenDbInfoParams;
  rInfo: SyncDatabaseInfoType;
  info: CRawRecordInfo;
  ctr: Integer;
begin
  // Get the database attributes
  rParam.bOptFlags := SYNC_DB_INFO_OPT_GET_ATTRIBUTES or SYNC_DB_INFO_OPT_GET_SIZE;
  rParam.bDbHandle := Handle;
  FillChar(rInfo, sizeof(SyncDatabaseInfoType), 0);
  PalmCheck(SyncReadOpenDbInfo(rParam, rInfo));

  PDB := TpfgPalmDbFile.Create(Filename, dbWriteOnly);
  try
    // Feed in the attributes
    with rInfo.baseInfo do
    begin
      PDB.DBName := StrPas(m_Name);
      PDB.Attributes := m_DbFlags;
      PDB.Version := m_Version;
      PDB.CreationDate := PalmLongTimeToDateTime(m_CreateDate);
      PDB.ModificationDate := PalmLongTimeToDateTime(m_ModDate);
      PDB.LastBackupDate := PalmLongTimeToDateTime(m_BackupDate);
      PDB.ModificationNumber := m_ModNumber;
      PDB.DbType := m_DbType;
      PDB.Creator := m_Creator;
      PDB.UniqueIDSeed := 0; // Is this correct?
    end;

    // Load in the AppInfo/SortInfo blocks
    if rInfo.dwAppBlkSize > 0 then LoadBlock(Handle, PDB.AppInfo, True);
    if rInfo.dwSortBlkSize > 0 then LoadBlock(Handle, PDB.SortInfo, False);

    // Read in the records
    GetMem(info.m_pBytes, MaxRecordSize);
    try
      PDB.RecordCount := rInfo.dwNumRecords;

      // Read in each record
      for ctr := 0 to PDB.RecordCount-1 do
      begin
        info.m_FileHandle := Handle;
        info.m_TotalBytes := MaxRecordSize;
        info.m_dwReserved := 0;
        info.m_CatId := 0;
        info.m_RecIndex := ctr;
        PalmCheck(SyncReadRecordByIndex(info));

        PDB.SetRecord(ctr, info.m_Attribs, info.m_RecId, info.m_CatId,
          info.m_pBytes, info.m_RecSize);
      end;
    finally
      Dispose(info.m_pBytes);
    end;

    // Write out the database
    PDB.Flush;

  finally
    PDB.Free;
  end;
end;

// ExportDatabaseToFile
// An alternatate version that takes in the data from a passed TDataSet
// component, and uses it to construct a Palm image file. Note that this
// method can be called outside of a HotSync session, allowing a programmer
// to pre-construct a set of tables that can be later quickly installed during
// a HotSync session

procedure ExportDatabaseToFile(DataSet: TDataSet; Filename: string;
  AppInfo, SortInfo: TMemoryStream; Options: TExportTableOptions);
var
  t: TpfgPalmRemoteTable;
  PDB: TpfgPalmDbFile;
  ctr: Integer;
  pData: Pointer;
  Size: LongWord;
  RecId: LongWord;

  procedure DuplicateStream(Src, Dest: TMemoryStream);
  var
    p: PChar;
  begin
    Dest.SetSize(Src.Size);
    Src.Position := 0; Dest.Position := 0;
    GetMem(p, Src.Size);
    try
      Src.Read(p^, Src.Size);
      Dest.Write(p^, Src.Size);
    finally
      Dispose(p);
    end;
  end;

begin
  t := TpfgPalmRemoteTable.Create(nil);
  PDB := TpfgPalmDbFile.Create(Filename, dbWriteOnly);
  try
    AssignFieldDefs(t, DataSet);
    t.DbSaving := True;

    // Set up header information
    with Options do
    begin
      PDB.DbName := DbName;
      PDB.Attributes := Attributes;
      PDB.Version := Version;
      PDB.CreationDate := CreationDate;
      PDB.ModificationDate := ModificationDate;
      PDB.LastBackupDate := LastBackupDate;
      PDB.ModificationNumber := ModificationNumber;
      PDB.DbType := DbType;
      PDB.Creator := CreatorId;
      PDB.UniqueIdSeed := UniqueIdSeed;
    end;
    t.Options := Options.RemoteOptions;
    if Assigned(AppInfo) then DuplicateStream(AppInfo, PDB.AppInfo);
    if Assigned(SortInfo) then DuplicateStream(SortInfo, PDB.SortInfo);

    RecId := 0;
    DataSet.First;
    PDB.RecordCount := DataSet.RecordCount;

    while not DataSet.Eof do
    begin
      for ctr := 0 to DataSet.FieldCount-1 do
        t.Fields[ctr].AsString := DataSet.Fields[ctr].AsString;

      t.PublicLocalToRemoteRecord(pData, Size);
      try
        // Note: currently using an incrementing counter for assigning
        // record Ids. This may need to be replaced later with something better
        Inc(RecId);
        PDB.SetRecord(DataSet.RecNo-1, 0, RecId, 0, pData, Size);
      finally
        Dispose(pData);
      end;

      DataSet.Next;
    end;

  finally
    t.Free;
    PDB.Free;
  end;
end;

end.