方法一:
- uses
- ComObj, DateUtils;
- function GetInternetTime: string;
- var
- XmlHttp: OleVariant;
- datetxt: string;
- DateLst: TStringList;
- mon: string;
- timeGMT, GetNetTime: TDateTime;
- s: string;
- begin
- XmlHttp := CreateOleObject('Microsoft.XMLHTTP');
- XmlHttp.Open('GET', 'http://open.baidu.com/special/time/', False);
- XmlHttp.Send;
- datetxt := XmlHttp.GetResponseHeader('Date');
- datetxt := Copy(datetxt, Pos(',', datetxt) + 1, 100);
- datetxt := StringReplace(datetxt, 'GMT', '', []);
- datetxt := Trim(datetxt);
- if datetxt = '' then Exit;
- DateLst := TStringList.Create;
- while Pos(' ', datetxt) > 0 do
- begin
- DateLst.Add(Copy(datetxt, 1, Pos(' ', datetxt) - 1));
- datetxt := Copy(datetxt, Pos(' ', datetxt) + 1, 100);
- end;
- DateLst.Add(datetxt);
- if DateLst[1] = 'Jan' then
- mon := '01'
- else if DateLst[1] = 'Feb' then
- mon := '02'
- else if DateLst[1] = 'Mar' then
- mon := '03'
- else if DateLst[1] = 'Apr' then
- mon := '04'
- else if DateLst[1] = 'Mar' then
- mon := '05'
- else if DateLst[1] = 'Jun' then
- mon := '06'
- else if DateLst[1] = 'Jul' then
- mon := '07'
- else if DateLst[1] = 'Aug' then
- mon := '08'
- else if DateLst[1] = 'Sep' then
- mon := '09'
- else if DateLst[1] = 'Oct' then
- mon := '10'
- else if DateLst[1] = 'Nov' then
- mon := '11'
- else if DateLst[1] = 'Dec' then
- mon := '12';
- s := DateLst[2] + '-' + mon + '-' + DateLst[0] + ' ' + DateLst[3];
- //标准时间
- // ShowMessage(s);
- // '/' or '-'
- timeGMT := StrToDateTime(DateLst[2] + '-' + mon + '-' + DateLst[0] + ' ' + DateLst[3]);
- //转换时区
- GetNetTime := IncHour(TimeGMT, 8);
- // ShowMessage(FormatDateTime('yyyy年mm月dd日 HH:NN:SS', GetNetTime));
- FreeAndNil(DateLst);
- Result:= FormatDateTime('yyyy年mm月dd日 HH:NN:SS', GetNetTime);
- end;
方法二:
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- WebBrowser.Navigate('http://www.timedate.cn/worldclock/ti.asp');
- tmr1.Enabled := True;
- end;
- procedure TForm1.WebBrowserStatusTextChange(Sender: TObject;
- const Text: WideString);
- var
- strText: string;
- begin
- strText := Text;
- if strText = '完成' Then
- begin
- Caption := WebBrowser.OleObject.Document.Body.Innertext;
- tmr1.Enabled := True
- end;
- end;
- procedure TForm1.tmr1Timer(Sender: TObject);
- begin
- tmr1.Enabled := False;
- WebBrowser.Refresh
- end;