What is the problem of obtaining Internet time?

Source: Internet
Author: User
What is the problem of obtaining Internet time? Delphi/Windows SDK/API
Http://www.delphi2007.net/DelphiAPI/html/delphi_20061204151729125.html
The source code downloaded on the Internet Prompts that the control cannot be found.

Can it be the simplest?
It also describes where to add the control and how to use it.

Can I divide myself ???
The post is closed.

Can I divide myself ???
------------
No
Jf

// Directly use tclientsocket
Unit timedllu;

Interface

Uses
Windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
Scktcomp;

Type
Tdtform = Class (tform)
Dtsock: tclientsocket;
Procedure dtsockread (Sender: tobject; socket: tcustomwinsocket );
Private
{Private Declarations}
Public
{Public declarations}
End;

Const
Timerserver: String = '2017. 129.68.14 '; // Hong Kong Time Server

VaR
Dtform: tdtform = nil;
DT: tdatetime =-1;
Dtready: Boolean = false;

Procedure timedllinit (); stdcall
Function timedllgettime (doadj: Boolean): tdatetime; stdcall
Procedure timedllfinish (); stdcall

Implementation

{$ R *. DFM}

Procedure timedllinit ();
Begin
Dtform: = tdtform. Create (application );
End;

Procedure timedllfinish ();
Begin
Dtform. Free ();
End;

VaR
Ptimezoneinformation: ttimezoneinformation;
Function timedllgettime (doadj: Boolean): tdatetime;
VaR
Running IM: systemtime;
Htoken: thandle;
Tkp: token_privileges;
TMP: DWORD;
Pretick: DWORD;
Begin
DT: =-1;
Dtready: = false;
Try
Dtform. dtsock. HOST: = timerserver;
Dtform. dtsock. open ();
Pretick: = gettickcount ();
While gettickcount ()-pretick <5000 do
Begin
Sleep (10 );
Application. processmessages ();
If dtready then
Break;
End;
Except
Else
;
End;
If dtready then
Begin
Gettimezoneinformation (ptimezoneinformation );
DT: = DT-ptimezoneinformation. Bias/(24*60); // (International Standard Time to local time)
If doadj then
If DT> 38880 then
Begin
Decodedate (DT, interval im. wyear, interval im. wmonth, interval im. wday );
Decodetime (DT, messaging im. whour, messaging im. wminute, messaging im. wsecond, messaging im. wmilliseconds );
If openprocesstoken (getcurrentprocess (), token_adjust_privileges or token_query, htoken) then
Begin
Lookupprivilegevalue (nil, 'systemtimeprivilege', tkp. Privileges [0]. luid );
Tkp. privilegecount: = 1; // One privilege to set
Tkp. Privileges [0]. attributes: = se_privilege_enabled;
TMP: = 0;
Adjusttokenprivileges (htoken, false, tkp, 0, nil, TMP );
End;
Setlocaltime (milliseconds IM );
End;
End;
Result: = DT;
End;

Function mouthstr2int (MS: string): word;
Const
Mouthstrs: array [1 .. 12] of string =
(
'Jan ',
'Feb ',
'Mar ',
'Apr ',
'May ',
'Jun ',
'Jul ',
'Aug ',
'Sept ',
'Oct ',
'Nov ',
'Dec'
);
VaR
I: integer;
Begin
MS: = uppercase (MS );
For I: = 1 to 12 do
Begin
If MS = mouthstrs [I] Then
Begin
Result: = I;
Exit;
End;
End;
Result: = 0;
End;

Procedure tdtform. dtsockread (Sender: tobject; socket: tcustomwinsocket );
VaR
Stime: string;
Running IM: systemtime;
I: integer;
Ti: tdatetime;
Begin
Stime: = socket. receivetext;
If length (stime) <32 then
Begin
I: = pos ('', stime );
If I = 0 then
Exit;
Required im. wday: = strtoint (copy (stime, 1, I-1 ));
Delete (stime, 1, I );
I: = pos ('', stime );
If I = 0 then
Exit;
Required im. wmonth: = mouthstr2int (copy (stime, 1, I-1 ));
Delete (stime, 1, I );
I: = pos ('', stime );
If I = 0 then
Exit;
Using im. wyear: = strtoint (copy (stime, 1, I-1 ));
Delete (stime, 1, I );

I: = pos ('', stime );
If I = 0 then
Exit;
Ti: = strtotime (copy (stime, 1, I-1 ));
Delete (stime, 1, I );

