pfgrecbuff.pas

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

unit pfgRecBuff;
{**************************************************************************}
{* pfgRecBuff Unit                                                        *}
{*                                                                        *}
{* This unit implements the TpfgRecordBuffer class, a small add-on class  *}
{* that scans through a Palm remote and builds a list of the primary key  *}
{* of each record. This is usefull for slow synchronization operations,   *}
{* where you don't want to keep scanning the entire table for every       *}
{* record on the local computer.                                          *}
{*                                                                        *}
{* Copyright (C) 2000-2002 by Paul Gilbert, All Rights Reserved           *}
{**************************************************************************}

interface

{$I pfgPalmConduits.inc}

{$IFDEF PFG_DELPHI6_UP}
uses pfgPalmDb, Classes, SysUtils, Variants;
{$ELSE}
uses pfgPalmDb, Classes, SysUtils;
{$ENDIF}

type
  TpfgRecordEntry = record
    Fields: Variant;
    RecordID: LongWord;
  end;
  PpfgRecordEntry = ^TpfgRecordEntry;

  TOnReadFieldEvent = procedure(Sender: TObject; ATable: TpfgPalmRemoteTable;
    FieldIndex: Integer; out Value: Variant) of object;

  TpfgRecordBuffer = class
  private
    FList: TList;
    FKeyFieldCount: Integer;
    FOnReadField: TOnReadFieldEvent;

    procedure SetKeyFieldCount(Value: Integer);
    function GetItems(Index: Integer): PpfgRecordEntry;
    function GetCount: Integer;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure Load(ATable: TpfgPalmRemoteTable);
    procedure AddCurrentRecord(ATable: TpfgPalmRemoteTable);
    procedure Clear;
    procedure AddRecord(KeyFields: Variant; ARecordID: LongWord);
    procedure RemoveRecord(KeyFields: Variant);

    function IndexOf(KeyFields: Variant): Integer; overload;
    function IndexOf(KeyFields: Array of Variant): Integer; overload;
    function RecordID(KeyFields: Variant): LongWord; overload;
    function RecordID(KeyFields: Array of Variant): LongWord; overload;

    property KeyFieldCount: Integer read FKeyFieldCount write SetKeyFieldCount;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: PpfgRecordEntry read GetItems; default;
    property OnReadField: TOnReadFieldEvent read FOnReadField write FOnReadField;
  end;

  EKeyFieldsError = class(Exception);

implementation

resourcestring
  SInvalidKeyFields = 'Invalid value passed for key fields count';
  SNumFieldsMismatch = 'Mismatch on the number of key fields';
  
constructor TpfgRecordBuffer.Create;
begin
  inherited Create;
  FList := TList.Create;
  FKeyFieldCount := 1;
end;

destructor TpfgRecordBuffer.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

procedure TpfgRecordBuffer.AddCurrentRecord(ATable: TpfgPalmRemoteTable);
var
  rec: PpfgRecordEntry;
  ctr: Integer;
  Data: Variant;
begin
  New(rec);
  FList.Add(rec);

  // Load up the primary key fields and the record's Record ID
  rec^.Fields := VarArrayCreate([0, KeyFieldCount-1], varVariant);
  for ctr := 0 to KeyFieldCount-1 do
  begin
    if not Assigned(FOnReadField) then Data := ATable.Fields[ctr].AsVariant
    else FOnReadField(Self, ATable, ctr, Data);

    rec^.Fields[ctr] := Data;
  end;
  rec^.RecordID := ATable.Fields.RecordID;
end;
// Load
// Loads the contents of the specified table into the list

procedure TpfgRecordBuffer.Load(ATable: TpfgPalmRemoteTable);

  function Lowest(A, B: Integer): Integer;
  begin
    if A < B then Result := A else Result := B;
  end;

begin
  Clear;
  if not ATable.Active then ATable.Active := True;
  if ATable.FieldDefs.Count < KeyFieldCount then
    raise Exception.Create('KeyFieldCount is greater than the number of fields');

  ATable.First;
  while not ATable.Eof do
  begin
    AddCurrentRecord(ATable);
    ATable.Next;
  end;
  ATable.First;
end;

// Clear
// Clears the contents of the list

procedure TpfgRecordBuffer.Clear;
var
  ctr: Integer;
begin
  for ctr := 0 to FList.Count-1 do
  begin
    VarClear(PpfgRecordEntry(FList[ctr])^.Fields);
    Dispose(FList[ctr]);
  end;

  FList.Clear;   
end;

// AddRecord
// Manually adds a record into the list

procedure TpfgRecordBuffer.AddRecord(KeyFields: Variant; ARecordID: LongWord);
var
  rec: PpfgRecordEntry;
begin
  New(rec);
  rec^.Fields := KeyFields;
  rec^.RecordID := ARecordID;
  FList.Add(rec);
end;

// RemoveRecord
// Removes the specified record

procedure TpfgRecordBuffer.RemoveRecord(KeyFields: Variant);
var
  Index: Integer;
begin
  Index := IndexOf(KeyFields);
  if Index <> -1 then
  begin
    VarClear(PpfgRecordEntry(FList[Index])^.Fields);
    Dispose(FList[Index]);
    FList.Delete(Index);
  end;
end;

// IndexOf
// Returns the index of the record with the specified primary fields

function TpfgRecordBuffer.IndexOf(KeyFields: Variant): Integer;
var
  ctr, fctr, fctr2: Integer;
  Flag: Boolean;
  p: PpfgRecordEntry;
begin
  if VarArrayHighBound(KeyFields, 1) <> KeyFieldCount-1 then
    raise EKeyFieldsError.Create(SNumFieldsMismatch);

  for ctr := 0 to Count-1 do
  begin
    Flag := True;
    // Compare the record
    p := Items[ctr];
    for fctr := 0 to KeyFieldCount-1 do
    begin
      if VarIsArray(p^.Fields[fctr]) then
      begin
        Flag := VarArrayHighBound(p^.Fields[fctr], 1) =
                VarArrayHighBound(KeyFields[fctr], 1);
        if Flag then
          for fctr2 := 0 to VarArrayHighBound(p^.Fields[fctr], 1) do
            if p^.Fields[fctr][fctr2] <> KeyFields[fctr][fctr2] then
            begin
              Flag := False;
              Break;
            end;
        if not Flag then Break;
      end
      else if p^.Fields[fctr] <> KeyFields[fctr] then
      begin
        Flag := False;
        Break;
      end;
    end;
    
    if Flag then
    begin
      Result := ctr;
      Exit;
    end;
  end;

  Result := -1;
end;

// IndexOf Overloaded
// Alternate version that allows passing of an open array of variants

function TpfgRecordBuffer.IndexOf(KeyFields: Array of Variant): Integer;
var
  V: Variant;
  ctr: Integer;
begin
  V := VarArrayCreate([0, Length(KeyFields)-1], varVariant);
  for ctr := 0 to Length(KeyFields)-1 do V[ctr] := KeyFields[ctr];
  Result := IndexOf(V);
end;

// RecordID
// Returns the record ID for the specified record

function TpfgRecordBuffer.RecordID(KeyFields: Variant): LongWord;
var
  Index: Integer;
begin
  Index := IndexOf(KeyFields);
  if Index <> -1 then
    Result := Items[Index].RecordID
  else
    // No record found
    Result := 0;
end;

// RecordID Overloaded
// Alternate version that accepts an open array of variants

function TpfgRecordBuffer.RecordID(KeyFields: Array of Variant): LongWord;
var
  V: Variant;
  ctr: Integer;
begin
  V := VarArrayCreate([0, Length(KeyFields)-1], varVariant);
  for ctr := 0 to Length(KeyFields)-1 do V[ctr] := KeyFields[ctr];
  Result := RecordID(V);
end;

// SetKeyFieldCount
// Sets the number of primary key fields to use

procedure TpfgRecordBuffer.SetKeyFieldCount(Value: Integer);
begin
  if Value < 1 then raise EKeyFieldsError.Create(SInvalidKeyFields);
  FKeyFieldCount := Value;
end;

// GetCount
// Returns the number of records in the list

function TpfgRecordBuffer.GetCount: Integer;
begin
  Result := FList.Count;
end;

// GetItems
// Returns the item at the specified index

function TpfgRecordBuffer.GetItems(Index: Integer): PpfgRecordEntry;
begin
  Result := PpfgRecordEntry(FList[Index]);
end;

end.