pfgpalmdb.pas

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

begin
  FFields[Index].AsVariant := AField.AsVariant;
end;

// GetFlags
// Returns the flags for the record

function TpfgPalmFields.GetFlags: Byte;
begin
  Result := Owner.GetRecordFlags;
end;

// SetFlags
// Sets the flags for the record

procedure TpfgPalmFields.SetFlags(AFlags: Byte);
begin
  Owner.SetRecordFlags(AFlags);
end;

function TpfgPalmFields.GetRecordID: LongWord;
begin
  Result := Owner.GetRecordID;
end;

procedure TpfgPalmFields.SetRecordID(AID: LongWord);
begin
  Owner.SetRecordID(AID);
end;

function TpfgPalmFields.GetCategory: Shortint;
begin
  Result := Owner.GetRecordCategory;
end;

procedure TpfgPalmFields.SetCategory(ACategory: Shortint);
begin
  Owner.SetRecordCategory(ACategory);
end;

function TpfgPalmFields.GetIsEmpty: Boolean;
begin
  Result := Owner.GetIsEmpty;
end;

{**************************************************************************}
{* TpfgPalmTable class                                                       *}
{*                                                                        *}
{**************************************************************************}

constructor TpfgPalmTable.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFieldDefs := TpfgPalmFieldDefs.Create(Self);
  FFields := TpfgPalmFields.Create(Self);

  // Initialize event handler pointers
  FOnBeforeClose     := nil;
  FOnAfterClose      := nil;
  FOnBeforeOpen      := nil;
  FOnAfterOpen       := nil;
  FOnBeforeRecChange := nil;
  FOnAfterRecChange  := nil;
  FOnBeforeEdit      := nil;
  FOnAfterEdit       := nil;
  FOnBeforeInsert    := nil;
  FOnAfterInsert     := nil;
  FOnBeforePost      := nil;
  FOnAfterPost       := nil;
  FOnBeforeCancel    := nil;
  FOnAfterCancel     := nil;
  FOnReadField       := nil;
  FOnWriteField      := nil;
end;

destructor TpfgPalmTable.Destroy;
begin
  FFieldDefs.Free;
  FFields.Free;
  inherited Destroy;
end;

{==========================================================================}
{= Junction methods for embedded methods                                  =}
{=                                                                        =}
{==========================================================================}

procedure TpfgPalmTable.FieldDefChanged;
begin
  // Do nothing
end;

{==========================================================================}
{= Event dispatch methods                                                 =}
{=                                                                        =}
{==========================================================================}

procedure TpfgPalmTable.DoBeforeClose;
begin
  if Assigned(FOnBeforeClose) then FOnBeforeClose(Self);
end;

procedure TpfgPalmTable.DoAfterClose;
begin
  if Assigned(FOnAfterClose) then FOnAfterClose(Self);
end;

procedure TpfgPalmTable.DoBeforeOpen;
begin
  if Assigned(FOnBeforeOpen) then FOnBeforeOpen(Self);
end;

procedure TpfgPalmTable.DoAfterOpen;
begin
  if Assigned(FOnAfterOpen) then FOnAfterOpen(Self);
end;

procedure TpfgPalmTable.DoBeforeRecChange;
begin
  if Assigned(FOnBeforeRecChange) then FOnBeforeRecChange(Self);
end;

procedure TpfgPalmTable.DoAfterRecChange;
begin
  if Assigned(FOnAfterRecChange) then FOnAfterRecChange(Self);
end;

procedure TpfgPalmTable.DoBeforeEdit;
begin
  if Assigned(FOnBeforeEdit) then FOnBeforeEdit(Self);
end;

procedure TpfgPalmTable.DoAfterEdit;
begin
  if Assigned(FOnAfterEdit) then FOnAfterEdit(Self);
end;

procedure TpfgPalmTable.DoBeforeInsert;
begin
  if Assigned(FOnBeforeInsert) then FOnBeforeInsert(Self);
