pfgpalmdb.pas

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

        RetVal := SyncReadRecordByIndex(info);
      end;
    end;

    // Reset the record saved flag
    FRecordSaved := False;

    // Check the result
    if RetVal = SYNCERR_NOT_FOUND then
    begin
      // Must be end of table
      FRecNum := RecordCount;
      FRecordFlags := 0;
      FRecordID := 0;
      FRecordCategory := FCategoryFilter;
      Exit;
    end
    else if RetVal <> 0 then PalmError(RetVal);

    // Retrieve the data from the remote record
    RemoteRecordToLocal(info.m_pBytes, info.m_RecSize);

    FRecordFlags := info.m_Attribs;
    FRecordID := info.m_RecId;
    FRecordCategory := info.m_CatId;

    FBOF := False;
  finally
    Dispose(info.m_pBytes);
  end;
end;

// PostRecord
// Saves the edited record to the database. Checks the current state to
// determine whether it's a new record or an existing one

procedure TpfgPalmRemoteTable.PostRecord;
var
  info: CRawRecordInfo;
  rec: Pointer;
  recSize: LongWord;
begin
  LocalToRemoteRecord(rec, recSize);
  try
    FillChar(info, Sizeof(info), 0);
    info.m_FileHandle := FHandle;
    if FState = psEdit then info.m_RecId := FRecordID  // Existing record
    else info.m_RecID := 0;                            // New one

    info.m_Attribs := FRecordFlags;                 // Record attributes

    if FRecordCategory = -1 then info.m_CatId := 0
    else info.m_CatId := FRecordCategory;
    info.m_pBytes := rec;
    info.m_RecSize := recSize;
    info.m_TotalBytes := recSize;
    PalmCheck(SyncWriteRec(info));
    FRecordID := info.m_RecId;      // Read back the new record ID
    // Read out the record number if it was an insert
    if FState = psInsert then FRecNum := RecordCount;
  finally
    Dispose(rec);
  end;
end;

// DeleteRecord
// Deletes the record with the specified record ID

procedure TpfgPalmRemoteTable.DeleteRecord(ARecID: LongWord);
var
  info: CRawRecordInfo;
begin
  DoBeforeDelete;

  FillChar(info, Sizeof(info), 0);
  info.m_FileHandle := FHandle;
  info.m_RecID := ARecID;
  PalmCheck(SyncDeleteRec(info));

  DoAfterDelete;
end;

// InitRecord
// Initializes the record buffer. This basically involves filling up the
// data string list with a blank entry for each field

procedure TpfgPalmRemoteTable.InitRecord;
var
  ctr: Integer;
begin
  FData.Clear;
  for ctr := 1 to FieldDefs.Count do
    FData.Add('');
end;

// RemoteRecordToLocal
// This method takes a remote record read in from the Palm, and using the
// current field definitions, converts the data it contains into a list of
// strings stored in the FData string list

procedure TpfgPalmRemoteTable.RemoteRecordToLocal(const pData: Pointer; Size: LongWord);
var
  Index: Integer;
  ptr: LongWord;
  FieldSize: Integer;
  p: PByte;
  sValue: string;
  Data: string;
  vSingle: LongWord;
  vDouble: Int64;
  pLW: PLongWord;
  v: Int64;
