You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

99 lines
2.5 KiB

  1. const
  2. ts_key = 'ytrf_ts';
  3. lts_key = 'ytrf_lts';
  4. procedure InitScriptBuffer;
  5. begin
  6. if ScriptBuffer = '' then begin
  7. ScriptBuffer := '<' + ts_key + '=0>_<' + lts_key + '=0>';
  8. end;
  9. end;
  10. procedure SaveIntValue(const key: string; const value: Integer);
  11. var
  12. val_expr, val_repl: string;
  13. begin
  14. val_expr := '<' + key + '=(\d+)>';
  15. val_repl := '<' + key + '=' + IntToStr(value) + '>';
  16. ScriptBuffer := RegExprReplaceMatchSubStr(ScriptBuffer, val_expr, val_repl);
  17. end;
  18. function GetIntValue(const key: string): Integer;
  19. var
  20. val_expr, val_str: string;
  21. begin
  22. val_expr := '<' + key + '=(\d+)>';
  23. val_str := RegExprGetMatchSubStr(ScriptBuffer, val_expr, 1);
  24. if (val_str <> '') then begin
  25. Result := StrToInt(val_str);
  26. end else begin
  27. Result := 0;
  28. end;
  29. end;
  30. function DownloadUrl(const AUrl: AnsiString): string;
  31. var
  32. VResponseCode: Cardinal;
  33. VResponseHeader, VResponseData: AnsiString;
  34. VRequestUrl, VRequestHeader, VPostData: AnsiString;
  35. begin
  36. Result := '';
  37. if Assigned(Downloader) then begin
  38. VRequestUrl := AUrl;
  39. VRequestHeader := '';
  40. VPostData := '';
  41. VResponseHeader := '';
  42. VResponseData := '';
  43. VResponseCode := Downloader.DoHttpRequest(VRequestUrl, VRequestHeader, VPostData, VResponseHeader, VResponseData);
  44. if VResponseCode = 200 then begin
  45. Result := VResponseData;
  46. end;
  47. end;
  48. end;
  49. function IsNeedUpdateTimeStamp(const ADelta: Integer): Boolean;
  50. var
  51. ts, lts: Integer;
  52. begin
  53. ts := GetUnixTime;
  54. lts := GetIntValue(lts_key);
  55. if (ts > lts + ADelta) then begin
  56. SaveIntValue(lts_key, ts);
  57. Result := True;
  58. end else begin
  59. Result := False;
  60. end;
  61. end;
  62. function GetTimeStamp(const ADelta: Integer): Integer;
  63. var
  64. ts: Integer;
  65. ts_val: string;
  66. stat_js: string;
  67. begin
  68. ts := 0;
  69. if IsNeedUpdateTimeStamp(ADelta) then begin
  70. stat_js := DownloadUrl('https://api-maps.yandex.ru/services/coverage/v2/layers_stamps?l=trf');
  71. if stat_js <> '' then begin
  72. ts_val := RegExprGetMatchSubStr(stat_js, '"version":"(\d+)"', 1);
  73. if ts_val <> '' then begin
  74. ts := StrToInt(ts_val);
  75. SaveIntValue(ts_key, ts);
  76. end;
  77. end;
  78. end else begin
  79. ts := GetIntValue(ts_key);
  80. end;
  81. Result := ts;
  82. end;
  83. begin
  84. InitScriptBuffer;
  85. if GetZ <> 0 then begin
  86. ResultURL := GetURLBase + IntToStr(GetX) + '&y=' + IntToStr(GetY) +
  87. '&z=' + IntToStr(GetZ-1) + '&tm=' + IntToStr(GetTimeStamp(60));
  88. end else begin
  89. ResultURL := '';
  90. end;
  91. end.