If uppercase (copy (stime, 1, 3) = 'hkt 'then
Begin
DT: = encodedate (interval im. wyear, interval im. wmonth, interval im. wday );
DT: = DT + Ti;
DT: = DT-(8/24); // HK Time to UTC (Hong Kong Time is converted to International Standard Time)
Dtready: = true;
End;
End;
End;

End.

// Changed and aligned with spaces
Unit timedllu;

Interface

Uses
Windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
Scktcomp;

Type
Tdtform = Class (tform)
Dtsock: tclientsocket;
Procedure dtsockread (Sender: tobject; socket: tcustomwinsocket );
Private
{Private Declarations}
Public
{Public declarations}
End;

Const
Timerserver: String = '2017. 129.68.14 '; // Hong Kong Time Server

VaR
Dtform: tdtform = nil;
DT: tdatetime =-1;
Dtready: Boolean = false;

Procedure timedllinit (); stdcall
Function timedllgettime (doadj: Boolean): tdatetime; stdcall
Procedure timedllfinish (); stdcall

Implementation

{$ R *. DFM}

Procedure timedllinit ();
Begin
Dtform: = tdtform. Create (application );
End;

Procedure timedllfinish ();
Begin
Dtform. Free ();
End;

VaR
Ptimezoneinformation: ttimezoneinformation;
Function timedllgettime (doadj: Boolean): tdatetime;
VaR
Running IM: systemtime;
Htoken: thandle;
Tkp: token_privileges;
TMP: DWORD;
Pretick: DWORD;
Begin
DT: =-1;
Dtready: = false;
Try
Dtform. dtsock. HOST: = timerserver;
Dtform. dtsock. open ();
Pretick: = gettickcount ();
While gettickcount ()-pretick <5000 do
Begin
Sleep (10 );
Application. processmessages ();
If dtready then
Break;
End;
Except
Else
;
End;
If dtready then
Begin
Gettimezoneinformation (ptimezoneinformation );
DT: = DT-ptimezoneinformation. Bias/(24*60); // (International Standard Time to local time)
If doadj then
If DT> 38880 then
Begin
Decodedate (DT, interval im. wyear, interval im. wmonth, interval im. wday );
Decodetime (DT, messaging im. whour, messaging im. wminute, messaging im. wsecond, messaging im. wmilliseconds );
If openprocesstoken (getcurrentprocess (), token_adjust_privileges or token_query, htoken) then
Begin
Lookupprivilegevalue (nil, 'systemtimeprivilege', tkp. Privileges [0]. luid );
Tkp. privilegecount: = 1; // One privilege to set
Tkp. Privileges [0]. attributes: = se_privilege_enabled;
TMP: = 0;
Adjusttokenprivileges (htoken, false, tkp, 0, nil, TMP );
End;
Setlocaltime (milliseconds IM );
End;
End;
Result: = DT;
End;

Function mouthstr2int (MS: string): word;
Const
Mouthstrs: array [1 .. 12] of string =
(
'Jan ',
'Feb ',
'Mar ',
'Apr ',
'May ',
'Jun ',
'Jul ',
'Aug ',
'Sept ',
'Oct ',
'Nov ',
'Dec'
);
VaR
I: integer;
Begin
MS: = uppercase (MS );
For I: = 1 to 12 do
Begin
If MS = mouthstrs [I] Then
Begin
Result: = I;
Exit;
End;
End;
Result: = 0;
End;

Procedure tdtform. dtsockread (Sender: tobject; socket: tcustomwinsocket );
VaR
Stime: string;
Running IM: systemtime;
I: integer;
Ti: tdatetime;
Begin
Stime: = socket. receivetext;
If length (stime) <32 then
Begin
I: = pos ('', stime );
If I = 0 then
Exit;
Required im. wday: = strtoint (copy (stime, 1, I-1 ));
Delete (stime, 1, I );
I: = pos ('', stime );
If I = 0 then
Exit;
Required im. wmonth: = mouthstr2int (copy (stime, 1, I-1 ));
Delete (stime, 1, I );
I: = pos ('', stime );
If I = 0 then
Exit;
Using im. wyear: = strtoint (copy (stime, 1, I-1 ));
Delete (stime, 1, I );

I: = pos ('', stime );
If I = 0 then
Exit;
Ti: = strtotime (copy (stime, 1, I-1 ));
Delete (stime, 1, I );

If uppercase (copy (stime, 1, 3) = 'hkt 'then
Begin
DT: = encodedate (interval im. wyear, interval im. wmonth, interval im. wday );
DT: = DT + Ti;
DT: = DT-(8/24); // HK Time to UTC (Hong Kong Time is converted to International Standard Time)
Dtready: = true;
End;
End;
End;

End.

Unit
Nmtime

Description
The tnmtime component is used for getting the time from Internet time servers, as described in RFC 868.

To me.

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.