delphi 随便找个网站获取格林威治时间, 并转换到北京时间


本文整理自网络,侵删。

 uses Winapi.msxml, System.DateUtils;

//实时获取网络时间的函数, 得到的是格林威治时间; 默认从 sohu 服务器获取, 因为它最快, 平均只需 15 毫秒
function GetNetTime(aUrl: WideString = 'http://www.sohu.com'): string;
begin
  with CoXMLHTTP.Create do
  begin
    open('Post', aUrl, False, EmptyParam, EmptyParam);
    send(EmptyParam);
    Result := getResponseHeader('Date');
  end;
end;

//格林威治时间(字符串)转换到北京时间
function GMT2BjDateTime(const GMT: string): TDateTime;
var
  A: TArray<string>;
begin
  A := GMT.Split([',', ' '], ExcludeEmpty); //XE4 支持

  with TStringList.Create do begin
    CommaText := 'Jan=1,Feb=2,Mar=3,Apr=4,May=5,Jun=6,Jul=7,Aug=8,Sep=9,Oct=10,Nov=11,Dec=12';
    A[2] := Values[A[2]];
    Free;
  end;

  Result := StrToDateTime(Format('%s/%s/%s %s', [A[3], A[2], A[1], A[4]]), FormatSettings.Create(2052));
  Result := Result + 8/24; //换算成北京时间
end;

//测试
procedure TForm1.Button1Click(Sender: TObject);
var
  strGMT: string;
  bjDateTime: TDateTime;
begin
  strGMT := GetNetTime();
  bjDateTime := GMT2BjDateTime(strGMT);

  ShowMessageFmt('%s'#13#10'%s', [strGMT, DateTimeToStr(bjDateTime)]);
end;
--------------------------------------------------------------------------------

在真正实用中, 我把 GMT2BjDateTime 函数换成了:
--------------------------------------------------------------------------------


function GMT2BjDateTime(const GMT: string): TDateTime;
var
  A: TArray<string>;
  Y,M,D,H,N,S: Word;
begin
  A := GMT.Split([',', ' ', ':'], ExcludeEmpty);

  with TStringList.Create do begin
    CommaText := 'Jan=1,Feb=2,Mar=3,Apr=4,May=5,Jun=6,Jul=7,Aug=8,Sep=9,Oct=10,Nov=11,Dec=12';
    A[2] := Values[A[2]];
    Free;
  end;

  Y := StrToIntDef(A[3], YearOf(Now));
  M := StrToIntDef(A[2], MonthOf(Now));
  D := StrToIntDef(A[1], DayOf(Now));
  H := StrToIntDef(A[4], HourOf(Now));
  N := StrToIntDef(A[5], MinuteOf(Now));
  S := StrToIntDef(A[6], SecondOf(Now));

  Result := EncodeDateTime(Y, M , D, H, N, S, 0);
  Result := Result + 8/24; //换算成北京时间
end;
--------------------------------------------------------------------------------

相关阅读 >>

Delphi 打造mygetprocaddress函数(Delphi源码)

Delphi windows 下用 Delphi 代码杀死进程,或者杀死自己

Delphi格式化wmi中的datetime

Delphi中的instrrev函数(倒找文本)

Delphi 关闭所有正在运行的程序

Delphi comparedatetime、comparedate、comparetime、samedatetime、samedate、sametime �c 对比时间的函数

Delphi判断文本文件的编码格式

Delphi image 图像清空

Delphi unigui程序部署到服务器

Delphi 利用http的post方法做个在线翻译的小工

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...