IdTimeUDP.pas 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.7 2/10/2005 2:24:38 PM JPMugaas
  18. Minor Restructures for some new UnixTime Service components.
  19. Rev 1.6 2004.02.03 5:44:36 PM czhower
  20. Name changes
  21. Rev 1.5 1/21/2004 4:21:00 PM JPMugaas
  22. InitComponent
  23. Rev 1.4 1/3/2004 1:00:06 PM JPMugaas
  24. These should now compile with Kudzu's change in IdCoreGlobal.
  25. Rev 1.3 10/26/2003 5:16:52 PM BGooijen
  26. Works now, times in GetTickDiff were in wrong order
  27. Rev 1.2 10/22/2003 04:54:26 PM JPMugaas
  28. Attempted to get these to work.
  29. Rev 1.1 2003.10.12 6:36:46 PM czhower
  30. Now compiles.
  31. Rev 1.0 11/13/2002 08:03:24 AM JPMugaas
  32. }
  33. unit IdTimeUDP;
  34. interface
  35. {$i IdCompilerDefines.inc}
  36. uses
  37. Classes,
  38. IdGlobal,
  39. IdAssignedNumbers, IdUDPBase, IdGlobalProtocols, IdUDPClient;
  40. type
  41. TIdCustomTimeUDP = class(TIdUDPClient)
  42. protected
  43. FBaseDate: TDateTime;
  44. FRoundTripDelay: UInt32;
  45. //
  46. function GetDateTimeCard: UInt32;
  47. function GetDateTime: TDateTime;
  48. public
  49. constructor Create(AOwner: TComponent); override;
  50. {This synchronizes the local clock with the Time Server}
  51. function SyncTime: Boolean;
  52. {This is the number of seconds since 12:00 AM, 1900 - Jan-1}
  53. property DateTimeCard: UInt32 read GetDateTimeCard;
  54. {This is the current time according to the server. TimeZone and Time used
  55. to receive the data are accounted for}
  56. property DateTime: TDateTime read GetDateTime;
  57. {This is the time it took to receive the Time from the server. There is no
  58. need to use this to calculate the current time when using DateTime property
  59. as we have done that here}
  60. property RoundTripDelay: UInt32 read FRoundTripDelay;
  61. published
  62. end;
  63. TIdTimeUDP = class(TIdCustomTimeUDP)
  64. published
  65. {This property is used to set the Date that the Time server bases its
  66. calculations from. If both the server and client are based from the same
  67. date which is higher than the original date, you can extend it beyond the
  68. year 2035}
  69. property BaseDate: TDateTime read FBaseDate write FBaseDate;
  70. property Port default IdPORT_TIME;
  71. end;
  72. implementation
  73. uses
  74. {$IFDEF USE_VCL_POSIX}
  75. {$IFDEF OSX}
  76. Macapi.CoreServices,
  77. {$ENDIF}
  78. Posix.SysTime,
  79. {$ENDIF}
  80. IdStack, SysUtils; //Sysutils added to facilitate inlining.
  81. { TIdCustomTimeUDP }
  82. constructor TIdCustomTimeUDP.Create(AOwner: TComponent);
  83. begin
  84. inherited Create(AOwner);
  85. Port := IdPORT_TIME;
  86. {This indicates that the default date is Jan 1, 1900 which was specified
  87. by RFC 868.}
  88. FBaseDate := TIME_BASEDATE;
  89. end;
  90. function TIdCustomTimeUDP.GetDateTime: TDateTime;
  91. var
  92. BufCard: UInt32;
  93. begin
  94. BufCard := GetDateTimeCard;
  95. if BufCard <> 0 then begin
  96. {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
  97. - the Time Zone difference}
  98. Result := UTCTimeToLocalTime( ((BufCard + (FRoundTripDelay div 1000))/ (24 * 60 * 60) ) + Int(fBaseDate) );
  99. end else begin
  100. { Somehow, I really doubt we are ever going to really get a time such as
  101. 12/30/1899 12:00 am so use that as a failure test}
  102. Result := 0;
  103. end;
  104. end;
  105. function TIdCustomTimeUDP.GetDateTimeCard: UInt32;
  106. var
  107. LTimeBeforeRetrieve: TIdTicks;
  108. LBuffer : TIdBytes;
  109. begin
  110. //Important - This must send an empty UDP Datagram
  111. Send(''); {Do not Localize}
  112. LTimeBeforeRetrieve := Ticks64;
  113. SetLength(LBuffer,4);
  114. ReceiveBuffer(LBuffer);
  115. Result := BytesToUInt32(LBuffer);
  116. Result := GStack.NetworkToHost(Result);
  117. {Theoritically, it should take about 1/2 of the time to receive the data
  118. but in practice, it could be any portion depending upon network conditions. This is also
  119. as per RFC standard}
  120. {This is just in case the TickCount rolled back to zero}
  121. FRoundTripDelay := GetElapsedTicks(LTimeBeforeRetrieve) div 2;
  122. end;
  123. function TIdCustomTimeUDP.SyncTime: Boolean;
  124. var
  125. LBufTime: TDateTime;
  126. begin
  127. LBufTime := DateTime;
  128. Result := LBufTime <> 0;
  129. if Result then begin
  130. Result := IndySetLocalTime(LBufTime);
  131. end;
  132. end;
  133. end.