Du kan inte välja fler än 25 ämnen Ämnen måste starta med en bokstav eller siffra, kan innehålla bindestreck ('-') och vara max 35 tecken långa.

GetUrlScript.txt 2.5 KiB

54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
54 år sedan
1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798
  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.