begin
  InitRecord;

  // Check whether the record is empty
  FRecordEmpty := Size = 0;
  if FRecordEmpty then Exit;

  ptr := 0;
  for Index := 0 to FieldDefs.Count-1 do
  begin
    // Check to see whether a field handler has been set
    if Assigned(FOnReadField) then
    begin
      try
        FOnReadField(Self, pData, Size, Index, ptr, Data);
        FData[Index] := Data;

        // Field handled, so move onto next field
        Continue;

      except
        // Suppress any abort and fall back on standard field handling
        on EAbort do
        begin
        end;
      end;
    end;

    // If number aligning is on, check if the field is a 2 or 4 byte number,
    // and if so, make sure it's on a word boundary
    if (opNumAlign in FOptions) and (ptr mod 2 = 1) and
       (PalmFieldSize[FieldDefs[Index].DataType] mod 2 = 0) then
      Inc(ptr);

    // Work out the field size
    FieldSize := PalmFieldSize[FieldDefs[Index].DataType];
    if FieldSize = -1 then FieldSize := FieldDefs[Index].Size;

    // Make sure the field is within the physical record
    if ptr >= LongWord(Size) then
    begin
      if not FieldDefs.StrictFields then Break   // Finished mapping fields
      else raise EPalmDbError.Create(SFieldMappingError);
    end;
    if (FieldSize > 0) and (ptr + LongWord(FieldSize) > LongWord(Size)) then
      raise EPalmDbError.Create(SFieldMappingError);

    // Get the value
    p := PByte(LongWord(pData) + ptr);

    if FieldDefs[Index].DataType = ptString then
    begin
      { String type }
      if (FieldSize = 0) or ((FieldSize > 0) and
         (Integer(StrLen(PChar(p))) < FieldSize)) then
      begin
        sValue := StrPas(PChar(p))
      end
      else
      begin
        // Special case: fixed size string field completely full up
        SetLength(sValue, FieldSize);
        Move(PChar(p)^, sValue[1], FieldSize);
      end;

      // Increment the pointer
      if FieldSize > 0 then Inc(ptr, FieldSize)
      else Inc(ptr, Length(sValue)+1); // Variable length string, past NULL
    end
    else
    begin
      { Handle remaining data types }
      case FieldDefs[Index].DataType of
        ptByte: sValue := IntToStr(p^);
        ptWord: sValue := IntToStr(ReverseVal(PWord(p)^, 2));
        ptLong: sValue := IntToStr(Integer(ReverseVal(PInteger(p)^, 4)));
        ptDate: sValue := DateToStr(PalmDateToDateTime(ReverseVal(PWord(p)^, 2)));
        ptTime: sValue := PalmTimeToTimeStr(PTimeType(p)^);
        ptDateTime: sValue := DateTimeToStr(PalmDateTimeToDateTime(pDateTimeType(p)^));
        ptInt64:
        begin
          // The conversion is somewhat broken up because the combined
          // version kept crashing Kernel32.dll for some reason
          pLW := PLongWord(p);
          v := ReverseVal(pLW^, 4) shl 32;
          Inc(pLW);
          v := v + ReverseVal(pLW^, 4);

          sValue := IntToStr(v);
        end;
        ptSingle:
        begin
          vSingle := ReverseVal(PLongWord(p)^, 4);
          sValue := FloatToStr(PSingle(@vSingle)^);
        end;
        ptDouble:
        begin
          vDouble := ReverseVal(PInt64(p)^, 8);
          sValue := FloatToStr(PDouble(@vDouble)^);
        end;
      else
        // ptCustom: Unknown data block, so store as a representative string
        SetLength(sValue, FieldSize);
        Move(PChar(p)^, sValue[1], FieldSize);
      end;

      Inc(ptr, FieldSize);
    end;

    // Add the string value into the data list
    FData[Index] := sValue;

    // Handle string alignment processisng
    if FieldDefs[Index].DataType = ptString then
    begin
      if (not (opStringsAlign in Options)) or
         ((Index < FieldDefs.Count-1) and (FieldDefs[Index+1].DataType = ptString)) then
        Continue;
    end;
    
    // Make sure the pointer is on an alignment boundary for the next field,
    // if there is an alignment entry setting
    if (FieldDefs.Alignment <> 0) and
       (ptr mod FieldDefs.Alignment <> 0) then
      ptr := ((ptr + FieldDefs.Alignment - 1) div FieldDefs.Alignment) *
        FieldDefs.Alignment;
  end;
end;

// LocalToRemoteRecord
// This method creates a data block that represents the Palm record for the
// current field data contained in the FData string list. It is the
// responsibility of the caller to free the memory when finished with it

procedure TpfgPalmRemoteTable.LocalToRemoteRecord(out pData: Pointer; out Size: LongWord);
const
  SRecordError = 'LocalToRemoteRecord: Record went beyond it''s limits';
var
  Index, ctr: Integer;
  FieldSize: Integer;
  ptr: LongWord;
  p: PByte;
  fsize: Integer;
  vData: Variant;
  vSingle: Single;
  vDouble: Double;
  v: Int64;
  pLW: PLongWord;

  function StrToInt(const s: string): Integer;
  begin
    if s = '' then Result := 0
    else Result := SysUtils.StrToInt(s);
  end;

  function StrToInt64(const s: string): Int64;
  begin
    if s = '' then Result := 0
    else Result := SysUtils.StrToInt64(s);
  end;

  function StrToFloat(const s: string): Double;
  begin
    if s = '' then Result := 0.0
    else Result := SysUtils.StrToFloat(s);
  end;

  function StrToDate(const S: string): TDateTime;
  begin
    if s = '' then Result := 0
    else Result := SysUtils.StrToDate(s);
  end;

  function StrToDateTime(const S: string): TDateTime;
  begin
    if s = '' then Result := 0
    else Result := SysUtils.StrToDateTime(s);
  end;

