pfgpalmdb.pas

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

    FData[Index] := Value
  else
  begin
    Low := VarArrayLowBound(Value, 1);
    SetLength(s, VarArrayHighBound(Value, 1) - Low + 1);
    for ctr := 1 to Length(s) do
      s[ctr] := Chr(Byte(Value[ctr+Low-1]));
    FData[Index] := s;
  end;
end;

function TpfgPalmRemoteTable.GetRecordFlags: Byte;
begin
  Result := FRecordFlags;
end;

procedure TpfgPalmRemoteTable.SetRecordFlags(AFlags: Byte);
begin
  FRecordFlags := AFlags;
end;

function TpfgPalmRemoteTable.GetRecordID: LongWord;
begin
  Result := FRecordID;
end;

procedure TpfgPalmRemoteTable.SetRecordID(Value: LongWord);
begin
  FRecordID := Value;
end;

function TpfgPalmRemoteTable.GetRecordCategory: Shortint;
begin
  Result := FRecordCategory;
end;

procedure TpfgPalmRemoteTable.SetRecordCategory(ACategory: Shortint);
begin
  FRecordCategory := ACategory;
end;

function TpfgPalmRemoteTable.GetIsEmpty: Boolean;
begin
  Result := FRecordEmpty;
end;

{==========================================================================}
{= Property handler methods                                               =}
{=                                                                        =}
{==========================================================================}

// SetHandle
// Sets the HotSync Palm database to use

procedure TpfgPalmRemoteTable.SetHandle(AHandle: Byte);
begin
  if FHandle <> AHandle then
  begin
    if FHandle <> 0 then Close;             // Close the active database
    FHandle := AHandle;
  end;
end;

// GetActive
// Returns true if the database is active

function TpfgPalmRemoteTable.GetActive: Boolean;
begin
  Result := FHandle <> 0;
end;

// SetActive
// Sets whether the database is active

procedure TpfgPalmRemoteTable.SetActive(AActive: Boolean);
begin
  if GetActive <> AActive then
  begin
    if csDesigning in ComponentState then raise
      EPalmDbError.Create(SRuntimeError);

    if AActive then
    begin
      DoBeforeOpen;
      OpenDatabase;
      FState := psBrowse;
      DoAfterOpen;
    end
    else
    begin
      DoBeforeClose;
      CloseDatabase;
      FState := psInactive;
      DoAfterClose;
    end;
  end;
end;

function TpfgPalmRemoteTable.GetTableName: string;
begin
  Result := FTableName;
end;

procedure TpfgPalmRemoteTable.SetTableName(AName: string);
begin
  if AName <> FTableName then
  begin
    Close;                        // Make sure database is closed
    FTableName := AName;
  end;
end;

// SetCreatorID
// Sets the creator ID to use

procedure TpfgPalmRemoteTable.SetCreatorID(AID: string);
begin
  if FCreatorID = AID then Exit;
  Close;                          // Make sure database is closed

  // Try and convert the creator ID to a value - this will generate an
  // exception if the creator id is malformed
  StrToCreatorID(AID);

  FCreatorID := AID;
end;

// SetTableType
// Sets the tabletype

procedure TpfgPalmRemoteTable.SetTableType(AType: string);
begin
  if FTableType = AType then Exit;
  Close;                          // Make sure database is closed

  if not IsCreatorID(AType) then
    raise EPalmDbError.CreateFmt(STableTypeError, [AType]);

  FTableType := AType;
end;

procedure TpfgPalmRemoteTable.SetVersion(AVersion: Word);
begin
  if FVersion <> AVersion then
  begin
    Close;                        // Make sure database is closed
    FVersion := AVersion;
  end;
end;

function TpfgPalmRemoteTable.GetOptions: TpfgPalmRemoteTableOptions;
begin
  Result := FOptions;
end;

procedure TpfgPalmRemoteTable.SetOptions(AOptions: TpfgPalmRemoteTableOptions);
begin
  if AOptions <> FOptions then
  begin
    Close;                        // Make sure database is closed
    FOptions := AOptions;
  end;
