pfgpalmmisc.pas

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

unit pfgPalmMisc;
{**************************************************************************}
{* pfgPalmMisc Unit                                                       *}
{*                                                                        *}
{* This unit provides a set of miscellaneous classes and functions used   *}
{* by the Palm conduit package.                                           *}
{*                                                                        *}
{* Copyright (C) 2000-2002 by Paul Gilbert, All Rights Reserved           *}
{**************************************************************************}

interface

uses Classes, SysUtils, pfgWTypes;

type
  TpfgIntegerStringList = class(TStringList)
  protected
    function GetValue(Index: Integer): Integer; virtual;
    procedure SetValue(Index: Integer; Value: Integer); virtual;
  public
    function AddInteger(const S: string; AValue: Integer): Integer; virtual;

    property Values[Index: Integer]: Integer read GetValue write SetValue;
  end;

  TpfgModifiedMemoryStream = class(TMemoryStream)
  private
    FModified: Boolean;
  protected
    function GetCapacity: Integer; virtual;
    procedure SetCapacity(ACapacity: Integer); virtual;
  public
    procedure LoadFromStream(Stream: TStream); reintroduce;
    procedure LoadFromFile(const FileName: string); reintroduce;
    procedure SetSize(NewSize: Longint); override;
    function Write(const Buffer; Count: Longint): Longint; override;

    property Capacity: Integer read GetCapacity write SetCapacity;
    property Modified: Boolean read FModified write FModified;
  end;

  ECreatorIDError = class(Exception);

  ETimeError = class(Exception);

  { Helper functions }

  function IsCreatorID(id: string): Boolean;
  function StrToCreatorID(ID: string): LongWord;
  function CreatorIDToStr(ID: LongWord): string;
  function PalmDateToDateTime(PalmDate: DateType): TDateTime;
  function DateTimeToPalmDate(DT: TDateTime): DateType;
  function PalmTimeToTime(PalmTime: TimeType): TDateTime;
  function TimeToPalmTime(ATime: TDateTime): TimeType;
  function PalmTimeToTimeStr(PalmTime: TimeType): string;
  function TimeStrToPalmTime(ATime: string): TimeType;
  function PalmDateTimeToDateTime(PalmDT: DateTimeType): TDateTime;
  procedure DateTimeToPalmDateTime(DT: TDateTime; var PDT: DateTimeType);
  function TimSecondsToDateTime(ATime: LongWord): TDateTime;

  function ReverseVal(AVal: Int64; ANumBytes: Integer): Int64;

  function PalmStrToStr(s: string): string;

  function DateTimeToGMTDateTime(dt: TDateTime): TDateTime;
  function GMTDateTimeToDateTime(dt: TDateTime): TDateTime;

  function RemoveDirTree(Value: String): Integer;

implementation

uses pfgSyncMgr, Windows, ShellApi;

resourcestring
  SCreatorIDError = 'The Creator ID "%s" is invalid';
  STimeZoneError = 'Unable to retrieve the current timezone information';
  SNullTimeError = 'The specified time is a null time value';

{**************************************************************************}
{* TpfgIntegerStringList                                                  *}
{*                                                                        *}
{* A string list with associated integers instead of objects              *}
{**************************************************************************}

function TpfgIntegerStringList.AddInteger(const S: string; AValue: Integer): Integer;
begin
  Result := AddObject(S, TObject(AValue));
end;

function TpfgIntegerStringList.GetValue(Index: Integer): Integer;
begin
  Result := Integer(Objects[Index]);
end;

procedure TpfgIntegerStringList.SetValue(Index: Integer; Value: Integer);
begin
  Objects[Index] := TObject(Value);
end;

{**************************************************************************}
{* TpfgModifiedMemoryStream class                                         *}
{*                                                                        *}
{* This class derives from the standard TMemoryStream, and provides a     *}
{* new property Modified, which gets set when the stream is modified.     *}
{**************************************************************************}

function TpfgModifiedMemoryStream.GetCapacity: Integer;
begin
  Result := inherited Capacity;
end;

procedure TpfgModifiedMemoryStream.SetCapacity(ACapacity: Integer);
begin
  inherited Capacity := ACapacity;
  FModified := True;
end;