begin
  // Firstly we need to work out how much memory needs to be allocated, by
  // totalling up the size of each individual field
  Size := 0;
  for Index := 0 to FieldDefs.Count-1 do
  begin
    // If a write field event handler is set, use it in preference
    if Assigned(FOnWriteField) then
    begin
      // At this stage we are merely finding out how much space to allocate
      // for storage; we will later loop again to get the actual data. This
      // means that the data returned from looping through the fields
      // multiple times must remain identical
      try
        FonWriteField(Self, Index, Size, vData);
        Inc(Size, VarArrayHighBound(vData, 1)+1);
        Continue;

      except
        // Suppress any aborts and allow standard field handling to go forward
        on EAbort do
        begin
        end;
      end;
    end;

    // Get the field size
    FieldSize := PalmFieldSize[FieldDefs[Index].DataType];
    if FieldSize = -1 then FieldSize := FieldDefs[Index].Size;

    if FieldSize > 0 then Inc(Size, FieldSize)
    else
    begin
      // Variable length string, or custom data block. For strings, the size
      // is the string length plus 1 for the NULL terminator. For custom data
      // blocks, it's just the length of the data itself
      if FieldDefs[Index].DataType = ptString then
        Inc(Size, Length(FData[Index])+1)
      else
        Inc(Size, Length(FData[Index]));
    end;

    // Alignment control handler for variable length strings
    if (FieldDefs[Index].DataType = ptString) and
       (FieldDefs[Index].Size = 0) then
    begin
      // Don't perform alignment control if the following field is also
      // a string, or if the string alignment flag is not set in the options
      if ((Index+1 < FieldDefs.Count) and (FieldDefs[Index+1].DataType = ptString)) or
         (not (opStringsAlign in Options)) then
        // Skip over alignment adjust
        Continue;
    end;

    // Handle rounding up to alignment boundary
    if (FieldDefs.Alignment <> 0) and
       (Size mod FieldDefs.Alignment <> 0) then
      Size := ((Size + FieldDefs.Alignment - 1) div FieldDefs.Alignment) *
        FieldDefs.Alignment;
    if (opNumAlign in FOptions) and (Size mod 2 <> 0) and
       (PalmFieldSize[FieldDefs[Index].DataType] mod 2 = 0) then
      Inc(Size);
  end;

  // Alloacte the memory for the record
  GetMem(pData, Size);

  // Loop through filling out the contents of the record with each field
  ptr := 0;
  for Index := 0 to FieldDefs.Count-1 do
  begin
    // Get a pointer to the start of field
    p := PByte(LongWord(pData) + ptr);

    // If a write field event handler is set, use it to get the data
    if Assigned(FOnWriteField) then
    begin
      try
        FOnWriteField(Self, Index, ptr, vData);
        for ctr := 0 to VarArrayHighBound(vData, 1) do
        begin
          if ptr >= Size then raise Exception.Create(SRecordError);
          p^ := vData[ctr];
          Inc(p); Inc(ptr);
        end;
        Continue;

      except
        on EAbort do
        begin
        end;
      end;
    end;

    // Get the field size
    FieldSize := PalmFieldSize[FieldDefs[Index].DataType];
    if FieldSize = -1 then FieldSize := FieldDefs[Index].Size;

    // Handle word alignment if dealing with a word or long value
    if (opNumAlign in FOptions) and (ptr mod 2 <> 0) and
       (PalmFieldSize[FieldDefs[Index].DataType] mod 2 = 0) then
    begin
      Inc(ptr);
      Inc(p);
    end;

    if FieldDefs[Index].DataType = ptString then
    begin
      { String type }
      if FieldSize <= 0 then
      begin
        if ptr + LongWord(Length(FData[Index])) > Size then
          Exception.Create(SRecordError);
        StrPCopy(PChar(p), FData[Index]);
        Inc(ptr, Length(FData[Index])+1);
      end
      else
      begin
        if ptr + LongWord(FieldSize) > Size then Exception.Create(SRecordError);
        FillChar(p^, FieldSize, 0); // Blank out the entire strings
        StrLCopy(PChar(p), PChar(FData[Index]), FieldSize);
        Inc(ptr, FieldSize);
      end;
    end
    else
    begin
      { Handle remaining data types }
      if ptr + LongWord(FieldSize) > Size then Exception.Create(SRecordError);

      case FieldDefs[Index].DataType of
        ptByte: p^ := StrToInt(FData[Index]);
        ptWord: PWord(p)^ := ReverseVal(StrToInt(FData[Index]), 2);