Indy/Bubbles/boxtests/SNTPBox.pas

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  11275: SNTPBox.pas 
{
{   Rev 1.0    11/12/2002 09:19:46 PM  JPMugaas
{ Initial check in.  Import from FTP VC.
}
unit SNTPBox;

interface

uses
  IndyBox,
  IdSNTP;

type

  TSNTPBox = class(TIndyBox)
  protected
    FClient: TIdSNTP;
  public
    procedure Test; override;
    procedure DoGetTime;
    procedure DoSetTime;
  end;

implementation

uses
  Windows,
  SysUtils,
  IniFiles;


const

  {
   SNTP hosts:
   clock.psu.edu  clock.isc.org  time.twc.weather.com  tick.uh.edu  tick.mhpcc.edu
  }

  GTimeHost = 'clock.psu.edu';
  GTimeout = 5000;


procedure TSNTPBox.Test;
begin

  FClient := TIdSNTP.Create(Nil);

  FClient.Host := Trim(GlobalParamValue('SNTP Server'));
  if Length(FClient.Host) = 0 then
  begin
    FClient.Host := GTimeHost;
  end;
  FClient.ReceiveTimeout := GTimeout;

  try
    Status('SNTP Client Tests (2)');

    DoGetTime;
    DoSetTime;

    Status('SNTP Client Tests... Done');
  finally
    FreeAndNil(FClient);
  end;
end;


procedure TSNTPBox.DoGetTime;
var
  iCounter: integer;
  iCount: integer;
  sMsgForm: string;

begin
  iCount := 10;
  sMsgForm := '[%d] GetTime - Time %s RoundTrip %s Adjustment %s';

  Status(Format('SNTP Client Test (1) GetTime [1..%d]', [ iCount ]));

  for iCounter := 1 to iCount do
  begin
    Status(Format(sMsgForm,
      [ iCounter,
        FormatDateTime('hh:nn:ss.zzz', FClient.DateTime),
        FormatDateTime('hh:nn:ss.zzz', FClient.RoundTripDelay),
        FormatDateTime('hh:nn:ss.zzz', FClient.AdjustmentTime) ] ));
    Sleep(GTimeout);
  end;

  Status('SNTP Client Test (1) GetTime... Done.');

end;


procedure TSNTPBox.DoSetTime;
var
//  ASystemTime: TSystemTime;
  ADateTime: TDateTime;
//  iCounter: integer;
  wMo, wDay, wYr: Word;

begin

  ADateTime := Now;
  DecodeDate(ADateTime, wYr, wMo, wDay);
//  ADateTime := EncodeDate(wYr, wMo, wDay) + EncodeTime(0, 0, 0, 1);

  Status('SNTP Client Test (2) SetTime');
  Status('SetTime - Time on Test entry    ' + FormatDateTime('hh:nn:ss.zzz', Now));
//  SetLocalTime(DateTimeToSystemTime(ADateTime));
  Status('SetTime - Time before Test      ' + FormatDateTime('hh:nn:ss.zzz', Now));
  FClient.SyncTime;
  Status('SetTime - Time after Test       ' + FormatDateTime('hh:nn:ss.zzz', Now));
  Status('SNTP Client Test (2) SetTime... Done.');

end;


initialization
  TIndyBox.RegisterBox(TSNTPBox, 'SNTP Client', 'Clients');
end.