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.

GetUrlScript.txt 7.1 KiB

3 years ago
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216
  1. // -----------------------------------------------------------------------------
  2. // --- Универсальный адаптер от AnyGIS
  3. // -----------------------------------------------------------------------------
  4. // Этот скрипт призван упростить добавление новых карт в SasPlanet.
  5. // Он избавит начинающих пользователей от необходимости программировать на Pascal,
  6. // чтобы вносить изменения в файл GetUrlScript.txt при добавлении каждой новой карты.
  7. // Теперь можно просто вставлять привычный URL с заглушками типа {x}, {y}, {z}
  8. // в поле DefURLBase из файла params.txt. На пример, так:
  9. //
  10. // DefURLBase=http://{s:a,b,c}.tile.openstreetmap.org/{z}/{x}/{y}.png
  11. // Скрипт разрабатывали Nnngrach и Erelen
  12. // --- Список доступных параметров для автозамены:
  13. // {x} Номер тайла по оси X. (Как в картах OpenStreetMaps)
  14. // {y} Номер тайла по оси Y. (Как в картах OpenStreetMaps)
  15. // {z} Уровень приближения/зума. (Как в картах OpenStreetMaps)
  16. // {q} Номер тайла в системе QuadKey. (Как в картах Bing)
  17. // {-y} Инвертированный номер тайла по оси Y. (Как на сайте Nakarte)
  18. // {bbox} Координаты границ тайла. (Для WMS серверов)
  19. // {timeStamp} Текущее время в формате UnixTime. (Для карт с пробками)
  20. // {z+1} Уровень зума. (Для карт, хранящихся в формате SasPlanet)
  21. // {x/1024} Номер первой подпапки (Для карт, в формате SasPlanet)
  22. // {y/1024} Номер второй подпапки (Для карт, в формате SasPlanet)
  23. // {s:a,b,c} Буква или цифра с номером зеркала сервера.
  24. // В данном случае - одна из букв (A,B,C), выбранная рандомно.
  25. // Совет для начинающих: если хотите разобраться в этом коде,
  26. // то удобнее всего читать его с конца.
  27. // Еще один совет: если будете писать свои скрипты,
  28. // то вывод в консоль (а точнее, в окно Debug Output ) делается так:
  29. //
  30. // writeLn('Hello Sas.Planet!');
  31. // -----------------------------------------------------------------------------
  32. // --- 4. Вспомогательные функции
  33. // -----------------------------------------------------------------------------
  34. // --- Проверить, содержит ли одна строка другую?
  35. function isContains(findingText: string; inSourceText: string) : boolean;
  36. begin
  37. result := pos(findingText, inSourceText) <> 0;
  38. end;
  39. // --- Округление до нужного количества знаков после запятой
  40. // --- (стандартные функции округления у меня почему-то не заработали)
  41. function roundFor(sourceNumber: Double ; digitAfterComma: integer) : string;
  42. var
  43. intPart, floatPart : integer;
  44. begin
  45. intPart := floor(sourceNumber);
  46. floatPart := floor( (sourceNumber - intPart) * round(intPower(10, digitAfterComma)) )
  47. result := intToStr(intPart) + '.' + intToStr(floatPart)
  48. end;
  49. // --- Вычислить номер тайла в системе Quadkey (используется в картах Bing)
  50. function getQuadkeyText(x: integer; y: integer; z: integer) : string;
  51. var
  52. i, q : byte;
  53. begin
  54. result:='';
  55. for i:=1 to z do begin
  56. q:=0;
  57. if x mod 2 = 1 then q := q + 1;
  58. if y mod 2 = 1 then q := q + 2;
  59. x := x div 2;
  60. y := y div 2;
  61. result := intToStr(q) + result;
  62. end;
  63. end;
  64. // -----------------------------------------------------------------------------
  65. // --- 3. Если требуется, то подставить имя для зеркала сервера
  66. // --- на место заглушки типа {s: a,b,c}
  67. // -----------------------------------------------------------------------------
  68. type
  69. TSubst = record
  70. mask, val : string;
  71. end;
  72. TSubsts = record
  73. count : integer;
  74. s : array [0..15] of TSubst;
  75. end;
  76. function replaceServerName(url: string) : string;
  77. var
  78. s, ss : string;
  79. sarr : array [0..9] of string;
  80. sarr_l, p : integer;
  81. begin
  82. s := RegExprGetMatchSubStr(url, '\{[sS]:([^}]+)\}', 0);
  83. if s <> '' then begin
  84. ss := s;
  85. ss := StringReplace(ss, '{s:', '', [rfIgnoreCase]);
  86. ss := StringReplace(ss, '}', '', [rfIgnoreCase]);
  87. ss := ss + ',';
  88. sarr_l := 0;
  89. while ss <> '' do begin
  90. p := pos(',', ss);
  91. if p = 0 then p := length(ss);
  92. sarr[sarr_l] := copy(ss, 1, p-1);
  93. sarr_l := sarr_l + 1;
  94. delete(ss, 1, p);
  95. end;
  96. url := StringReplace(url, s, sarr[random(sarr_l)], []);
  97. end;
  98. Result := url;
  99. end;
  100. // -----------------------------------------------------------------------------
  101. // --- 2. Если требуется, то вычислить и подставить в шаблон URL адреса
  102. // --- нужные значения на место заглушек типа {x}, {y}, {z}.
  103. // -----------------------------------------------------------------------------
  104. function replaceLeafletPlaceholders(urlTemplate: string; x: integer; y: integer; z: integer) : string;
  105. var
  106. options: tReplaceFlags;
  107. calculatedValue: string;
  108. begin
  109. options := [rfReplaceAll, rfIgnoreCase];
  110. result := urlTemplate;
  111. if isContains('{x}', result) then begin
  112. calculatedValue := intToStr(x);
  113. result := stringReplace( result, '{x}', calculatedValue, options)
  114. end;
  115. if isContains('{y}', result) then begin
  116. calculatedValue := intToStr(y);
  117. result := stringReplace( result, '{y}', calculatedValue, options)
  118. end;
  119. if isContains('{z}', result) then begin
  120. calculatedValue := intToStr(z-1);
  121. result := stringReplace( result, '{z}', calculatedValue, options)
  122. end;
  123. if isContains('{z+1}', result) then begin
  124. calculatedValue := intToStr(z);
  125. result := stringReplace( result, '{z+1}', calculatedValue, options)
  126. end;
  127. if isContains('{x/1024}', result) then begin
  128. calculatedValue := intToStr(x div 1024);
  129. result := stringReplace( result, '{x/1024}', calculatedValue, options)
  130. end;
  131. if isContains('{y/1024}', result) then begin
  132. calculatedValue := intToStr(y div 1024);
  133. result := stringReplace( result, '{y/1024}', calculatedValue, options)
  134. end;
  135. if isContains('{-y}', result) then begin
  136. calculatedValue := intToStr( round(intPower(2, z-1)) - 1 - y);
  137. result := stringReplace( result, '{-y}', calculatedValue, options)
  138. end;
  139. if isContains('{q}', result) then begin
  140. calculatedValue := getQuadkeyText(x, y, z);
  141. result := stringReplace( result, '{q}', calculatedValue, options)
  142. end;
  143. if isContains('{bbox}', result) then begin
  144. result := stringReplace( result, '{bbox}', '{Left},{Bottom},{Right},{Top}', options)
  145. result := stringReplace( result, '{Left}', roundFor(GetLMetr,8), options)
  146. result := stringReplace( result, '{Bottom}', roundFor(GetBMetr,8), options)
  147. result := stringReplace( result, '{Right}', roundFor(GetRMetr,8), options)
  148. result := stringReplace( result, '{Top}', roundFor(GetTMetr,8), options)
  149. // Делаю замену в пять операций потому, что при попытке
  150. // сделать все одной строкой возникает ошибка.
  151. // Возможно какое-то ограничение на память.
  152. end;
  153. if isContains('{timeStamp}', result) then begin
  154. calculatedValue := IntToStr(GetUnixTime);
  155. result := stringReplace( result, '{timeStamp}', calculatedValue, options)
  156. end;
  157. end;
  158. // -----------------------------------------------------------------------------
  159. // --- 1. Старт скрипта. Запустить вычисление URL-адреса тайла.
  160. // --- Скачать тайл по полученному URL.
  161. // -----------------------------------------------------------------------------
  162. begin
  163. resultURL := replaceLeafletPlaceholders(getURLBase, getX, getY, getZ);
  164. resultURL := replaceServerName(resultURL);
  165. end.