procedure TpfgModifiedMemoryStream.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FModified := True;
end;

procedure TpfgModifiedMemoryStream.LoadFromFile(const FileName: string);
begin
  inherited LoadFromFile(FileName);
  FModified := True;
end;

procedure TpfgModifiedMemoryStream.SetSize(NewSize: Longint);
begin
  inherited SetSize(NewSize);
  FModified := True;
end;

function TpfgModifiedMemoryStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := inherited Write(Buffer, Count);
  FModified := True;
end;

{**************************************************************************}
{* Helper functions                                                       *}
{*                                                                        *}
{**************************************************************************}

// IsCreatorID
// Returns true if the given string is a valid creator ID

function IsCreatorID(id: string): Boolean;
var
  ctr: Integer;
begin
  Result := Length(ID) = 4;
  if Result then
    for ctr := 1 to 4 do
      if (Ord(ID[ctr]) < 32) or (Ord(ID[ctr]) > 127) then
      begin
        Result := False;
        Exit;
      end;
end;

// StrToCreatorID
// Returns the creator ID for a string

function StrToCreatorID(ID: string): LongWord;
begin
  if not IsCreatorID(ID) then
    raise ECreatorIDError.CreateFmt(SCreatorIDError, [ID]);

  // Get the string as a longword, and reverse it to accomodate Palm byte order
  Result := ReverseVal(PLongWord(@ID[1])^, 4);
end;

// Returns the string for a given creator ID

function CreatorIDToStr(ID: LongWord): string;
var
  v: LongWord;
  bytes: Array [0..3] of Byte absolute ID;
begin
  if (not bytes[0] in [32..127]) or (not bytes[1] in [32..127]) or
     (not bytes[2] in [32..127]) or (not bytes[3] in [32..127]) then
    raise ECreatorIDError.CreateFmt(SCreatorIDError, [IntToStr(ID)]);

  // Reverse the byte ordering of the ID to convert to Intel ordering
  v := ReverseVal(ID, 4);
  // Convert value into four digit string
  SetLength(Result, 4);
  Move(v, Result[1], 4);
end;


// PalmDateToDateTime
// Converts a Palm date variable into a Windows TDateTime variable

function PalmDateToDateTime(PalmDate: DateType): TDateTime;
var
  y, m, d: Word;
begin
  y := (PalmDate shr 9) + 1904;
  m := (PalmDate shr 5) and $F;
  d := PalmDate and $1F;
  Result := EncodeDate(y, m, d);
end;

// DateTimeToPalmDate
// Converts a Windows TDateTime variable into a Palm date variable

function DateTimeToPalmDate(DT: TDateTime): DateType;
var
  y, m, d: Word;
begin
  if DT = 0 then Result := 0 else
  begin
    DecodeDate(DT, y, m, d);
    Result := ((y-1904) shl 9) + (m shl 5) + d;
  end;
end;

// PalmTimeToTime
// Converts a Palm time structure to a PC time structure

function PalmTimeToTime(PalmTime: TimeType): TDateTime;
begin
  if (PalmTime.hours = $FF) and (PalmTime.minutes = $FF) then
    raise ETimeError.Create(SNullTimeError);
  Result := EncodeTime(PalmTime.hours, PalmTime.minutes, 0, 0);
end;

function TimeToPalmTime(ATime: TDateTime): TimeType;
var
  h, m, s, msec: Word;
begin
  DecodeTime(ATime, h, m, s, msec);
  Result.hours := h; Result.minutes := m;
end;

function PalmTimeToTimeStr(PalmTime: TimeType): string;
begin
  try
    Result := TimeToStr(PalmTimeToTime(PalmTime));
  except
    on ETimeError do Result := '';
  end;
end;

function TimeStrToPalmTime(ATime: string): TimeType;
begin
  if ATime = '' then
  begin
    Result.hours := $FF; Result.minutes := $FF;
  end
  else
    Result := TimeToPalmTime(StrToTime(ATime));
end;

// TimSecondsToDateTime
// Converts a longword time specifier (number of seconds since 1/1/1904) to
// a standard TDateTime format. Note that for the special case of 0 seconds,
// it translates to the TDateTime(0) for easier checking of empty status
// TODO: Verify that this works - currently only experimental

