IdTimeUDP.pas 3.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113
  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: 10391: IdTimeUDP.pas
  11. {
  12. { Rev 1.0 2002.11.12 10:57:02 PM czhower
  13. }
  14. unit IdTimeUDP;
  15. interface
  16. uses Classes, IdAssignedNumbers, IdUDPBase, IdUDPClient;
  17. const
  18. {This indicates that the default date is Jan 1, 1900 which was specified
  19. by RFC 868.}
  20. TIMEUDP_BASEDATE = 2;
  21. type
  22. TIdTimeUDP = class(TIdUDPClient)
  23. protected
  24. FBaseDate: TDateTime;
  25. FRoundTripDelay: Cardinal;
  26. //
  27. function GetDateTimeCard: Cardinal;
  28. function GetDateTime: TDateTime;
  29. public
  30. constructor Create(AOwner: TComponent); override;
  31. {This synchronizes the local clock with the Time Server}
  32. function SyncTime: Boolean;
  33. {This is the number of seconds since 12:00 AM, 1900 - Jan-1}
  34. property DateTimeCard: Cardinal read GetDateTimeCard;
  35. {This is the current time according to the server. TimeZone and Time used
  36. to receive the data are accounted for}
  37. property DateTime: TDateTime read GetDateTime;
  38. {This is the time it took to receive the Time from the server. There is no
  39. need to use this to calculate the current time when using DateTime property
  40. as we have done that here}
  41. property RoundTripDelay: Cardinal read FRoundTripDelay;
  42. published
  43. {This property is used to set the Date that the Time server bases its
  44. calculations from. If both the server and client are based from the same
  45. date which is higher than the original date, you can extend it beyond the
  46. year 2035}
  47. property BaseDate: TDateTime read FBaseDate write FBaseDate;
  48. property Port default IdPORT_TIME;
  49. end;
  50. implementation
  51. uses IdGlobal, IdStack;
  52. { TIdTimeUDP }
  53. constructor TIdTimeUDP.Create(AOwner: TComponent);
  54. begin
  55. inherited Create(AOwner);
  56. Port := IdPORT_TIME;
  57. {This indicates that the default date is Jan 1, 1900 which was specified
  58. by RFC 868.}
  59. FBaseDate := TIMEUDP_BASEDATE;
  60. end;
  61. function TIdTimeUDP.GetDateTime: TDateTime;
  62. var
  63. BufCard: Cardinal;
  64. begin
  65. BufCard := GetDateTimeCard;
  66. if BufCard <> 0 then begin
  67. {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
  68. - the Time Zone difference}
  69. Result := ( ((BufCard + (FRoundTripDelay div 1000))/ (24 * 60 * 60) ) + Int(fBaseDate))
  70. - IdGlobal.TimeZoneBias;
  71. end else begin
  72. { Somehow, I really doubt we are ever going to really get a time such as
  73. 12/30/1899 12:00 am so use that as a failure test}
  74. Result := 0;
  75. end;
  76. end;
  77. function TIdTimeUDP.GetDateTimeCard: Cardinal;
  78. var
  79. LTimeBeforeRetrieve: Cardinal;
  80. begin
  81. Result := 0;
  82. //Important - This must send an empty UDP Datagram
  83. Send(''); {Do not Localize}
  84. LTimeBeforeRetrieve := IdGlobal.GetTickCount;
  85. ReceiveBuffer(Result,SizeOf(Result));
  86. Result := GStack.WSNToHL(Result);
  87. {Theoritically, it should take about 1/2 of the time to receive the data
  88. but in practice, it could be any portion depending upon network conditions. This is also
  89. as per RFC standard}
  90. {This is just in case the TickCount rolled back to zero}
  91. FRoundTripDelay := GetTickDiff(IdGlobal.GetTickCount,LTimeBeforeRetrieve) div 2;
  92. end;
  93. function TIdTimeUDP.SyncTime: Boolean;
  94. var
  95. LBufTime: TDateTime;
  96. begin
  97. LBufTime := DateTime;
  98. Result := LBufTime <> 0;
  99. if Result then begin
  100. Result := SetLocalTime(LBufTime);
  101. end;
  102. end;
  103. end.