220 lines
6.7 KiB
Plaintext
220 lines
6.7 KiB
Plaintext
{
|
|
$Project$
|
|
$Workfile$
|
|
$Revision$
|
|
$DateUTC$
|
|
$Id$
|
|
|
|
This file is part of the Indy (Internet Direct) project, and is offered
|
|
under the dual-licensing agreement described on the Indy website.
|
|
(http://www.indyproject.org/)
|
|
|
|
Copyright:
|
|
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
|
}
|
|
{
|
|
$Log$
|
|
}
|
|
{
|
|
Rev 1.10 2/10/2005 2:24:42 PM JPMugaas
|
|
Minor Restructures for some new UnixTime Service components.
|
|
|
|
Rev 1.9 2004.02.03 5:44:34 PM czhower
|
|
Name changes
|
|
|
|
Rev 1.8 1/21/2004 4:20:56 PM JPMugaas
|
|
InitComponent
|
|
|
|
Rev 1.7 1/3/2004 1:00:00 PM JPMugaas
|
|
These should now compile with Kudzu's change in IdCoreGlobal.
|
|
|
|
Rev 1.6 4/11/2003 02:45:44 PM JPMugaas
|
|
|
|
Rev 1.5 4/5/2003 7:23:56 PM BGooijen
|
|
Raises exception on timeout now
|
|
|
|
Rev 1.4 4/4/2003 8:02:34 PM BGooijen
|
|
made host published
|
|
|
|
Rev 1.3 2/24/2003 10:37:00 PM JPMugaas
|
|
Should compile. TODO: Figure out what to do with TIdTime and the timeout
|
|
feature.
|
|
|
|
Rev 1.2 12/7/2002 06:43:38 PM JPMugaas
|
|
These should now compile except for Socks server. IPVersion has to be a
|
|
property someplace for that.
|
|
|
|
Rev 1.1 12/6/2002 05:30:48 PM JPMugaas
|
|
Now descend from TIdTCPClientCustom instead of TIdTCPClient.
|
|
|
|
Rev 1.0 11/13/2002 08:03:14 AM JPMugaas
|
|
}
|
|
|
|
unit IdTime;
|
|
|
|
{*******************************************************}
|
|
{ }
|
|
{ Indy Time Client TIdTime }
|
|
{ }
|
|
{ Copyright (C) 2000 Winshoes Working Group }
|
|
{ Original author J. Peter Mugaas }
|
|
{ 2000-April-24 }
|
|
{ Based on RFC RFC 868 }
|
|
{ }
|
|
{*******************************************************}
|
|
{
|
|
2001-Sep -21 J. Peter Mugaas
|
|
- adjusted formula as suggested by Vaclav Korecek. The old
|
|
one would give wrong date, time if RoundTripDelay was over
|
|
a value of 1000
|
|
2000-May -04 J. Peter Mugaas
|
|
-Changed RoundTripDelay to a cardinal and I now use the
|
|
GetTickCount function for more accuracy
|
|
-The formula had to adjusted for this.
|
|
2000-May -03 J. Peter Mugaas
|
|
-Added BaseDate to the date the calculations are based on can be
|
|
adjusted to work after the year 2035
|
|
2000-Apr.-29 J. Peter Mugaas
|
|
-Made the time more accurate by taking into account time-zone
|
|
bias by subtracting IdGlobal.TimeZoneBias.
|
|
-I also added a correction for the time it took to receive the
|
|
Integer from the server ( ReadInteger )
|
|
-Changed Time property to DateTime and TimeCard to DateTimeCard
|
|
to be more consistant with TIdSNTP.
|
|
}
|
|
|
|
interface
|
|
|
|
{$i IdCompilerDefines.inc}
|
|
|
|
uses
|
|
{$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
|
|
Classes,
|
|
{$ENDIF}
|
|
IdGlobal,
|
|
IdAssignedNumbers, IdGlobalProtocols, IdTCPClient;
|
|
|
|
const
|
|
TIME_TIMEOUT = 2500;
|
|
|
|
type
|
|
TIdCustomTime = class(TIdTCPClientCustom)
|
|
protected
|
|
FBaseDate: TDateTime;
|
|
FRoundTripDelay: UInt32;
|
|
FTimeout: Integer;
|
|
//
|
|
function GetDateTimeCard: UInt32;
|
|
function GetDateTime: TDateTime;
|
|
procedure InitComponent; override;
|
|
public
|
|
{$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
|
|
constructor Create(AOwner: TComponent); reintroduce; overload;
|
|
{$ENDIF}
|
|
{This synchronizes the local clock with the Time Server}
|
|
function SyncTime: Boolean;
|
|
{This is the number of seconds since 12:00 AM, 1900 - Jan-1}
|
|
property DateTimeCard: UInt32 read GetDateTimeCard;
|
|
{This is the current time according to the server. TimeZone and Time used
|
|
to receive the data are accounted for}
|
|
property DateTime: TDateTime read GetDateTime;
|
|
{This is the time it took to receive the Time from the server. There is no
|
|
need to use this to calculate the current time when using DateTime property
|
|
as we have done that here}
|
|
property RoundTripDelay: UInt32 read FRoundTripDelay;
|
|
published
|
|
property Timeout: Integer read FTimeout write FTimeout default TIME_TIMEOUT;
|
|
property Host;
|
|
end;
|
|
|
|
TIdTime = class(TIdCustomTime)
|
|
published
|
|
{This property is used to set the Date that the Time server bases its
|
|
calculations from. If both the server and client are based from the same
|
|
date which is higher than the original date, you can extend it beyond the
|
|
year 2035}
|
|
property BaseDate: TDateTime read FBaseDate write FBaseDate;
|
|
property Timeout: Integer read FTimeout write FTimeout default TIME_TIMEOUT;
|
|
property Port default IdPORT_TIME;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$IFDEF USE_VCL_POSIX}
|
|
{$IFDEF DARWIN}
|
|
Macapi.CoreServices,
|
|
{$ENDIF}
|
|
Posix.SysTime,
|
|
{$ENDIF}
|
|
IdTCPConnection;
|
|
|
|
{ TIdCustomTime }
|
|
|
|
{$IFDEF WORKAROUND_INLINE_CONSTRUCTORS}
|
|
constructor TIdCustomTime.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TIdCustomTime.InitComponent;
|
|
begin
|
|
inherited;
|
|
Port := IdPORT_TIME;
|
|
{This indicates that the default date is Jan 1, 1900 which was specified
|
|
by RFC 868.}
|
|
FBaseDate := TIME_BASEDATE;
|
|
FTimeout := TIME_TIMEOUT;
|
|
end;
|
|
|
|
function TIdCustomTime.GetDateTime: TDateTime;
|
|
var
|
|
BufCard: UInt32;
|
|
begin
|
|
BufCard := GetDateTimeCard;
|
|
if BufCard <> 0 then begin
|
|
{The formula is The Time cardinal we receive divided by (24 * 60*60 for days + RoundTrip divided by one-thousand since this is based on seconds
|
|
- the Time Zone difference}
|
|
Result := ( ((BufCard + (FRoundTripDelay div 1000))/ (24 * 60 * 60) ) + Int(fBaseDate))
|
|
-TimeZoneBias;
|
|
|
|
end else begin
|
|
{ Somehow, I really doubt we are ever going to really get a time such as
|
|
12/30/1899 12:00 am so use that as a failure test}
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
|
|
function TIdCustomTime.GetDateTimeCard: UInt32;
|
|
var
|
|
LTimeBeforeRetrieve: TIdTicks;
|
|
begin
|
|
Connect; try
|
|
// Check for timeout
|
|
// Timeout is actually a time with no traffic, not a total timeout.
|
|
IOHandler.ReadTimeout:=Timeout;
|
|
LTimeBeforeRetrieve := Ticks64;
|
|
Result := IOHandler.ReadUInt32;
|
|
{Theoritically, it should take about 1/2 of the time to receive the data
|
|
but in practice, it could be any portion depending upon network conditions. This is also
|
|
as per RFC standard}
|
|
|
|
{This is just in case the TickCount rolled back to zero}
|
|
FRoundTripDelay := GetElapsedTicks(LTimeBeforeRetrieve) div 2;
|
|
finally Disconnect; end;
|
|
end;
|
|
|
|
function TIdCustomTime.SyncTime: Boolean;
|
|
var
|
|
LBufTime: TDateTime;
|
|
begin
|
|
LBufTime := DateTime;
|
|
Result := LBufTime <> 0;
|
|
if Result then begin
|
|
Result := IndySetLocalTime(LBufTime);
|
|
end;
|
|
end;
|
|
|
|
end.
|