function TimSecondsToDateTime(ATime: LongWord): TDateTime;
const
  SecsPerDay = 24 * 60 * 60;
var
  n, d: Double;
begin
  if ATime = 0 then
    Result := 0
  else
  begin
    n := ATime mod SecsPerDay;
    d := SecsPerDay;

    Result := EncodeDate(1904, 1, 1) + (ATime div SecsPerDay) +
      (n / d);
  end;
end;

function PalmDateTimeToDateTime(PalmDT: DateTimeType): TDateTime;
begin
  if (PalmDT.year = 0) and (PalmDT.month = 0) and (PalmDT.day = 0) then
    Result := 0
  else
    Result := EncodeDate(Swap(PalmDT.year), Swap(PalmDT.month), Swap(PalmDT.day)) +
                 EncodeTime(Swap(PalmDT.hour), Swap(PalmDT.minute),
                           Swap(PalmDT.second), 0);
end;

procedure DateTimeToPalmDateTime(DT: TDateTime; var PDT: DateTimeType);
var
  y, m, d, h, min, sec, msec: Word;
begin
  if DT = 0.0 then
    // Zero date, so set empty date value
    FillChar(PDT, sizeof(DateTimeType), 0)
  else
  begin
    DecodeDate(dt, y, m, d);
    DecodeTime(dt, h, min, sec, msec);

    PDT.year := Swap(y); PDT.month := Swap(m); PDT.day := Swap(d);
    PDT.hour := Swap(h); PDT.minute := Swap(min); PDT.second := Swap(sec);
    PDT.weekday := Swap(Word(DayOfWeek(dt)-1));
  end;
end;


// ReverseVal
// Reverses the byte order of the specified value

function ReverseVal(AVal: Int64; ANumBytes: Integer): Int64;
var
  ctr: Integer;
begin
  Assert((ANumBytes >= 1) and (ANumBytes <= 8), 'Illegal # Bytes for ReverseVal');
  Result := 0;
  for ctr := 1 to ANumBytes do
  begin
    Result := Result shl 8 + (AVal and $FF);
    AVal := AVal shr 8;
  end;
end;

// PalmStrToStr
// Returns a string with any non-ASCII characters stripped out. Note that I
// don't use this automatically in the AsString field, since a person may
// want to get the extra control characters. Note that the Palm CR's are
// automatically translated to a LF character

function PalmStrToStr(s: string): string;
var
  ctr: Integer;
begin
  Result := '';
  for ctr := 1 to Length(s) do
    if (s[ctr] >= #32) then Result := Result + s[ctr]
    else if (s[ctr] = #9) then Result := Result + #9
    else if (s[ctr] = #13) or (s[ctr] = #10) then Result := Result + #10;
end;

// DateTimeToGMTDateTime
// Converts a given TDateTime variable to it's GMT equivalent

function DateTimeToGMTDateTime(dt: TDateTime): TDateTime;
var
  tz: _TIME_ZONE_INFORMATION;
begin
  if not Succeeded(GetTimeZoneInformation(tz)) then
    raise Exception.Create(STimeZoneError);

  if dt = 0 then Result := 0
  else Result := dt + tz.Bias * EncodeTime(0, 1, 0, 0);
end;

// GMTDateTimeToDateTime
// Converts a given GMT TDateTime variable to it's local time equivalent

function GMTDateTimeToDateTime(dt: TDateTime): TDateTime;
var
  tz: _TIME_ZONE_INFORMATION;
begin
  if not Succeeded(GetTimeZoneInformation(tz)) then
    raise Exception.Create(STimeZoneError);

  if dt = 0 then Result := 0
  else Result := dt - tz.Bias * EncodeTime(0, 1, 0, 0);
end;

// RemoveDirTree
// Removes the specified folder, and any subfolders

function RemoveDirTree(Value: String): Integer;
var
  FOS : TSHFileOpStruct;
begin
  FillChar(FOS, SizeOf(TSHFileOpStruct), 0);
  with FOS do
  begin
    wFunc :=FO_DELETE;
    pFrom :=PChar(Value+#0#0);
    fFlags:=FOF_NOCONFIRMATION Or FOF_SILENT or FOF_NOERRORUI;
  end;
  Result:=ShFileOperation(FOS);
end;

end.