end;

// GetAppInfo
// Returns the AppInfo block pointer

function TpfgPalmRemoteTable.GetAppInfo: TpfgModifiedMemoryStream;
begin
  Result := FAppInfo;
end;

// SetAppInfo
// Sets the database application info block

procedure TpfgPalmRemoteTable.SetAppInfo(AInfo: TpfgModifiedMemoryStream);
begin
  if not Active then raise EPalmDbError.Create(SNotActiveError);
  if ReadOnly then raise EPalmDbError.Create(SReadOnlyError);

  FAppInfo.Clear;
  FAppInfo.LoadFromStream(AInfo);
end;

// GetCategoryFilter
// Gets the current active cateogry filter (-1 for none)

function TpfgPalmRemoteTable.GetCategoryFilter: Shortint;
begin
  Result := FCategoryFilter;
end;

// SetCategoryFilter
// Sets the active category filter. Valid category numbers are from 0 - 14,
// or -1 for no filtering

procedure TpfgPalmRemoteTable.SetCategoryFilter(ACategory: Shortint);
begin
  if FCategoryFilter = ACategory then Exit;

  if not Active then raise EPalmDbError.Create(SNotActiveError);
  if State in [psEdit, psInsert] then raise EPalmDbError.Create(SEditModeError);

  // Validate that the category is correct
  if not ((ACategory = -1) or ((ACategory >= 0) and (ACategory <= 14))) then
    raise EPalmDbError.CreateFmt(SCategoryError, [ACategory]);

  FCategoryFilter := ACategory;
  DoBeforeRecChange;
  GetNextRecord;
  DoAfterRecChange;
end;

// GetState
// Returns the active state of the table

function TpfgPalmRemoteTable.GetState: TpfgPalmDataSetState;
begin
  Result := FState;
end;

function TpfgPalmRemoteTable.GetRecordCount: Integer;
var
  NumRecs: Word;
begin
  if not Active then raise EPalmDbError.Create(SNotActiveError);

  PalmCheck(SyncGetDbRecordCount(FHandle, NumRecs));
  Result := NumRecs;
end;

function TpfgPalmRemoteTable.GetRecNum: Integer;
begin
  if not Active then raise EPalmDbError.Create(SNotActiveError);

  Result := FRecNum;
end;

procedure TpfgPalmRemoteTable.SetRecNum(ARecNum: Integer);
var
  info: CRawRecordInfo;
  rCount: Integer;
begin
  if not Active then raise EPalmDbError.Create(SNotActiveError);
  if State in [psEdit, psInsert] then raise EPalmDbError.Create(SEditModeError);

  DoBeforeRecChange;

  rCount := RecordCount;
  if (ARecNum < 0) or (ARecNum > rCount) then
    raise EPalmDbError.CreateFmt(SInvalidRecNumError, [ARecNum]);

  FRecNum := ARecNum;
  if FRecNum = rCount then
  begin
    InitRecord;
    FEOF := True;
  end;

  // Move to the specified record
  GetMem(info.m_pBytes, MaxRecordSize);
  try
    info.m_TotalBytes := MaxRecordSize;
    info.m_FileHandle := FHandle;
    info.m_RecIndex := ARecNum;
    info.m_Attribs := 0;
    info.m_dwReserved := 0;

    PalmCheck(SyncReadRecordByIndex(info));
    FRecordCategory := info.m_catID;
    FRecordID := info.m_recId;

    RemoteRecordToLocal(info.m_pBytes, info.m_RecSize);

    if FRecNum <> 0 then FBOF := False;
    DoAfterRecChange;

  finally
    Dispose(info.m_pBytes);
  end;
end;

// GetBOF
// Returns true if at the beginning of the table

function TpfgPalmRemoteTable.GetBOF: Boolean;
begin
  if not Active then raise EPalmDbError.Create(SNotActiveError);

  Result := FRecNum = 0;
//  Result := FBOF;
end;

// GetEOF
// Returns true if at the end of the file

