IdTime.pas 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 10387: IdTime.pas
  11. {
  12. { Rev 1.0 2002.11.12 10:56:42 PM czhower
  13. }
  14. unit IdTime;
  15. {*******************************************************}
  16. { }
  17. { Indy Time Client TIdTime }
  18. { }
  19. { Copyright (C) 2000 Winshoes Working Group }
  20. { Original author J. Peter Mugaas }
  21. { 2000-April-24 }
  22. { Based on RFC RFC 868 }
  23. { }
  24. {*******************************************************}
  25. {
  26. 2001-Sep -21 J. Peter Mugaas
  27. - adjusted formula as suggested by Vaclav Korecek. The old
  28. one would give wrong date, time if RoundTripDelay was over
  29. a value of 1000
  30. 2000-May -04 J. Peter Mugaas
  31. -Changed RoundTripDelay to a cardinal and I now use the
  32. GetTickCount function for more accuracy
  33. -The formula had to adjusted for this.
  34. 2000-May -03 J. Peter Mugaas
  35. -Added BaseDate to the date the calculations are based on can be
  36. adjusted to work after the year 2035
  37. 2000-Apr.-29 J. Peter Mugaas
  38. -Made the time more accurate by taking into account time-zone
  39. bias by subtracting IdGlobal.TimeZoneBias.
  40. -I also added a correction for the time it took to receive the
  41. Integer from the server ( ReadInteger )
  42. -Changed Time property to DateTime and TimeCard to DateTimeCard
  43. to be more consistant with TIdSNTP.
  44. }
  45. interface
  46. uses
  47. Classes, IdAssignedNumbers, IdTCPClient;
  48. const
  49. {This indicates that the default date is Jan 1, 1900 which was specified
  50. by RFC 868.}
  51. TIME_BASEDATE = 2;
  52. TIME_TIMEOUT = 2500;
  53. type
  54. TIdTime = class(TIdTCPClient)
  55. protected
  56. FBaseDate: TDateTime;
  57. FRoundTripDelay: Cardinal;
  58. FTimeout: Integer;
  59. //
  60. function GetDateTimeCard: Cardinal;
  61. function GetDateTime: TDateTime;
  62. public
  63. constructor Create(AOwner: TComponent); override;
  64. {This synchronizes the local clock with the Time Server}
  65. function SyncTime: Boolean;
  66. {This is the number of seconds since 12:00 AM, 1900 - Jan-1}
  67. property DateTimeCard: Cardinal read GetDateTimeCard;
  68. {This is the current time according to the server. TimeZone and Time used
  69. to receive the data are accounted for}
  70. property DateTime: TDateTime read GetDateTime;
  71. {This is the time it took to receive the Time from the server. There is no
  72. need to use this to calculate the current time when using DateTime property
  73. as we have done that here}
  74. property RoundTripDelay: Cardinal read FRoundTripDelay;
  75. published
  76. {This property is used to set the Date that the Time server bases its
  77. calculations from. If both the server and client are based from the same
  78. date which is higher than the original date, you can extend it beyond the
  79. year 2035}
  80. property BaseDate: TDateTime read FBaseDate write FBaseDate;
  81. property Timeout: Integer read FTimeout write FTimeout default TIME_TIMEOUT;
  82. property Port default IdPORT_TIME;
  83. end;
  84. implementation
  85. uses
  86. IdGlobal, IdTCPConnection,
  87. SysUtils;
  88. { TIdTime }
  89. constructor TIdTime.Create(AOwner: TComponent);
  90. begin
  91. inherited;
  92. Port := IdPORT_TIME;
  93. {This indicates that the default date is Jan 1, 1900 which was specified
  94. by RFC 868.}
  95. FBaseDate := TIME_BASEDATE;
  96. FTimeout := TIME_TIMEOUT;
  97. end;
  98. function TIdTime.GetDateTime: TDateTime;
  99. var
  100. BufCard: Cardinal;
  101. begin
  102. BufCard := GetDateTimeCard;
  103. if BufCard <> 0 then begin
  104. {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
  105. - the Time Zone difference}
  106. Result := ( ((BufCard + (FRoundTripDelay div 1000))/ (24 * 60 * 60) ) + Int(fBaseDate))
  107. -IdGlobal.TimeZoneBias;
  108. end else begin
  109. { Somehow, I really doubt we are ever going to really get a time such as
  110. 12/30/1899 12:00 am so use that as a failure test}
  111. Result := 0;
  112. end;
  113. end;
  114. function TIdTime.GetDateTimeCard: Cardinal;
  115. var
  116. LTimeBeforeRetrieve: Cardinal;
  117. begin
  118. Result := 0;
  119. Connect; try
  120. LTimeBeforeRetrieve := IdGlobal.GetTickCount;
  121. // Check for timeout
  122. // Timeout is actually a time with no traffic, not a total timeout.
  123. repeat
  124. if ReadFromStack(True, FTimeout) = 0 then begin
  125. Exit;
  126. end;
  127. until InputBuffer.Size >= SizeOf(Result);
  128. //
  129. Result := ReadCardinal;
  130. {Theoritically, it should take about 1/2 of the time to receive the data
  131. but in practice, it could be any portion depending upon network conditions. This is also
  132. as per RFC standard}
  133. {This is just in case the TickCount rolled back to zero}
  134. FRoundTripDelay := GetTickDiff(LTimeBeforeRetrieve,IdGlobal.GetTickCount) div 2;
  135. finally Disconnect; end;
  136. end;
  137. function TIdTime.SyncTime: Boolean;
  138. var
  139. LBufTime: TDateTime;
  140. begin
  141. LBufTime := DateTime;
  142. Result := LBufTime <> 0;
  143. if Result then begin
  144. Result := SetLocalTime(LBufTime);
  145. end;
  146. end;
  147. end.