end;

procedure TpfgPalmTable.DoAfterInsert;
begin
  if Assigned(FOnAfterInsert) then FOnAfterInsert(Self);
end;

procedure TpfgPalmTable.DoBeforePost;
begin
  if Assigned(FOnBeforePost) then FOnBeforePost(Self);
end;

procedure TpfgPalmTable.DoAfterPost;
begin
  if Assigned(FOnAfterPost) then FOnAfterPost(Self);
end;

procedure TpfgPalmTable.DoBeforeCancel;
begin
  if Assigned(FOnBeforeCancel) then FOnBeforeCancel(Self);
end;

procedure TpfgPalmTable.DoAfterCancel;
begin
  if Assigned(FOnAfterCancel) then FOnAfterCancel(Self);
end;

procedure TpfgPalmTable.DoBeforeDelete;
begin
  if Assigned(FOnBeforeDelete) then FOnBeforeDelete(Self);
end;

procedure TpfgPalmTable.DoAfterDelete;
begin
  if Assigned(FOnAfterDelete) then FOnAfterDelete(Self);
end;

procedure TpfgPalmTable.DoBeforeTableCreate;
begin
  if Assigned(FOnBeforeTableCreate) then FOnBeforeTableCreate(Self);
end;

procedure TpfgPalmTable.DoAfterTableCreate;
begin
  if Assigned(FOnAfterTableCreate) then FOnAfterTableCreate(Self);
end;

procedure TpfgPalmTable.DoReadField(pData: Pointer; DataSize: Integer;
  FieldIndex: Integer; var DataPos: LongWord; out Data: string);
begin
  if Assigned(FOnReadField) then
    FOnReadField(Self, pData, DataSize, FieldIndex, DataPos, Data);
end;

procedure TpfgPalmTable.DoWriteField(FieldIndex: Integer; DataPos: Integer;
  out Data: Variant);
begin
  if Assigned(FOnWriteField) then
    FOnWriteField(Self, FieldIndex, DataPos, Data);
end;

{==========================================================================}
{= Miscellaneous standard implementations                                 =}
{=                                                                        =}
{==========================================================================}

procedure TpfgPalmTable.Open;
begin
  Active := True;
end;

procedure TpfgPalmTable.Close;
begin
  Active := False;
end;

// FindField
// Returns a reference to the specified field, or nil if not found

function TpfgPalmTable.FindField(FieldName: string): TpfgPalmField;
var
  ctr: Integer;
begin
  for ctr := 0 to FieldCount-1 do
    if AnsiCompareText(Fields[ctr].FieldName, FieldName) = 0 then
    begin
      Result := Fields[ctr];
      Exit;
    end;

  Result := nil;
end;

// FieldByName
// Similar to FindField, but it raises an exception if the specified field
// isn't found

function TpfgPalmTable.FieldByName(FieldName: string): TpfgPalmField;
begin
  Result := FindField(FieldName);
  if not Assigned(Result) then raise EPalmDbError.CreateFmt(SFieldNotFound, [FieldName]);
end;

function TpfgPalmTable.Exists: Boolean;
begin
  Result := False;
end;

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

procedure TpfgPalmTable.SetFieldDefs(AFieldDefs: TpfgPalmFieldDefs);
begin
  FFieldDefs.Assign(AFieldDefs);
end;

procedure TpfgPalmTable.SetFields(AFields: TpfgPalmFields);
begin
  FFields.Assign(AFields);
end;

function TpfgPalmTable.GetFieldCount: Integer;
begin
  Result := FFieldDefs.Count;
end;

function TpfgPalmTable.GetReadOnly: Boolean;
begin
  Result := FReadOnly;
end;

procedure TpfgPalmTable.SetReadOnly(AReadOnly: Boolean);
begin
  FReadOnly := AReadOnly;
end;

{**************************************************************************}
{* TpfgPalmRemoteTable class                                                 *}
{*                                                                        *}
{**************************************************************************}