function TpfgPalmRemoteTable.GetEOF: Boolean;
begin
  if not Active then raise EPalmDbError.Create(SNotActiveError);

  Result := FRecNum >= RecordCount;
  // Result := FEOF;
end;

// SetDbFlags
// Sets the database flags for the table

procedure TpfgPalmRemoteTable.SetDbFlags(Value: TpfgPalmRemoteTableFlags);
begin
  // Error checking added because some people didn't realise that the
  // database flags could only be set prior to creating the table
  if Active then raise EPalmDbError.Create(SActiveError);
  FdbFlags := Value;
end;

// SetDbSaving
// Sets the DbSaving flag. If it is being turned on, also calls the table's
// InitRecord method to set up an empty dataset

procedure TpfgPalmRemoteTable.SetDbSaving(Value: Boolean);
begin
  FDbSaving := Value;
  if FDbSaving then InitRecord;
end;

{==========================================================================}
{= Internal support methods                                               =}
{=                                                                        =}
{==========================================================================}

// OpenDatabase
// Opens the remote Palm database

procedure TpfgPalmRemoteTable.OpenDatabase;
var
  openMode: Byte;
  RetVal: Integer;
//  d: CDbCreateDB;
  info: CDbGenInfo;
begin
  { Open up the database for access }
  // Work out the open mode
  openMode := eDbRead;
  if not ReadOnly then openMode := openMode or eDbWrite;
  if (opShowSecret in FOptions) then openMode := openMode or eDbShowSecret;

  // Try and open the table
  RetVal := SyncOpenDb(PChar(FTableName), FCardNum, FHandle, openMode);
  if (RetVal <> 0) {and (RetVal <> SYNCERR_NOT_FOUND)} then PalmError(RetVal);

  // Read in the AppInfo block
  GetMem(info.m_pBytes, MaxRecordSize);
  try
    info.m_TotalBytes := MaxRecordSize;
    info.m_dwReserved := 0;
    SyncReadDbAppInfoBlock(FHandle, info);

    // Store it in the app info stream
    ReallocMem(info.m_pBytes, info.m_BytesRead);
    FAppInfo.Clear;
    FAppInfo.Write(info.m_pBytes^, info.m_BytesRead);
  finally
    Dispose(info.m_pBytes);
  end;

  // Initialize the record set
  InitRecord;

  // Get in the first record, if any
  FRecNum := 0;
  GetNextRecord;
end;

procedure TpfgPalmRemoteTable.CloseDatabase;
var
  RetVal: Integer;
  info: CDbGenInfo;
begin
  // Save app info if modified
  if FAppInfo.Modified then
  begin
    // Fill out parameter block
    info.m_pBytes := FAppInfo.Memory;
    info.m_TotalBytes := FAppInfo.Size;
    info.m_BytesRead := FAppInfo.Size;
    info.m_dwReserved := 0; //Reserved
    SyncWriteDBAppInfoBlock(FHandle, info);
  end;

  // Close the database
  RetVal := SyncCloseDb(FHandle);
  FHandle := 0;
  if RetVal <> 0 then PalmError(RetVal);
end;

// GetNextRecord
// Reads in the next record from the database

procedure TpfgPalmRemoteTable.GetNextRecord;
var
  info: CRawRecordInfo;
  RetVal: Integer;
begin
  GetMem(info.m_pBytes, MaxRecordSize);

  try
    info.m_FileHandle := FHandle;
    info.m_TotalBytes := MaxRecordSize;
    info.m_dwReserved := 0;

    if CategoryFilter <> -1 then
    begin
      info.m_CatId := FCategoryFilter;
      if opModified in FOptions then
        RetVal := SyncReadNextModifiedRecInCategory(info)
      else
        RetVal := SyncReadNextRecInCategory(info);
    end
    else
    begin
      info.m_CatId := 0;

      if opModified in FOptions then
        RetVal := SyncReadNextModifiedRec(info)
      else
      begin
        // Get the specified record
        info.m_RecIndex := FRecNum;