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.

217 lines
7.1 KiB

  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.