constructor TpfgPalmRemoteTable.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHandle := 0;                        // Inactive
  FAppInfo := TpfgModifiedMemoryStream.Create; // Create stream for app info
  FData := TStringList.Create;              // list for storing record data
  FAppInfo.Modified := False;
  FReadOnly := False;                  // Read only flag
  FTableName := '';                    // Table name
  FVersion := $0100;                   // Table version (1.0)
  FTableType := 'DATA';                // Default table type
  FCategoryFilter := -1;               // No category filtering
  FOptions := [];
  FState := psInactive;                // Table is inactive
  FdbFlags := [];
  FRecordFlags := 0;
  FRecordID := $FFFFFFFF;
  FRecordEmpty := False;
  FCardNum := CARD_NUM;

  FDbSaving := False;

  FRecNum := -1;
  FBOF := True; FEOF := True;          // Flags for at beginning/end of file

  // If the component has just been dropped on a form at design time, then
  // try and grab a copy of the conduit's creator ID
  FCreatorID := '';
  if csDesigning in ComponentState then
    FCreatorID := ConduitCreatorID;
end;

destructor TpfgPalmRemoteTable.Destroy;
begin
  // If the database is active, then close it - any exceptions are
  // suppressed, since we can't abort out of a component destruction
  if Active then
  begin
    try
      CloseDatabase;
    except
    end;
  end;

  FAppInfo.Free;
  FData.Free;

  inherited Destroy;
end;

{==========================================================================}
{= Overriden inherited methods                                            =}
{=                                                                        =}
{==========================================================================}

// Loaded
// After the component is loaded, check if there is a Creator ID assigned,
// and if not, attempt to dynamically assign one

procedure TpfgPalmRemoteTable.Loaded;
begin
  inherited Loaded;

  if FCreatorID = '' then FCreatorID := ConduitCreatorID;
end;

{==========================================================================}
{= Junction methods for embedded methods                                  =}
{=                                                                        =}
{==========================================================================}

// FieldDefChanged
// When the field definitions change, update the fields list

procedure TpfgPalmRemoteTable.FieldDefChanged;
begin
  FFields.Update;
end;

// GetFieldValue
// Gets a field value from a loaded record

function TpfgPalmRemoteTable.GetFieldValue(Index: Integer): Variant;
var
  ctr: Integer;
  s: string;
  dt: TDateTime;
  si: Single;
  d: Double;
begin
  if not Active then raise EPalmDbError.Create(SNotActiveError);

  case FFieldDefs[Index].DataType of
    ptByte, ptWord, ptLong:
      if FData[Index] = '' then Result := 0
      else Result := StrToInt(FData[Index]);

    ptString, ptInt64:
      // Int64s are treated like strings, since a variant can't hold it
      Result := FData[Index];

    ptSingle:
    begin
      if FData[Index] = '' then si := 0.0
      else si := StrToFloat(FData[Index]);
      Result := si;
    end;

    ptDouble:
    begin
      if FData[Index] = '' then d := 0.0
      else d := StrToFloat(FData[Index]);
      Result := d;
    end;

    ptDate, ptTime, ptDateTime:
    begin
      if FData[Index] = '' then Result := ''
      else
      begin
        dt := StrToDateTime(FData[Index]);
        Result := dt;
      end;
    end;

    ptCustom:
    begin
      s := FData[Index];
      Result := VarArrayCreate([0, Length(s)-1], varByte);
      for ctr := 1 to Length(s) do
        Result[ctr-1] := Byte(s[ctr]);
    end;
  end;
end;

procedure TpfgPalmRemoteTable.SetFieldValue(Index: Integer; Value: Variant);
var
  ctr: Integer;
  Low: Integer;
  s: string;
begin
  if (not DbSaving) and (not Active) then raise EPalmDbError.Create(SNotActiveError);
  if ReadOnly then raise EPalmDbError.Create(SReadOnlyError);

  if not VarIsArray(Value) then