SwissTime for Delphi 2

The unit swisstime is used for getting the time from (daytime) timeservers as stated in RFC867 (TTime13, port 13, local time), RFC868 ( TTime37, UTC) , RFC2030 ( SNTPClient , UTC, see the SNTP40.html document in this ZIP file ).

Similar components for RFC867,RFC868 are distributed with C++Builder 3 and Delphi 4 (??), but there is no SNTPClient (the best of the three ways to get the time from the internet) distributed with it!

Before connecting to a timeserver, you have to set the HostAddr (for example bernina.ethz.ch or some IP address), the HostPort (if you don't use the default port) and the timeout property and at least, you have to handle the event  OnDataAvailable : TDataAvailable.

If you need a free DCU version of SwissTime for Delphi 3, then let me know (theiler.gasser@bluewin.ch)
 

SwissTime is freeware. If you need the source code (to compile it for Delphi 3 or 4, C++Builder 3), you can get it by sending US$10 to
Michael Gasser, Quellenweg 3, CH-3084 Wabern.

Thank you very much.
Delivery only by eMail.

Contact : theiler.gasser@bluewin.ch



Example
...
...
...
with XXX do
begin
        HostAddr := 'bernina.ethz.ch';
        Timeout   := 300;                                // if you don't specify a port, the components default port will be set as HostPort.
       connect;
end;
...
...
...

procedure TForm1.Time131DataAvailable(Sender: TObject; Error: Word);
begin
        Showmessage( datetostr( time131.datetime) + ', '+datetostr( time131.datetime) );
end;
...
...


The other events :

property  OnWinsockError      : TWinsockError
(type  TWinsockError      = procedure ( Sender: TObject; Error: word ) of object;)

Windows Socket Error. Error : Windows Socket Error code.
 
 

property  OnTimeout                : TNotifyEvent
 

property  OnReceiveError       : TNotifyEvent

The component did not receive the correct number of bytes.
 

property  OnFormatError         : TNotifyEvent

TTime13 component only : Unknown format.
 

property  OnResolveError        : TNotifyEvent

"Can't resolve host."  Host with address HostAddr does probably not exist.
 
 
 
 

TTime37

type
  TTime37 = class( TComponent )

  public
      procedure Connect;
      property  DateTime      : TDateTime        // DateTime sent by the server
      property  AdjTime       : TDateTime        // Adjusted DateTime (AdjTime := DateTime + Ping/2)
      property  Ping          : integer
      property  LocalIP       : string
      property  HostIP        : string
      property  P37Msg        : Integer                // RFC868 message
 

  published
    { Published-Deklarationen }

    property  HostAddr        : String
    property  HostPort        : String
    property  Timeout         : integer

    property  OnWinsockError  : TWinsockError
    property  OnDataAvailable : TDataAvailable
    property  OnTimeout       : TNotifyEvent
    property  OnReceiveError  : TNotifyEvent
    property  OnResolveError  : TNotifyEvent
  end;


TTime13
 

type
  TTime13 = class( TComponent )

  public
    { Public-Deklarationen }

      procedure Connect;
      property  NormTimeStr   : String              // There is a problem, using RFC867. TimeStr is not normed.
                                                                        // TTime13 norms the TimeStr received from the server.
                                                                        //  Format : YYYY/MM/DD,hh:mm:ss
 
      property  TimeStr       : String                    // Message received from the timeserver.

      property  DateTime      : TDateTime         // see TTime37
      property  AdjTime       : TDateTime
      property  Ping          : integer
      property  LocalIP       : string
      property  HostIP        : string
 

  published
    { Published-Deklarationen }

    property  HostAddr        : String
    property  HostPort        : String
    property  Timeout         : integer

    property  OnWinsockError  : TWinsockError
    property  OnDataAvailable : TDataAvailable
    property  OnTimeout       : TNotifyEvent
    property  OnReceiveError  : TNotifyEvent
    property  OnFormatError   : TNotifyEvent
    property  OnResolveError  : TNotifyEvent
  end;



SNTPClient

type Fourbytes = record
      case integer of
        0: ( b : array[1..4] of byte);
        1: ( i : integer);
      end;
 

type NTP_Time  = record
          seconds  : Fourbytes;
          fraction : Fourbytes;
     end;
 

type SNTPMsgFormat = record
       Info            : Fourbytes;
       root_delay      : Fourbytes;
       root_dispersion : Fourbytes;
       reference_id    : Fourbytes;

       ref_timestamp   : ntp_time;
       orig_timestamp  : ntp_time;
       rec_timestamp   : ntp_time;
       trans_timestamp : ntp_time;
     end;

type  TSNTPError        = procedure (Sender: TObject; Error: word) of object;
 

type
  TSNTPClient = class(TComponent)

  public
    { Public-Deklarationen }

    function    DisregardMsg( Mess : SNTPMsgFormat ) : boolean;

    function    ntptimetodatetime ( t : ntp_time ) : TdateTime;
 

    procedure   SNTPontimeout( Sender : TObject );
    procedure   SockError(Sender:TObject);

    property    ServerIP      : string
    property    LocalIP       : string
    property    Leapindicator : integer
    property    Version       : integer
    property    Mode          : integer
    property    Stratum       : integer
    property    Poll          : integer
    property    Precision     : integer
    property    Rootdelay     : double
    property    Rootdispersion: double
    property    Ref_time      : TDateTime
    property    Ori_time      : TDateTime
    property    Rec_time      : TDateTime
    property    Tra_time      : TDateTime

    property    Disregard     : boolean
    property    Ping          : integer
    property    SNTPMsg       : SNTPMsgFormat

    property    DateTime      : TDateTime
    procedure   Connect;
    property    LocalPort     : String
    property    HostIP        : string
    property    AdjTime       : TDateTime
 

  published
    { Published-Deklarationen }

    property    HostAddr      : String
    property    HostPort      : String
    property    Timeout       : integer

    property    OnDataAvailable: TDataavailable
    property    OnTimeout      : TNotifyEvent
    property    OnWinsockError : TSNTPError
    property    OnResolveError : TNotifyEvent
    property    OnReceiveError  : TNotifyEvent
  end;