1. uses
2. ComObj, DateUtils;
3. function GetInternetTime: string;
4. var
5. XmlHttp: OleVariant;
6. datetxt: string;
7. DateLst: TStringList;
8. mon: string;
9. timeGMT, GetNetTime: TDateTime;
10. s: string;
11. begin
12. XmlHttp := CreateOleObject('Microsoft.XMLHTTP');
13. XmlHttp.Open('GET', 'http://open.baidu.com/special/time/', False);
14. XmlHttp.Send;
15. datetxt := XmlHttp.GetResponseHeader('Date');
16. datetxt := Copy(datetxt, Pos(',', datetxt) + 1, 100);
17. datetxt := StringReplace(datetxt, 'GMT', '', []);
18. datetxt := Trim(datetxt);
19. if datetxt = '' then Exit;
20. DateLst := TStringList.Create;
21. while Pos(' ', datetxt) > 0 do
22. begin
23. DateLst.Add(Copy(datetxt, 1, Pos(' ', datetxt) - 1));
24. datetxt := Copy(datetxt, Pos(' ', datetxt) + 1, 100);
25. end;
26. DateLst.Add(datetxt);
27. if DateLst[1] = 'Jan' then
28. mon := '01'
29. else if DateLst[1] = 'Feb' then
30. mon := '02'
31. else if DateLst[1] = 'Mar' then
32. mon := '03'
33. else if DateLst[1] = 'Apr' then
34. mon := '04'
35. else if DateLst[1] = 'Mar' then
36. mon := '05'
37. else if DateLst[1] = 'Jun' then
38. mon := '06'
39. else if DateLst[1] = 'Jul' then
40. mon := '07'
41. else if DateLst[1] = 'Aug' then
42. mon := '08'
43. else if DateLst[1] = 'Sep' then
44. mon := '09'
45. else if DateLst[1] = 'Oct' then
46. mon := '10'
47. else if DateLst[1] = 'Nov' then
48. mon := '11'
49. else if DateLst[1] = 'Dec' then
50. mon := '12';
51. s := DateLst[2] + '-' + mon + '-' + DateLst[0] + ' ' + DateLst[3];
52. //标准时间
53. //  ShowMessage(s);
54. // '/' or '-'
55. timeGMT := StrToDateTime(DateLst[2] + '-' + mon + '-' + DateLst[0] + ' ' + DateLst[3]);
56. //转换时区
57. GetNetTime := IncHour(TimeGMT, 8);
58. //  ShowMessage(FormatDateTime('yyyy年mm月dd日 HH:NN:SS', GetNetTime));
59. FreeAndNil(DateLst);
60. Result:= FormatDateTime('yyyy年mm月dd日 HH:NN:SS', GetNetTime);
61. end;

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3. WebBrowser.Navigate('http://www.timedate.cn/worldclock/ti.asp');
4. tmr1.Enabled := True;
5. end;
6. procedure TForm1.WebBrowserStatusTextChange(Sender: TObject;
7. const Text: WideString);
8. var
9. strText: string;
10. begin
11. strText := Text;
12. if strText = '完成' Then
13. begin
14. Caption := WebBrowser.OleObject.Document.Body.Innertext;
15. tmr1.Enabled := True
16. end;
17. end;
18. procedure TForm1.tmr1Timer(Sender: TObject);
19. begin
20. tmr1.Enabled := False;
21. WebBrowser.Refresh
22. end;

http://blog.csdn.net/yanjiaye520/article/details/7887463