API tools faq
paste
Janilabo

String Handling Commands [18.07.2013]

Janilabo
Jul 17th, 2013
64
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 147.49 KB | None | 0 0
raw download clone embed print report
  1. [SIZE="5"][COLOR="red"]String Handling Commands[/COLOR][/SIZE][SIZE="0"] | [url=http://villavu.com/forum/showthread.php?t=104687]Point Commands[/url] | [url=http://villavu.com/forum/showthread.php?t=104649]Box Commands[/url] | [url=http://villavu.com/forum/showthread.php?t=104689]Integer Commands[/url][/SIZE]
  2.  
  3. Here is a little contribution from me to the SRL community.
  4. After all these years, that I have been here, it is finally time to give something back too (I am very proud member of this great community, even though I haven't been all that active)! :)
  5.  
  6. Sorry for not commenting any of my code - I still haven't learned to comment my code.
  7. ..and I doubt I ever will, sadly. :( Just not my strongest field.
  8.  
  9. I added small examples for commands, just to show how they work (due to missing code comments), although most of the functions/procedures are pretty much self-explanatory?.
  10.  
  11. [b]List of [color=blue]Functions[/color] & [color=blue]Procedures[/color]:[/b]
  12.  
  13. [code][u]### / Date Added / Command Name[/u]
  14.  
  15. 000 / 07-04-2013 / Position[Ex]()
  16. 001 / 06-25-2013 / StrContains()
  17. 002 / 06-25-2013 / StrContainsEx()
  18. 003 / 06-13-2013 / Left()
  19. 004 / 06-13-2013 / Right()
  20. 005 / 10-06-2012 / CopyEx()
  21. 006 / 04-29-2013 / BetweenEx()
  22. 007 / 08-28-2012 / Reverse()
  23. 008 / 05-15-2012 / StartsWith()
  24. 009 / 05-15-2012 / EndsWith()
  25. 010 / 04-29-2013 / StartWith()
  26. 011 / 04-29-2013 / EndWith()
  27. 012 / 05-15-2012 / TrimStart()
  28. 013 / 05-15-2012 / TrimEnd()
  29. 014 / 05-26-2013 / Behind()
  30. 015 / 05-26-2013 / Ahead()
  31. 016 / 05-13-2012 / After()
  32. 017 / 05-13-2012 / Before()
  33. 018 / 05-13-2012 / AfterEx()
  34. 019 / 05-13-2012 / BeforeEx()
  35. 020 / 05-13-2012 / LastAfter()
  36. 021 / 05-13-2012 / LastBefore()
  37. 022 / 06-25-2013 / Center()
  38. 023 / 06-25-2013 / CenterEx()
  39. 024 / 06-06-2013 / PosMultiID()
  40. 025 / 06-06-2013 / PosMultiIDEx()
  41. 026 / 06-06-2013 / PosMulti()
  42. 027 / 06-06-2013 / PosMultiEx()
  43. 028 / 05-13-2012 / LastPos()
  44. 029 / 08-07-2012 / LastPosEx()
  45. 030 / 08-13-2012 / ClosestPos()
  46. 031 / 08-13-2012 / FarthestPos()
  47. 032 / 08-29-2012 / Count()
  48. 033 / 05-22-2012 / CountEx()
  49. 034 / 05-26-2013 / CountMulti()
  50. 035 / 05-14-2012 / Stuff()
  51. 036 / 08-19-2013 / StuffEx()
  52. 037 / 06-15-2013 / WrapTextEx()
  53. 038 / 06-15-2013 / WrapText()
  54. 039 / 08-26-2012 / ReplaceEx()
  55. 040 / 05-14-2012 / Compare()
  56. 041 / 05-14-2012 / Compare2()
  57. 042 / 08-13-2012 / Expand()
  58. 043 / 04-18-2013 / ExpandEx()
  59. 044 / 04-29-2013 / StringOfString()
  60. 045 / 04-29-2013 / StringOfStringEx()
  61. 046 / 07-03-2013 / Line()
  62. 047 / 07-03-2013 / Lines()
  63. 048 / 07-03-2013 / LinePositions()
  64. 049 / 07-03-2013 / LineCount()
  65. 050 / 06-27-2013 / LineByPos()
  66. 051 / 06-27-2013 / PosByLine()
  67. 052 / 06-11-2013 / Indentation()
  68. 053 / 06-02-2013 / SplitEx()
  69. 054 / 06-02-2013 / Split()
  70. 055 / 06-13-2013 / Quotatation()
  71. 056 / 05-30-2013 / PregQuote()
  72. 057 / 05-30-2013 / PregQuoteEx()
  73. 058 / 06-04-2013 / Find() [**]
  74. 059 / 06-08-2013 / FindEx() [*****]
  75. 060 / 08-10-2012 / StringToHex() (by CynicRus)
  76. 061 / 08-10-2012 / HexToString() (by CynicRus)
  77. 062 / 08-10-2012 / WebCode() (by CynicRus)
  78. 063 / 08-10-2012 / WebDecode (by CynicRus)
  79. 064 / 05-01-2013 / ExplodeMulti()
  80. 065 / 05-13-2012 / PosAll()
  81. 066 / 04-29-2013 / PosAllEx()
  82. 067 / 05-26-2013 / PosAllMulti()
  83. 068 / 06-21-2013 / TraceStrsEx() [***]
  84. 069 / 06-21-2013 / TraceStrs() [***]
  85. 070 / 05-30-2013 / TraceStrPositions() [*]
  86. 071 / 05-30-2013 / TraceStrPositionsEx() [*]
  87. 072 / 05-13-2012 / AllBetween()
  88. 073 / 05-14-2012 / MultiBetween()
  89. 074 / 05-14-2012 / MultiBetweenEx()
  90. 075 / 07-16-2013 / GetWords()
  91. 076 / 07-16-2013 / GetWordsEx()
  92. 077 / 07-16-2013 / CountWords()
  93. 078 / 07-16-2013 / CountWordsEx()
  94. 079 / 04-28-2013 / TSAFill()
  95. 080 / 04-28-2013 / TSAFillEx()
  96. 081 / 04-29-2013 / TSAOfString()
  97. 082 / 04-29-2013 / TSAOfStringEx()
  98. 083 / 04-21-2013 / TSAClone()
  99. 084 / 07-14-2012 / TSACopy()
  100. 085 / 04-21-2013 / TSACopyEx()
  101. 086 / 04-28-2013 / TSAGet()
  102. 087 / 04-18-2013 / TSAAdd()
  103. 088 / 09-05-2012 / TSAReverse()
  104. 089 / 04-18-2013 / TSACombine()
  105. 090 / 08-13-2012 / TSAConcat()
  106. 091 / 04-28-2013 / TSAConcatEx()
  107. 092 / 06-10-2013 / TSATrimEx()
  108. 093 / 06-10-2013 / TSATrim()
  109. 094 / 05-14-2012 / TSAContains()
  110. 095 / 07-17-2013 / TSAContainsEx()
  111. 096 / 07-17-2013 / TSAContainsTSA()
  112. 097 / 05-14-2012 / TSADelete()
  113. 098 / 09-05-2012 / TSARemove()
  114. 099 / 05-14-2012 / TSAAppend()
  115. 100 / 05-14-2012 / TSAInsert()
  116. 101 / 04-19-2013 / TSAPlant()
  117. 102 / 04-28-2013 / TSAMove()
  118. 103 / 04-28-2013 / TSASame()
  119. 104 / 05-14-2012 / TSAUnique()
  120. 105 / 05-15-2012 / TSAAllUnique()
  121. 106 / 05-15-2012 / TSAAllSame()
  122. 107 / 04-28-2013 / TSAPos()
  123. 108 / 05-13-2012 / TSAPosAll()
  124. 109 / 07-17-2013 / TSAExtractStrings()
  125. 110 / 07-17-2013 / TSAFilterStrings()
  126. 111 / 10-06-2012 / TSAToParts() [*]
  127. 112 / 05-14-2012 / TSAToATSAByName()
  128. 113 / 05-14-2012 / TSAToATSAByLength()
  129. 114 / 05-15-2012 / ATSAMerge()
  130.  
  131. [i]* = Amount of custom types required.[/i][/code]
  132.  
  133. [spoiler="Position[Ex]"]
  134. [simba]function Position(subStr, s: string): Integer;
  135. var
  136. x, y, z: Integer;
  137. begin
  138. z := Length(s);
  139. y := Length(subStr);
  140. if ((z > 0) and (y > 0) and (y <= z)) then
  141. for Result := 1 to ((z - y) + 1) do
  142. begin
  143. for x := 1 to y do
  144. if (s[((Result + x) - 1)] <> subStr[x]) then
  145. Break;
  146. if (x > y) then
  147. Exit;
  148. end;
  149. Result := 0;
  150. end;
  151.  
  152. function Position2(subStr, s: string): Integer;
  153. var
  154. a, b: Integer;
  155. begin
  156. a := Length(s);
  157. b := Length(subStr);
  158. if ((a > 0) and (b > 0) and (b <= a)) then
  159. for Result := 1 to ((a - b) + 1) do
  160. if (subStr = Copy(s, Result, b)) then
  161. Exit;
  162. Result := 0;
  163. end;
  164.  
  165. function PositionEx(subStr, s: string; offset: Integer): Integer;
  166. var
  167. x, y, z: Integer;
  168. begin
  169. z := Length(s);
  170. y := Length(subStr);
  171. if ((z > 0) and (y > 0) and (y <= z) and (offset > 0) and (offset <= ((z - y) + 1))) then
  172. for Result := offset to ((z - y) + 1) do
  173. begin
  174. for x := 1 to y do
  175. if (s[((Result + x) - 1)] <> subStr[x]) then
  176. Break;
  177. if (x > y) then
  178. Exit;
  179. end;
  180. Result := 0;
  181. end;
  182.  
  183. function PositionEx2(subStr, s: string; offset: Integer): Integer;
  184. var
  185. a, b: Integer;
  186. begin
  187. a := Length(s);
  188. b := Length(subStr);
  189. if ((a > 0) and (b > 0) and (b <= a) and (offset > 0) and (offset <= ((a - b) + 1))) then
  190. for Result := offset to ((a - b) + 1) do
  191. if (subStr = Copy(s, Result, b)) then
  192. Exit;
  193. Result := 0;
  194. end;
  195.  
  196. begin
  197. WriteLn(Position('Test', 'Time for Testing... Test!'));
  198. WriteLn(Position2('Test', 'Time for Testing... Test!'));
  199. WriteLn(Pos('Test', 'Time for Testing... Test!'));
  200. WriteLn(PositionEx('Test', 'Time for Testing... Test!', 11));
  201. WriteLn(PositionEx2('Test', 'Time for Testing... Test!', 11));
  202. WriteLn(PosEx('Test', 'Time for Testing... Test!', 11));
  203. end.[/simba]
  204. [/spoiler]
  205. [spoiler="StrContains"]
  206. [simba]function StrContains(str, s: string): Boolean;
  207. begin
  208. if ((str <> '') and (s <> '')) then
  209. Result := (Pos(s, str) > 0)
  210. else
  211. Result := False;
  212. end;
  213.  
  214. begin
  215. ClearDebug;
  216. if StrContains('StrContains()', 'Contains') then
  217. WriteLn('YAY!');
  218. end.[/simba]
  219. [/spoiler]
  220. [spoiler="StrContainsEx"]
  221. [simba]function StrContainsEx(str, s: string; cs: Boolean): Boolean;
  222. begin
  223. if ((str = '') or (s = '')) then
  224. Result := False
  225. else
  226. if not cs then
  227. Result := (Pos(Lowercase(s), Lowercase(str)) > 0)
  228. else
  229. Result := (Pos(s, str) > 0);
  230. end;
  231.  
  232. begin
  233. ClearDebug;
  234. if StrContainsEx('StrContainsEx()', 'contains', True) then
  235. WriteLn('NAY!');
  236. if StrContainsEx('StrContainsEx()', 'contains', False) then
  237. WriteLn('YAY!');
  238. end.[/simba]
  239. [/spoiler]
  240. [spoiler="Left"]
  241. [simba]function Left(str: string; x: Integer): string;
  242. var
  243. l: Integer;
  244. begin
  245. l := Length(str);
  246. if ((x > 0) and (l > 0)) then
  247. Result := Copy(str, 1, x);
  248. end;
  249.  
  250. var
  251. text: string;
  252.  
  253. begin
  254. ClearDebug;
  255. text := 'Left() TESTING';
  256. WriteLn(text);
  257. WriteLn(Left(text, 6));
  258. end.[/simba]
  259. [/spoiler]
  260. [spoiler="Right"]
  261. [simba]function Right(str: string; x: Integer): string;
  262. var
  263. l: Integer;
  264. begin
  265. l := Length(str);
  266. if ((x > 0) and (l > 0)) then
  267. Result := Copy(str, (l - (x - 1)), x);
  268. end;
  269.  
  270. var
  271. text: string;
  272.  
  273. begin
  274. ClearDebug;
  275. text := 'TESTING Right()';
  276. WriteLn(text);
  277. WriteLn(Right(text, 7));
  278. end.[/simba]
  279. [/spoiler]
  280. [spoiler="CopyEx"]
  281. [simba]const
  282. TEST_STR = 'Janilabo is a nub! ;)';
  283. START_POS = 1;
  284. END_POS = 21;
  285.  
  286. function CopyEx(str: string; pos1, pos2: Integer): string;
  287. var
  288. i, l: Integer;
  289. begin
  290. l := Length(str);
  291. if (l > 0) then
  292. begin
  293. if (pos1 < 1) then
  294. pos1 := 1;
  295. if (pos1 > l) then
  296. pos1 := l;
  297. if (pos2 < 1) then
  298. pos2 := 1;
  299. if (pos2 > l) then
  300. pos2 := l;
  301. if (pos1 < pos2) then
  302. Result := Copy(str, pos1, ((pos2 - pos1) + 1))
  303. else
  304. if (pos1 <> pos2) then
  305. begin
  306. SetLength(Result, ((pos1 - pos2) + 1));
  307. for i := pos1 downto pos2 do
  308. Result[((pos1 - i) + 1)] := Char(str[i]);
  309. end else
  310. Result := Copy(str, pos1, 1);
  311. end else
  312. Result := '';
  313. end;
  314.  
  315. begin
  316. ClearDebug;
  317. WriteLn('CopyEx(''' + TEST_STR + ''', ' + IntToStr(START_POS) + ', ' + IntToStr(END_POS) + '): ' + #13#10 + CopyEx(TEST_STR, START_POS, END_POS) + ' [Low=>High]');
  318. WriteLn('');
  319. WriteLn('CopyEx(''' + TEST_STR + ''', ' + IntToStr(END_POS) + ', ' + IntToStr(START_POS) + '): ' + #13#10 + CopyEx(TEST_STR, END_POS, START_POS) + ' [High=>Low]');
  320. end.[/simba]
  321. [/spoiler]
  322. [spoiler="BetweenEx"]
  323. [simba]{==============================================================================]
  324. Explanation: Returns the string between pos1 and pos2 of str.
  325. [==============================================================================}
  326. function BetweenEx(str: string; pos1, pos2: Integer): string;
  327. var
  328. i, l: Integer;
  329. begin
  330. l := Length(str);
  331. if (pos1 < 0) then
  332. pos1 := 0;
  333. if (pos1 > (l + 1)) then
  334. pos1 := (l + 1);
  335. if (pos2 < 0) then
  336. pos2 := 0;
  337. if (pos2 > (l + 1)) then
  338. pos2 := (l + 1);
  339. if (pos1 < pos2) then
  340. Result := Copy(str, (pos1 + 1), ((pos2 - pos1) - 1))
  341. else
  342. if (pos1 <> pos2) then
  343. begin
  344. SetLength(Result, ((pos1 - pos2) - 1));
  345. for i := (pos1 - 1) downto (pos2 + 1) do
  346. Result[(pos1 - i)] := Char(str[i]);
  347. end else
  348. Result := '';
  349. end;
  350.  
  351. var
  352. str: string;
  353.  
  354. begin
  355. ClearDebug;
  356. str := 'Testing BetweenEx() Works!?';
  357. WriteLn(BetweenEx(str, Pos(' B', str), Pos('?', str)));
  358. WriteLn(BetweenEx(str, Pos('?', str), Pos(' B', str)));
  359. WriteLn('');
  360. WriteLn(BetweenEx(str, 0, (Length(str) + 1)));
  361. WriteLn(BetweenEx(str, (Length(str) + 1), 0));
  362. end.[/simba]
  363. [/spoiler]
  364. [spoiler="Reverse"]
  365. [simba]function Reverse(str: string): string;
  366. var
  367. i, l: Integer;
  368. begin
  369. l := Length(str);
  370. SetLength(Result, l);
  371. for i := l downto 1 do
  372. Result[i] := Char(str[((l - i) + 1)]);
  373. end;
  374.  
  375. begin
  376. ClearDebug;
  377. WriteLn(Reverse('!boj eht od ot smees ,noitcnuf )(trevnI rof gnirts TSET a si sihT'));
  378. end.[/simba]
  379. [/spoiler]
  380. [spoiler="StartsWith"]
  381. [simba]function StartsWith(s, str: string): Boolean;
  382. begin
  383. if ((s <> '') and (str <> '')) then
  384. Result := (s = Copy(str, 1, Length(s)))
  385. else
  386. Result := False;
  387. end;
  388.  
  389. begin
  390. ClearDebug;
  391. if StartsWith('TE', 'TEST') then
  392. WriteLn('YEP!')
  393. else
  394. WriteLn('NOPE.');
  395. end.[/simba]
  396. [/spoiler]
  397. [spoiler="StartWith"]
  398. [simba]{==============================================================================]
  399. Explanation: Returns true if suffix was found in s and it was set as the beginning of the s.
  400. [==============================================================================}
  401. function StartWith(suffix: string; var s: string): Boolean;
  402. var
  403. p, l: Integer;
  404. begin
  405. l := Length(suffix);
  406. if ((s <> '') and (l <= Length(s))) then
  407. begin
  408. p := Pos(suffix, s);
  409. Result := (p > 0);
  410. if Result then
  411. s := Copy(s, p, (Length(s) - (p - 1)));
  412. end else
  413. Result := False;
  414. end;
  415.  
  416. var
  417. str: string;
  418.  
  419. begin
  420. ClearDebug;
  421. str := 'Lets see that StartWith() Works!';
  422. if StartWith('StartWith', str) then
  423. WriteLn(str);
  424. end.[/simba]
  425. [/spoiler]
  426. [spoiler="EndsWith"]
  427. [simba]function EndsWith(s, str: string): Boolean;
  428. var
  429. sL: Integer;
  430. begin
  431. sL := Length(s);
  432. if ((s <> '') and (str <> '')) then
  433. Result := (s = Copy(str, (Length(str) - (sL - 1)), sL))
  434. else
  435. Result := False;
  436. end;
  437.  
  438. begin
  439. ClearDebug;
  440. if EndsWith('ST', 'TEST') then
  441. WriteLn('YEP!')
  442. else
  443. WriteLn('NOPE.');
  444. end.[/simba]
  445. [/spoiler]
  446. [spoiler="EndWith"]
  447. [simba]{==============================================================================]
  448. Explanation: Returns true if suffix was found in s and it was set as the ending of the s.
  449. [==============================================================================}
  450. function EndWith(suffix: string; var s: string): Boolean;
  451. var
  452. t, p, l: Integer;
  453. begin
  454. l := Length(suffix);
  455. if ((s <> '') and (l <= Length(s))) then
  456. begin
  457. if (Length(suffix) <= l) then
  458. begin
  459. repeat
  460. t := PosEx(suffix, s, (p + 1));
  461. if (t > 0) then
  462. p := t;
  463. until (t <= 0);
  464. Result := (p > 0);
  465. if Result then
  466. s := Copy(s, 1, ((p + l) - 1));
  467. end else
  468. Result := False;
  469. end else
  470. Result := False;
  471. end;
  472.  
  473. var
  474. str: string;
  475.  
  476. begin
  477. ClearDebug;
  478. str := 'EndWith() Works! Right? We will see if it does...';
  479. if EndWith('Works!', str) then
  480. WriteLn(str);
  481. end.[/simba]
  482. [/spoiler]
  483. [spoiler="TrimStart"]
  484. [simba]function TrimStart(str: string): string;
  485. var
  486. i, l: Integer;
  487. begin
  488. if (str <> '') then
  489. begin
  490. l := Length(str);
  491. for i := 1 to l do
  492. if (str[i] <> ' ') then
  493. Break;
  494. Result := Copy(str, i, ((l + 1) - i));
  495. end else
  496. Result := '';
  497. end;
  498.  
  499. var
  500. str: string;
  501.  
  502. begin
  503. ClearDebug;
  504. str := ' TEST ';
  505. WriteLn('STR length before TrimStart(): ' + IntToStr(Length(str)) + ' ("' + str + '").');
  506. str := TrimStart(str);
  507. WriteLn('STR length after TrimStart(): ' + IntToStr(Length(str)) + ' ("' + str + '").');
  508. end.[/simba]
  509. [/spoiler]
  510. [spoiler="TrimEnd"]
  511. [simba]function TrimEnd(str: string): string;
  512. var
  513. i, l: Integer;
  514. begin
  515. if (str <> '') then
  516. begin
  517. l := Length(str);
  518. for i := l downto 1 do
  519. if (str[i] <> ' ') then
  520. Break;
  521. Result := Copy(str, 1, i);
  522. end else
  523. Result := '';
  524. end;
  525.  
  526. var
  527. str: string;
  528.  
  529. begin
  530. ClearDebug;
  531. str := ' TEST ';
  532. WriteLn('STR length before TrimEnd(): ' + IntToStr(Length(str)) + ' ("' + str + '").');
  533. str := TrimEnd(str);
  534. WriteLn('STR length after TrimEnd(): ' + IntToStr(Length(str)) + ' ("' + str + '").');
  535. end.[/simba]
  536. [/spoiler]
  537. [spoiler="Behind"]
  538. [simba]function Behind(data: string; position, size: Integer): string;
  539. var
  540. l, r: Integer;
  541. begin
  542. l := Length(data);
  543. if ((l > 0) and (position > 1) and (size > 0)) then
  544. begin
  545. if ((position - size) < 1) then
  546. size := ((position - size) + (size - 1));
  547. if (position > (l + 1)) then
  548. begin
  549. r := ((position - l) - 1);
  550. size := (size - r);
  551. end;
  552. Result := Copy(data, ((position - size) - r), size);
  553. end else
  554. Result := '';
  555. end;
  556.  
  557. var
  558. str: string;
  559. p, c: Integer;
  560.  
  561. begin
  562. ClearDebug;
  563. str := 'BEHIND <= TEST => AHEAD';
  564. p := Pos(' TEST', str);
  565. c := (p - 1);
  566. WriteLn('Behind(str, ' + IntToStr(p) + ', ' + IntToStr(c) + '): "' + Behind(str, p, c) + '"');
  567. end.[/simba]
  568. [/spoiler]
  569. [spoiler="Ahead"]
  570. [simba]function Ahead(data: string; position, size: Integer): string;
  571. var
  572. l: Integer;
  573. begin
  574. l := Length(data);
  575. if ((l > 0) and (position <= l) and (size > 0)) then
  576. begin
  577. if (position < 1) then
  578. begin
  579. {$IFNDEF Lape}
  580. size := (size - iAbs(position - 1));
  581. {$ELSE}
  582. size := (size - Abs(position - 1));
  583. {$ENDIF}
  584. position := 1;
  585. end;
  586. if ((size > 0) and ((position + size) > l)) then
  587. size := (size - (((position + size) - l) - 1));
  588. Result := Copy(data, position, size);
  589. end else
  590. Result := '';
  591. end;
  592.  
  593. var
  594. str: string;
  595. p, c: Integer;
  596.  
  597. begin
  598. ClearDebug;
  599. str := 'BEHIND <= TEST => AHEAD';
  600. p := Pos('=>', str);
  601. c := ((Length(str) - p) + 1);
  602. WriteLn('Ahead(str, ' + IntToStr(p) + ', ' + IntToStr(c) + '): "' + Ahead(str, p, c) + '"');
  603. end.[/simba]
  604. [/spoiler]
  605. [spoiler="After"]
  606. [simba]function After(s, str: string): string;
  607. var
  608. p, strL, sL: Integer;
  609. begin
  610. sL := Length(s);
  611. strL := Length(str);
  612. if (sL < strL) then
  613. begin
  614. p := Pos(s, str);
  615. if (p > 0) then
  616. Result := Copy(str, (p + sL), ((1 + strL) - (p + sL)));
  617. end else
  618. Result := '';
  619. end;
  620.  
  621. var
  622. str: string;
  623.  
  624. begin
  625. ClearDebug;
  626. str := 'What comes after this? After() WORKS!';
  627. WriteLn(After('this? ', str));
  628. end.[/simba]
  629. [/spoiler]
  630. [spoiler="Before"]
  631. [simba]function Before(s, str: string): string;
  632. var
  633. p: Integer;
  634. begin
  635. if (Length(s) < Length(str)) then
  636. begin
  637. p := Pos(s, str);
  638. if (p > 1) then
  639. Result := Copy(str, 1, (p - 1))
  640. else
  641. Result := '';
  642. end else
  643. Result := '';
  644. end;
  645.  
  646. var
  647. str: string;
  648.  
  649. begin
  650. ClearDebug;
  651. str := 'Before() WORKS! Test to see if Before() works correctly.';
  652. WriteLn(Before(' Test', str));
  653. end.[/simba]
  654. [/spoiler]
  655. [spoiler="AfterEx"]
  656. [simba]function AfterEx(s, str: string; offset: Integer): string;
  657. var
  658. p, sL, strL: Integer;
  659. begin
  660. sL := Length(s);
  661. strL := Length(str);
  662. if ((sL < strL) and (offset < strL)) then
  663. begin
  664. p := PosEx(s, str, offset);
  665. if (p > 0) then
  666. Result := Copy(str, (p + sL), ((1 + strL) - (p + sL)))
  667. else
  668. Result := '';
  669. end else
  670. Result := '';
  671. end;
  672.  
  673. var
  674. o: Integer;
  675. str: string;
  676.  
  677. begin
  678. ClearDebug;
  679. str := 'Hmmmph, testing AfterEx(), testing AfterEx() WORKS!';
  680. o := Pos('testing', str);
  681. WriteLn(AfterEx('testing ', str, (o + 1)));
  682. end.[/simba]
  683. [/spoiler]
  684. [spoiler="BeforeEx"]
  685. [simba]function BeforeEx(s, str: string; offset: Integer): string;
  686. var
  687. p, strL: Integer;
  688. begin
  689. strL := Length(str);
  690. if ((Length(s) < strL) and (offset < strL)) then
  691. begin
  692. p := PosEx(s, str, offset);
  693. if (p > 1) then
  694. Result := Copy(str, 1, (p - 1))
  695. else
  696. Result := '';
  697. end else
  698. Result := '';
  699. end;
  700.  
  701. var
  702. o: Integer;
  703. str: string;
  704.  
  705. begin
  706. ClearDebug;
  707. str := 'BeforeEx() WORKS! This is BeforeEx() test!';
  708. o := Pos('This', str);
  709. WriteLn(BeforeEx(' ', str, (o - 1)));
  710. end.[/simba]
  711. [/spoiler]
  712. [spoiler="LastAfter"]
  713. [simba]function LastAfter(s, str: string): string;
  714. var
  715. sL, l, p, lp: Integer;
  716. begin
  717. l := Length(str);
  718. sL := Length(s);
  719. if (sL <= l) then
  720. begin
  721. repeat
  722. p := PosEx(s, str, (p + 1));
  723. if (p > 0) then
  724. lp := p;
  725. until (p <= 0);
  726. if (lp > 0) then
  727. Result := Copy(str, (lp + sL), ((1 + l) - (lp + sL)))
  728. else
  729. Result := '';
  730. end else
  731. Result := '';
  732. end;
  733.  
  734. var
  735. str: string;
  736.  
  737. begin
  738. ClearDebug;
  739. str := 'This is LastAfter() test. YEP, let''s test. LastAfter() WORKS!';
  740. WriteLn(LastAfter('test. ', str));
  741. end.[/simba]
  742. [/spoiler]
  743. [spoiler="LastBefore"]
  744. [simba]function LastBefore(s, str: string): string;
  745. var
  746. l, p, lp: Integer;
  747. begin
  748. l := Length(str);
  749. if (Length(s) <= l) then
  750. begin
  751. repeat
  752. p := PosEx(s, str, (p + 1));
  753. if (p > 0) then
  754. lp := p;
  755. until (p <= 0);
  756. if (lp > 0) then
  757. Result := Copy(str, 1, (lp - 1))
  758. else
  759. Result := '';
  760. end else
  761. Result := '';
  762. end;
  763.  
  764. var
  765. str: string;
  766.  
  767. begin
  768. ClearDebug;
  769. str := 'LastBefore() WORKS! WORKS? Right?! ;)';
  770. WriteLn(LastBefore(' WORK', str));
  771. end.[/simba]
  772. [/spoiler]
  773. [spoiler="Center"]
  774. [simba]function Center(str: string; size: Integer): string;
  775. var
  776. l, p: Integer;
  777. begin
  778. l := Length(str);
  779. if (l >= size) then
  780. Result := str
  781. else
  782. if (l > 0) then
  783. begin
  784. p := (((size - l) div 2) + 1);
  785. Result := (StringOfChar(' ', (p - 1)) + str + StringOfChar(' ', ((size - (p + l)) + 1)));
  786. end else
  787. Result := StringOfChar(' ', size)
  788. end;
  789.  
  790. var
  791. test: string;
  792.  
  793. begin
  794. ClearDebug;
  795. test := 'Center()';
  796. WriteLn('"' + Center(test, (Length(test) * 2)) + '"');
  797. end.[/simba]
  798. [/spoiler]
  799. [spoiler="CenterEx"]
  800. [simba]function CenterEx(str: string; size: Integer; fill: Char): string;
  801. var
  802. l, p: Integer;
  803. begin
  804. l := Length(str);
  805. if (l >= size) then
  806. Result := str
  807. else
  808. if (l > 0) then
  809. begin
  810. p := (((size - l) div 2) + 1);
  811. Result := (StringOfChar(fill, (p - 1)) + str + StringOfChar(fill, ((size - (p + l)) + 1)));
  812. end else
  813. Result := StringOfChar(fill, size);
  814. end;
  815.  
  816. var
  817. test: string;
  818.  
  819. begin
  820. ClearDebug;
  821. test := 'CenterEx()';
  822. WriteLn('"' + CenterEx(test, (Length(test) * 2), '-') + '"');
  823. end.[/simba]
  824. [/spoiler]
  825. [spoiler="PosMultiID"]
  826. [simba]{==============================================================================]
  827. Explanation: Finds position from s items in str. Stores the ID of the found s item to index variable.
  828. The importance order for d items is from left to right (=>).
  829. So place the important ones first and then less important after those.
  830. [==============================================================================}
  831. function PosMultiID(s: TStringArray; str: string; var index: Integer): Integer;
  832. var
  833. h, i, p, t: Integer;
  834. begin
  835. Result := -1;
  836. index := -1;
  837. h := High(s);
  838. if ((h > -1) and (str <> '')) then
  839. begin
  840. t := (Length(str) + 1);
  841. Result := t;
  842. for i := 0 to h do
  843. begin
  844. p := Pos(s[i], str);
  845. if ((p > 0) and (p < Result)) then
  846. begin
  847. Result := p;
  848. index := i;
  849. end;
  850. end;
  851. if (Result = t) then
  852. Result := 0;
  853. end;
  854. end;
  855.  
  856. var
  857. str: string;
  858. ID, position: Integer;
  859. items: TStringArray;
  860.  
  861. begin
  862. ClearDebug;
  863. str := 'Remember, this string variable is just for testing purposes!';
  864. items := ['testing', 'just', 'string'];
  865. position := PosMultiID(items, str, ID);
  866. if (position > 0) then
  867. WriteLn('Found item[' + IntToStr(ID) + '] ("' + items[ID] + '") inside str at position ' + IntToStr(position))
  868. else
  869. WriteLn('Nothing was found. :(');
  870. SetLength(items, 0);
  871. end.[/simba]
  872. [/spoiler]
  873. [spoiler="PosMultiIDEx"]
  874. [simba]{==============================================================================]
  875. Explanation: Finds position from s items in str. Stores the ID of the found s item to index variable.
  876. The importance order for d items is from left to right (=>).
  877. So place the important ones first and then less important after those.
  878. Contains field for offset.
  879. [==============================================================================}
  880. function PosMultiIDEx(s: TStringArray; str: string; var index: Integer; offset: Integer): Integer;
  881. var
  882. h, i, p, t: Integer;
  883. begin
  884. if (offset < 1) then
  885. offset := 1;
  886. Result := -1;
  887. index := -1;
  888. h := High(s);
  889. if ((h > -1) and (str <> '')) then
  890. begin
  891. t := (Length(str) + 1);
  892. Result := t;
  893. for i := 0 to h do
  894. begin
  895. p := PosEx(s[i], str, offset);
  896. if ((p > 0) and (p < Result)) then
  897. begin
  898. Result := p;
  899. index := i;
  900. end;
  901. end;
  902. if (Result = t) then
  903. Result := 0;
  904. end;
  905. end;
  906.  
  907. var
  908. str: string;
  909. ID, position: Integer;
  910. items: TStringArray;
  911.  
  912. begin
  913. ClearDebug;
  914. str := 'Remember, this string variable is just for testing purposes!';
  915. items := ['testing', 'just', 'string'];
  916. position := PosMultiIDEx(items, str, ID, (Pos('string', str) + 1));
  917. if (position > 0) then
  918. WriteLn('Found item[' + IntToStr(ID) + '] ("' + items[ID] + '") inside str at position ' + IntToStr(position))
  919. else
  920. WriteLn('Nothing was found. :(');
  921. SetLength(items, 0);
  922. end.[/simba]
  923. [/spoiler]
  924. [spoiler="PosMulti"]
  925. [simba]{==============================================================================]
  926. Explanation: Finds position from s items in str.
  927. The importance order for d items is from left to right (=>).
  928. So place the important ones first and then less important after those.
  929. [==============================================================================}
  930. function PosMulti(s: TStringArray; str: string): Integer;
  931. var
  932. h, i, p, t: Integer;
  933. begin
  934. h := High(s);
  935. if ((h > -1) and (str <> '')) then
  936. begin
  937. t := (Length(str) + 1);
  938. Result := t;
  939. for i := 0 to h do
  940. begin
  941. p := Pos(s[i], str);
  942. if ((p > 0) and (p < Result)) then
  943. Result := p;
  944. end;
  945. if (Result = t) then
  946. Result := 0;
  947. end else
  948. Result := -1;
  949. end;
  950.  
  951. var
  952. str: string;
  953. position: Integer;
  954. items: TStringArray;
  955.  
  956. begin
  957. ClearDebug;
  958. str := 'Remember, this string variable is just for testing purposes!';
  959. items := ['testing', 'just', 'string'];
  960. position := PosMulti(items, str);
  961. if (position > 0) then
  962. WriteLn('Found some item from items inside str at position ' + IntToStr(position))
  963. else
  964. WriteLn('Nothing was found. :(');
  965. SetLength(items, 0);
  966. end.[/simba]
  967. [/spoiler]
  968. [spoiler="PosMultiEx"]
  969. [simba]{==============================================================================]
  970. Explanation: Finds position from s items in str.
  971. The importance order for d items is from left to right (=>).
  972. So place the important ones first and then less important after those.
  973. Contains field for offset.
  974. [==============================================================================}
  975. function PosMultiEx(s: TStringArray; str: string; offset: Integer): Integer;
  976. var
  977. h, i, p, t: Integer;
  978. begin
  979. h := High(s);
  980. if ((h > -1) and (str <> '')) then
  981. begin
  982. if (offset < 1) then
  983. offset := 1;
  984. t := (Length(str) + 1);
  985. Result := t;
  986. for i := 0 to h do
  987. begin
  988. p := PosEx(s[i], str, offset);
  989. if ((p > 0) and (p < Result)) then
  990. Result := p;
  991. end;
  992. if (Result = t) then
  993. Result := 0;
  994. end else
  995. Result := -1;
  996. end;
  997.  
  998. var
  999. str: string;
  1000. position: Integer;
  1001. items: TStringArray;
  1002.  
  1003. begin
  1004. ClearDebug;
  1005. str := 'Remember, this string variable is just for testing purposes!';
  1006. items := ['testing', 'just', 'string'];
  1007. position := PosMultiEx(items, str, (Pos('string', str) + 1));
  1008. if (position > 0) then
  1009. WriteLn('Found some item from items inside str at position ' + IntToStr(position))
  1010. else
  1011. WriteLn('Nothing was found. :(');
  1012. SetLength(items, 0);
  1013. end.[/simba]
  1014. [/spoiler]
  1015. [spoiler="LastPos"]
  1016. [simba]function LastPos(s, str: string): Integer;
  1017. var
  1018. l, p: Integer;
  1019. begin
  1020. Result := 0;
  1021. l := Length(str);
  1022. if (Length(s) <= l) then
  1023. repeat
  1024. p := PosEx(s, str, (p + 1));
  1025. if (p > 0) then
  1026. Result := p;
  1027. until (p <= 0);
  1028. end;
  1029.  
  1030. begin
  1031. ClearDebug;
  1032. WriteLn(LastPos('.', 'LastPos() test. The DOT is the result position. <= Over there'));
  1033. end.[/simba]
  1034. [/spoiler]
  1035. [spoiler="LastPosEx"]
  1036. [simba]function LastPosEx(s, str: string; offset: Integer): Integer;
  1037. var
  1038. l, p: Integer;
  1039. begin
  1040. Result := 0;
  1041. l := Length(str);
  1042. if ((Length(s) > l) or (offset > l) or (offset < 1)) then
  1043. Exit;
  1044. str := Copy(str, 1, offset);
  1045. repeat
  1046. p := PosEx(s, str, (p + 1));
  1047. if (p > 0) then
  1048. Result := p;
  1049. until (p <= 0);
  1050. end;
  1051.  
  1052. var
  1053. str: string;
  1054.  
  1055. begin
  1056. ClearDebug;
  1057. str := 'LastPosEx() test.. The ".." is the result position... <= Over there! We ignore this: ..';
  1058. WriteLn(LastPosEx('..', str, Pos('We ignore this', str)));
  1059. end.[/simba]
  1060. [/spoiler]
  1061. [spoiler="ClosestPos"]
  1062. [simba]// Returns the closest position of 's' found in 'str' based on 'trgt_pos'.
  1063. function ClosestPos(trgt_pos: Integer; s, str: string): Integer;
  1064. var
  1065. strL, o, p: Integer;
  1066. begin
  1067. Result := 0;
  1068. strL := Length(str);
  1069. if ((Length(s) <= strL) and (trgt_pos >= 1) and (trgt_pos <= strL)) then
  1070. repeat
  1071. p := PosEx(s, str, (o + 1));
  1072. if (p > 0) then
  1073. begin
  1074. if (Result = 0) then
  1075. Result := p
  1076. else
  1077. {$IFNDEF Lape}
  1078. if (iAbs(trgt_pos - p) < iAbs(trgt_pos - Result)) then
  1079. {$ELSE}
  1080. if (Abs(trgt_pos - p) < Abs(trgt_pos - Result)) then
  1081. {$ENDIF}
  1082. Result := p
  1083. else
  1084. Exit;
  1085. o := p;
  1086. end;
  1087. until (p <= 0);
  1088. end;
  1089.  
  1090. var
  1091. h, i, cp: Integer;
  1092. str: string;
  1093. TIA: TIntegerArray;
  1094. TSA, cTSA: TStringArray;
  1095.  
  1096. begin
  1097. ClearDebug;
  1098. str := '<@#%¤ APPLE ~$¤@&* ORANGE ~%@$€* BANANA ~£&#>';
  1099. TSA := ['APPLE', 'ORANGE', 'BANANA'];
  1100. TIA := [Pos(TSA[0], str), Pos(TSA[1], str), Pos(TSA[2], str)];
  1101. cTSA := ['@', '#', '%', '¤', '~', '$', '&', '*', '€', '£'];
  1102. WriteLn('Closest positions...' + #13#10);
  1103. h := High(cTSA);
  1104. for i := 0 to 2 do
  1105. begin
  1106. WriteLn(TSA[i] + ' (pos: ' + IntToStr(TIA[i]) + ')');
  1107. for cp := 0 to h do
  1108. WriteLn(cTSA[cp] + ': ' + IntToStr(ClosestPos(TIA[i], cTSA[cp], str)));
  1109. if (i < 2) then
  1110. WriteLn('');
  1111. end;
  1112. SetLength(TSA, 0);
  1113. SetLength(TIA, 0);
  1114. end.[/simba]
  1115. [/spoiler]
  1116. [spoiler="FarthestPos"]
  1117. [simba]// Returns the farthest position of 's' found in 'str' based on 'trgt_pos'.
  1118. function FarthestPos(trgt_pos: Integer; s, str: string): Integer;
  1119. var
  1120. strL, o, p: Integer;
  1121. begin
  1122. Result := 0;
  1123. strL := Length(str);
  1124. if ((Length(s) <= strL) and (trgt_pos >= 1) and (trgt_pos <= strL)) then
  1125. repeat
  1126. p := PosEx(s, str, (o + 1));
  1127. if (p > 0) then
  1128. begin
  1129. if (Result = 0) then
  1130. Result := p
  1131. else
  1132. {$IFNDEF Lape}
  1133. if (IAbs(trgt_pos - p) > IAbs(trgt_pos - Result)) then
  1134. {$ELSE}
  1135. if (Abs(trgt_pos - p) > Abs(trgt_pos - Result)) then
  1136. {$ENDIF}
  1137. Result := p;
  1138. o := p;
  1139. end;
  1140. until (p <= 0);
  1141. end;
  1142.  
  1143. var
  1144. h, i, cp: Integer;
  1145. str: string;
  1146. TIA: TIntegerArray;
  1147. TSA, cTSA: TStringArray;
  1148.  
  1149. begin
  1150. ClearDebug;
  1151. str := '<@#%¤ APPLE ~$¤@&* ORANGE ~%@$€* BANANA ~£&#>';
  1152. TSA := ['APPLE', 'ORANGE', 'BANANA'];
  1153. TIA := [Pos(TSA[0], str), Pos(TSA[1], str), Pos(TSA[2], str)];
  1154. cTSA := ['@', '#', '%', '¤', '~', '$', '&', '*', '€', '£'];
  1155. WriteLn('Farthest positions...' + #13#10);
  1156. h := High(cTSA);
  1157. for i := 0 to 2 do
  1158. begin
  1159. WriteLn(TSA[i] + ' (pos: ' + IntToStr(TIA[i]) + ')');
  1160. for cp := 0 to h do
  1161. WriteLn(cTSA[cp] + ': ' + IntToStr(FarthestPos(TIA[i], cTSA[cp], str)));
  1162. if (i < 2) then
  1163. WriteLn('');
  1164. end;
  1165. SetLength(TSA, 0);
  1166. SetLength(TIA, 0);
  1167. end.[/simba]
  1168. [/spoiler]
  1169. [spoiler="Count"]
  1170. [simba]function Count(s, str: string): Integer;
  1171. var
  1172. p, sL: Integer;
  1173. begin
  1174. Result := 0;
  1175. sL := Length(s);
  1176. p := (p - (sL - 1));
  1177. if (sL <= Length(str)) then
  1178. repeat
  1179. p := PosEx(s, str, (p + sL));
  1180. if (p > 0) then
  1181. Inc(Result);
  1182. until (p <= 0);
  1183. end;
  1184.  
  1185. var
  1186. s, str: string;
  1187.  
  1188. begin
  1189. ClearDebug;
  1190. str := 'TESTESTESTEST for Count()!';
  1191. s := 'TEST';
  1192. WriteLn('String: "' + str + '"');
  1193. WriteLn('Count of "' + s + '" in String: ' + IntToStr(Count(s, str)) + '!');
  1194. end.[/simba]
  1195. [/spoiler]
  1196. [spoiler="CountEx"]
  1197. [simba]function CountEx(s, str: string; overlap: Boolean): Integer;
  1198. var
  1199. p, o: Integer;
  1200. begin
  1201. Result := 0;
  1202. if not overlap then
  1203. begin
  1204. o := Length(s);
  1205. p := (p - (o - 1));
  1206. end else
  1207. o := 1;
  1208. if (o <= Length(str)) then
  1209. repeat
  1210. p := PosEx(s, str, (p + o));
  1211. if (p > 0) then
  1212. Inc(Result);
  1213. until (p <= 0);
  1214. end;
  1215.  
  1216. var
  1217. s, str: string;
  1218.  
  1219. begin
  1220. ClearDebug;
  1221. str := 'TESTESTESTEST for CountEx()!';
  1222. s := 'TEST';
  1223. WriteLn('String: "' + str + '"');
  1224. WriteLn('Count of "' + s + '" in String: ' + IntToStr(CountEx(s, str, True)) + ' (overlap = ON)!');
  1225. WriteLn('Count of "' + s + '" in String: ' + IntToStr(CountEx(s, str, False)) + ' (overlap = OFF)!');
  1226. end.[/simba]
  1227. [/spoiler]
  1228. [spoiler="CountMulti"]
  1229. [simba]function CountMulti(s: TStringArray; str: string; overlap: Boolean): Integer;
  1230. var
  1231. h, l, p, o, i, t, d, x, y: Integer;
  1232. begin
  1233. Result := 0;
  1234. h := High(s);
  1235. if (h > -1) then
  1236. begin
  1237. o := 1;
  1238. repeat
  1239. p := 0;
  1240. for x := 0 to h do
  1241. begin
  1242. t := PosEx(s[x], str, (l + o));
  1243. if (t < 1) then
  1244. begin
  1245. for y := x to (h - 1) do
  1246. s[y] := s[(y + 1)];
  1247. SetLength(s, h);
  1248. Dec(x);
  1249. Dec(h);
  1250. end else
  1251. if ((p = 0) or (t < p)) then
  1252. begin
  1253. p := t;
  1254. i := x;
  1255. end;
  1256. end;
  1257. if (p > 0) then
  1258. begin
  1259. Inc(Result);
  1260. l := p;
  1261. if not overlap then
  1262. o := Length(s[i]);
  1263. end;
  1264. until (p <= 0);
  1265. end;
  1266. end;
  1267.  
  1268. var
  1269. str: string;
  1270.  
  1271. begin
  1272. ClearDebug;
  1273. str := 'HAHAHAH LOLOLOL!';
  1274. WriteLn(ToStr(CountMulti(['HAH', 'LOL'], str, True)) + ' [overlap = ON]');
  1275. WriteLn(ToStr(CountMulti(['HAH', 'LOL'], str, False)) + ' [overlap = OFF]');
  1276. end.[/simba]
  1277. [/spoiler]
  1278. [spoiler="Stuff"]
  1279. [simba]function Stuff(str, s: string; iFrom, iCount: Integer): string;
  1280. begin
  1281. Result := Copy(str, 1, Length(str));
  1282. Delete(Result, iFrom, iCount);
  1283. Insert(s, Result, iFrom);
  1284. end;
  1285.  
  1286. var
  1287. str: string;
  1288.  
  1289. begin
  1290. ClearDebug;
  1291. str := 'Stuff test to see this is working..!';
  1292. WriteLn(Stuff(str, '() WORKS', 6, 30));
  1293. end.[/simba]
  1294. [/spoiler]
  1295. [spoiler="StuffEx"]
  1296. [simba]{==============================================================================]
  1297. Explanation: Returns str stuffed with s - pos1=start position, pos2=finish position. With pos1 > pos2 s will be reversed.
  1298. [==============================================================================}
  1299. function StuffEx(str, s: string; pos1, pos2: Integer): string;
  1300. var
  1301. i, l: Integer;
  1302. begin
  1303. Result := str;
  1304. l := Length(Result);
  1305. if (pos1 < 1) then
  1306. pos1 := 1;
  1307. if (pos1 > l) then
  1308. pos1 := l;
  1309. if (pos2 < 1) then
  1310. pos2 := 1;
  1311. if (pos2 > l) then
  1312. pos2 := l;
  1313. if (pos1 > pos2) then
  1314. begin
  1315. Delete(Result, pos2, ((pos1 - pos2) + 1));
  1316. l := Length(s);
  1317. SetLength(str, l);
  1318. for i := l downto 1 do
  1319. str[i] := Char(s[((l - i) + 1)]);
  1320. Insert(str, Result, pos2);
  1321. end else
  1322. begin
  1323. Delete(Result, pos1, ((pos2 - pos1) + 1));
  1324. Insert(s, Result, pos1);
  1325. end;
  1326. end;
  1327.  
  1328. var
  1329. str: string;
  1330.  
  1331. begin
  1332. ClearDebug;
  1333. str := 'StuffEx test to see this is working..!';
  1334. WriteLn(StuffEx(str, '() WORKS', 8, 37));
  1335. WriteLn(StuffEx(str, 'SKROW )(', 37, 8));
  1336. end.[/simba]
  1337. [/spoiler]
  1338. [spoiler="WrapTextEx"]
  1339. [simba]function WrapTextEx(str, breakStr, breakChars: string; maxCol: Integer): string;
  1340. var
  1341. a, i, l, p, t, b, c: Integer;
  1342. begin
  1343. l := Length(str);
  1344. Result := '';
  1345. if (l > 0) then
  1346. if ((breakStr <> '') and (breakChars <> '')) then
  1347. begin
  1348. if (maxCol < 1) then
  1349. maxCol := 1;
  1350. a := 1;
  1351. while ((i + a) <= l) do
  1352. begin
  1353. IncEx(i, a);
  1354. p := (i + maxCol);
  1355. b := l;
  1356. for t := i to l do
  1357. if ((t >= p) and (b < l)) then
  1358. Break
  1359. else
  1360. if (Pos(str[t], breakChars) > 0) then
  1361. b := t;
  1362. if (t > l) then
  1363. b := l;
  1364. for c := i to b do
  1365. Result := (Result + str[c]);
  1366. if (b < l) then
  1367. Result := (Result + breakStr);
  1368. a := ((b - i) + 1);
  1369. if (a < 1) then
  1370. a := 1;
  1371. end;
  1372. end else
  1373. Result := str;
  1374. end;
  1375.  
  1376. var
  1377. s: string;
  1378.  
  1379. begin
  1380. ClearDebug;
  1381. s := 'This is quite a long string, at least 50 chars long'; // Example from delphibasics.co.uk
  1382. WriteLn(WrapTextEx(s, #13#10, ' ', 10));
  1383. end.[/simba]
  1384. [/spoiler]
  1385. [spoiler="WrapText"]
  1386. [simba]{$IFNDEF Lape}
  1387. function WrapText(str: string; maxCol: Integer): string;
  1388. {$ELSE}
  1389. function WrapText2(str: string; maxCol: Integer): string;
  1390. {$ENDIF}
  1391. var
  1392. a, i, l, p, t, b, c: Integer;
  1393. begin
  1394. l := Length(str);
  1395. Result := '';
  1396. if (l > 0) then
  1397. begin
  1398. if (maxCol < 1) then
  1399. maxCol := 1;
  1400. a := 1;
  1401. while ((i + a) <= l) do
  1402. begin
  1403. IncEx(i, a);
  1404. p := (i + maxCol);
  1405. b := l;
  1406. for t := i to l do
  1407. if ((t >= p) and (b < l)) then
  1408. Break
  1409. else
  1410. if (Pos(str[t], ' '#9'-') > 0) then
  1411. b := t;
  1412. if (t > l) then
  1413. b := l;
  1414. for c := i to b do
  1415. Result := (Result + str[c]);
  1416. if (b < l) then
  1417. Result := (Result + #13#10);
  1418. a := ((b - i) + 1);
  1419. if (a < 1) then
  1420. a := 1;
  1421. end;
  1422. end;
  1423. end;
  1424.  
  1425. var
  1426. s: string;
  1427.  
  1428. begin
  1429. ClearDebug;
  1430. s := 'This is quite a long string, at least 50 chars long!'; // Example from delphibasics.co.uk
  1431. {$IFNDEF Lape}
  1432. WriteLn(WrapText(s, 10));
  1433. {$ELSE}
  1434. WriteLn(WrapText2(s, 10));
  1435. {$ENDIF}
  1436. end.[/simba]
  1437. [/spoiler]
  1438. [spoiler="ReplaceEx"]
  1439. [simba]function ReplaceEx(Text, FindStr, ReplaceStr: string; Offset: Integer; Flags: TReplaceFlags): string;
  1440. var
  1441. tL: Integer;
  1442. begin
  1443. tL := Length(Text);
  1444. if (Offset < 1) then
  1445. Offset := 1;
  1446. if ((Length(FindStr) <= tL) and (Offset <= tL)) then
  1447. {$IFNDEF Lape}
  1448. Result := (Copy(Text, 1, (Offset - 1)) + ReplaceWrap(Copy(Text, Offset, ((tL - Offset) + 1)), FindStr, ReplaceStr, Flags))
  1449. {$ELSE}
  1450. Result := (Copy(Text, 1, (Offset - 1)) + Replace(Copy(Text, Offset, ((tL - Offset) + 1)), FindStr, ReplaceStr, Flags))
  1451. {$ENDIF}
  1452. else
  1453. Result := '';
  1454. end;
  1455.  
  1456. var
  1457. str: string;
  1458.  
  1459. begin
  1460. ClearDebug;
  1461. str := 'Janilabo is? N?WBI?! :)';
  1462. WriteLn(ReplaceEx(str, '?', 'E', (Pos('?', str) + 1), [rfReplaceAll]));
  1463. end.[/simba]
  1464. [/spoiler]
  1465. [spoiler="Compare"]
  1466. [simba]function Compare(s1, s2: string): Integer;
  1467. begin
  1468. if (s1 = s2) then
  1469. Result := 0
  1470. else
  1471. if (s1 > s2) then
  1472. Result := 1
  1473. else
  1474. Result := -1;
  1475. end;
  1476.  
  1477. function GetRelation(s1, s2: string): string;
  1478. var
  1479. r: Integer;
  1480. begin
  1481. r := Compare(s1, s2);
  1482. case r of
  1483. -1: Result := ('"' + s1 + '" < "' + s2 + '"');
  1484. 0: Result := ('"' + s1 + '" = "' + s2 + '"');
  1485. 1: Result := ('"' + s1 + '" > "' + s2 + '"');
  1486. end;
  1487. end;
  1488.  
  1489. begin
  1490. ClearDebug;
  1491. WriteLn(GetRelation('ABCD A', 'ABCD B'));
  1492. WriteLn(GetRelation('ABCD B', 'ABCD B'));
  1493. WriteLn(GetRelation('ABCD C', 'ABCD B'));
  1494. end.[/simba]
  1495. [/spoiler]
  1496. [spoiler="Compare2"]
  1497. [simba]function Compare2(s1, s2: string): Integer;
  1498. var
  1499. i, mL, s1L, s2L: Integer;
  1500. begin
  1501. Result := 0;
  1502. if (s1 <> s2) then
  1503. begin
  1504. s1L := Length(s1);
  1505. s2L := Length(s2);
  1506. if ((s1L <= 0) or (s2L <= 0)) then
  1507. if (s1L < s2L) then
  1508. Result := -1
  1509. else
  1510. Result := 1;
  1511. if (Result <> 0) then
  1512. Exit;
  1513. Result := -1;
  1514. mL := Min(s1L, s2L);
  1515. for i := 1 to mL do
  1516. if (s1[i] <> s2[i]) then
  1517. begin
  1518. if (s1[i] > s2[i]) then
  1519. Result := 1;
  1520. Exit;
  1521. end;
  1522. if (s1L > s2L) then
  1523. Result := 1;
  1524. end;
  1525. end;
  1526.  
  1527. function GetRelation(s1, s2: string): string;
  1528. var
  1529. r: Integer;
  1530. begin
  1531. r := Compare2(s1, s2);
  1532. case r of
  1533. -1: Result := ('"' + s1 + '" < "' + s2 + '"');
  1534. 0: Result := ('"' + s1 + '" = "' + s2 + '"');
  1535. 1: Result := ('"' + s1 + '" > "' + s2 + '"');
  1536. end;
  1537. end;
  1538.  
  1539. begin
  1540. ClearDebug;
  1541. WriteLn(GetRelation('ABCD A', 'ABCD B'));
  1542. WriteLn(GetRelation('ABCD B', 'ABCD B'));
  1543. WriteLn(GetRelation('ABCD C', 'ABCD B'));
  1544. end.[/simba]
  1545. [/spoiler]
  1546. [spoiler="Expand"]
  1547. [simba]function Expand(trgt_pos: Integer; s1, s2, str: string): string;
  1548. var
  1549. l, p, start, finish, s1L, s2L: Integer;
  1550. tmp: string;
  1551. begin
  1552. Result := '';
  1553. l := Length(str);
  1554. s1L := Length(s1);
  1555. s2L := Length(s2);
  1556. if ((s1L <= l) and (s2L <= l) and (trgt_pos <= l) and (trgt_pos >= 1)) then
  1557. begin
  1558. finish := PosEx(s2, str, trgt_pos);
  1559. if ((finish < 1) or (finish = trgt_pos)) then
  1560. Exit;
  1561. tmp := Copy(str, 1, trgt_pos);
  1562. repeat
  1563. p := PosEx(s1, tmp, (p + 1));
  1564. if (p > 0) then
  1565. start := p;
  1566. until (p <= 0);
  1567. if ((start <> trgt_pos) and (start > 0) and (finish > 0) and (start < finish)) then
  1568. Result := Copy(str, (start + s1L), ((finish - start) - s2L));
  1569. tmp := '';
  1570. end;
  1571. end;
  1572.  
  1573. var
  1574. str, tmp: string;
  1575. id, id_pos: Integer;
  1576.  
  1577. begin
  1578. ClearDebug;
  1579. str := '<item_list>' + #13#10 +
  1580. ' <item_data>' + #13#10 +
  1581. ' <item_name>Apple</item_name>' + #13#10 +
  1582. ' <item_category>Fruits</item_category>' + #13#10 +
  1583. ' <item_ID>2</item_ID>' + #13#10 +
  1584. ' <item_description>Great fruit</item_description>' + #13#10 +
  1585. ' </item_data>' + #13#10 +
  1586. ' <item_data>' + #13#10 +
  1587. ' <item_name>Strawberry</item_name>' + #13#10 +
  1588. ' <item_category>Berries</item_category>' + #13#10 +
  1589. ' <item_ID>0</item_ID>' + #13#10 +
  1590. ' <item_description>Sweet berry</item_description>' + #13#10 +
  1591. ' </item_data>' + #13#10 +
  1592. ' <item_data>' + #13#10 +
  1593. ' <item_name>Tomato</item_name>' + #13#10 +
  1594. ' <item_category>Vegetables</item_category>' + #13#10 +
  1595. ' <item_ID>1</item_ID>' + #13#10
  1596. ' <item_description>Healthy vegetable</item_description>' + #13#10 +
  1597. ' </item_data>' + #13#10 +
  1598. '</item_list>';
  1599. str := Between('<item_list>', '</item_list>', str);
  1600. for id := 0 to 2 do
  1601. begin
  1602. id_pos := Pos(('<item_ID>' + IntToStr(id) + '</item_ID>'), str);
  1603. if (id_pos > 0) then
  1604. begin
  1605. tmp := Expand(id_pos, '<item_data>', '</item_data>', str);
  1606. WriteLn('Item nr.' + IntToStr(id) + ':' + #13#10 +
  1607. 'Name: ' + Between('<item_name>', '</item_name>', tmp) + #13#10
  1608. 'Description: ' + Between('<item_description>', '</item_description>', tmp) + #13#10
  1609. 'Category: ' + Between('<item_category>', '</item_category>', tmp) + #13#10);
  1610. tmp := '';
  1611. end;
  1612. end;
  1613. end.[/simba]
  1614. [/spoiler]
  1615. [spoiler="ExpandEx"]
  1616. [simba]function ExpandEx(trgt_pos: Integer; s1, s2, str: string; includeTags: Boolean): string;
  1617. var
  1618. l, p, start, finish, s1L, s2L, e: Integer;
  1619. tmp: string;
  1620. begin
  1621. Result := '';
  1622. l := Length(str);
  1623. s1L := Length(s1);
  1624. s2L := Length(s2);
  1625. if ((s1L <= l) and (s2L <= l) and (trgt_pos <= l) and (trgt_pos >= 1)) then
  1626. begin
  1627. if includeTags then
  1628. begin
  1629. s1L := 0;
  1630. e := s2L;
  1631. s2L := 0;
  1632. end;
  1633. finish := PosEx(s2, str, trgt_pos);
  1634. if ((finish < 1) or (finish = trgt_pos)) then
  1635. Exit;
  1636. tmp := Copy(str, 1, trgt_pos);
  1637. repeat
  1638. p := PosEx(s1, tmp, (p + 1));
  1639. if (p > 0) then
  1640. start := p;
  1641. until (p <= 0);
  1642. if ((start <> trgt_pos) and (start > 0) and (finish > 0) and (start < finish)) then
  1643. Result := Copy(str, (start + s1L), (((finish - start) - S2L) + e));
  1644. tmp := '';
  1645. end;
  1646. end;
  1647.  
  1648. var
  1649. str, tmp: string;
  1650. id, id_pos: Integer;
  1651.  
  1652. begin
  1653. ClearDebug;
  1654. str := 'Lets do this... {* function ExpandEx() *} It is... Magical!';
  1655. WriteLn('ExpandEx(): "' + ExpandEx(Pos('ExpandEx', str), '{* ', ' *}', str, True) + '" [tags included]');
  1656. WriteLn('ExpandEx(): "' + ExpandEx(Pos('ExpandEx', str), '{* ', ' *}', str, False) + '" [without tags]');
  1657. end.[/simba]
  1658. [/spoiler]
  1659. [spoiler="StringOfString"]
  1660. [simba]{==============================================================================]
  1661. Explanation: Returns str * count times. Example: ('ha', 3) => 'hahaha'
  1662. [==============================================================================}
  1663. function StringOfString(str: string; count: Integer): string;
  1664. var
  1665. i: Integer;
  1666. begin
  1667. Result := '';
  1668. if (count > 0) then
  1669. for i := 1 to count do
  1670. Result := (Result + string(str));
  1671. end;
  1672.  
  1673. begin
  1674. ClearDebug;
  1675. WriteLn(StringOfString('ha', 4));
  1676. end.[/simba]
  1677. [/spoiler]
  1678. [spoiler="StringOfStringEx"]
  1679. [simba]{==============================================================================]
  1680. Explanation: Returns str * count times. Example: ('ha', 3, ' ') => 'ha ha ha'
  1681. Places glue between the str positions to result.
  1682. [==============================================================================}
  1683. function StringOfStringEx(str: string; count: Integer; glue: string): string;
  1684. var
  1685. i: Integer;
  1686. begin
  1687. Result := '';
  1688. if (count > 0) then
  1689. if (count > 1) then
  1690. begin
  1691. for i := 1 to (count - 1) do
  1692. Result := (Result + string(str) + string(glue));
  1693. Result := (Result + string(str));
  1694. end else
  1695. Result := string(str);
  1696. end;
  1697.  
  1698. begin
  1699. ClearDebug;
  1700. WriteLn('"' + StringOfStringEx('hah', 3, '-') + '"');
  1701. WriteLn('"' + StringOfStringEx('hah', 2, '-') + '"');
  1702. WriteLn('"' + StringOfStringEx('hah', 1, '-') + '"');
  1703. WriteLn('"' + StringOfStringEx('hah', 0, '-') + '"');
  1704. end.[/simba]
  1705. [/spoiler]
  1706. [spoiler="Line"]
  1707. [simba]{==============================================================================]
  1708. Explanation: Returns the line text from str by number.
  1709. NOTE: Line numbers start from 1!
  1710. [==============================================================================}
  1711. function Line(str: string; number: Integer): string;
  1712. var
  1713. p, h, i, x, o, m, l, y, z: Integer;
  1714. d, t: TStringArray;
  1715. begin
  1716. if ((str <> '') and (number > 0)) then
  1717. begin
  1718. d := [#13#10, #13, #10];
  1719. h := High(d);
  1720. o := 1;
  1721. SetLength(t, Length(str));
  1722. repeat
  1723. l := 0;
  1724. for x := 0 to h do
  1725. begin
  1726. p := Pos(d[x], str);
  1727. if (p < 1) then
  1728. begin
  1729. z := High(d);
  1730. if ((x <= z) and (x > -1)) then
  1731. begin
  1732. for y := x to (z - 1) do
  1733. d[y] := d[(y + 1)];
  1734. SetLength(d, z);
  1735. end;
  1736. Dec(x);
  1737. Dec(h);
  1738. end else
  1739. if ((l = 0) or (p < l)) then
  1740. begin
  1741. m := x;
  1742. l := p;
  1743. end;
  1744. end;
  1745. if (l > 0) then
  1746. begin
  1747. t[i] := Copy(str, 1, (l - 1));
  1748. Delete(str, 1, ((l + Length(d[m])) - 1));
  1749. Inc(i);
  1750. if (i > number) then
  1751. Break;
  1752. end else
  1753. t[i] := Copy(str, 1, Length(str));
  1754. until (l = 0);
  1755. if ((i + 1) >= number) then
  1756. Result := string(t[(number - 1)]);
  1757. SetLength(t, 0);
  1758. SetLength(d, 0);
  1759. end else
  1760. Result := '';
  1761. end;
  1762.  
  1763. var
  1764. str: string;
  1765. i: Integer;
  1766.  
  1767. begin
  1768. ClearDebug;
  1769. str := ('Line1' + #13#10 + 'Line2' + #13 + 'Line3' + #13#10 + 'Line4' + #10 + 'Line5' + #13#10 + 'TEST!');
  1770. for i := 1 to 5 do
  1771. WriteLn(Line(str, i));
  1772. end.[/simba]
  1773. [/spoiler]
  1774. [spoiler="Lines"]
  1775. [simba]{==============================================================================]
  1776. Explanation: Returns the lines of str as TStringArray.
  1777. [==============================================================================}
  1778. function Lines(str: string): TStringArray;
  1779. var
  1780. p, h, i, x, o, m, l, y, z: Integer;
  1781. d: TStringArray;
  1782. begin
  1783. d := [#13#10, #13, #10];
  1784. h := High(d);
  1785. if ((h > -1) and (str <> '')) then
  1786. begin
  1787. o := 1;
  1788. SetLength(Result, Length(str));
  1789. repeat
  1790. l := 0;
  1791. for x := 0 to h do
  1792. begin
  1793. p := Pos(d[x], str);
  1794. if (p < 1) then
  1795. begin
  1796. z := High(d);
  1797. if ((x <= z) and (x > -1)) then
  1798. begin
  1799. for y := x to (z - 1) do
  1800. d[y] := d[(y + 1)];
  1801. SetLength(d, z);
  1802. end;
  1803. Dec(x);
  1804. Dec(h);
  1805. end else
  1806. if ((l = 0) or (p < l)) then
  1807. begin
  1808. m := x;
  1809. l := p;
  1810. end;
  1811. end;
  1812. if (l > 0) then
  1813. begin
  1814. Result[i] := Copy(str, 1, (l - 1));
  1815. Delete(str, 1, ((l + Length(d[m])) - 1));
  1816. Inc(i);
  1817. end else
  1818. Result[i] := Copy(str, 1, Length(str));
  1819. until (l = 0);
  1820. SetLength(Result, (i + 1));
  1821. end else
  1822. Result := [string(str)];
  1823. end;
  1824.  
  1825. var
  1826. str: string;
  1827.  
  1828. begin
  1829. str := ('Line1' + #13#10 + 'Line2' + #13 + 'Line3' + #13#10 + 'Line4' + #10 + 'Line5');
  1830. WriteLn(ToStr(Lines(str)));
  1831. end.[/simba]
  1832. [/spoiler]
  1833. [spoiler="LinePositions"]
  1834. [simba]function LinePositions(str: string): TIntegerArray;
  1835. var
  1836. s: TStringArray;
  1837. c, i, l, h, p, m, t, o, r: Integer;
  1838. begin
  1839. if (str <> '') then
  1840. begin
  1841. r := 1;
  1842. t := (Length(str) + 1);
  1843. SetLength(Result, t);
  1844. Result[c] := r;
  1845. Inc(c);
  1846. l := 1;
  1847. s := [#13#10, #13, #10];
  1848. h := High(s);
  1849. repeat
  1850. m := t;
  1851. for i := 0 to h do
  1852. begin
  1853. p := PosEx(s[i], str, r);
  1854. if ((p > 0) and (p < m)) then
  1855. begin
  1856. m := p;
  1857. o := Length(s[i]);
  1858. end;
  1859. end;
  1860. if (m < t) then
  1861. begin
  1862. r := (m + o);
  1863. Result[c] := r;
  1864. Inc(c);
  1865. Inc(l);
  1866. end;
  1867. until (m = t);
  1868. SetLength(Result, c);
  1869. end else
  1870. Result := [1];
  1871. end;
  1872.  
  1873. var
  1874. i, h: Integer;
  1875. test: string;
  1876. positions: TIntegerArray;
  1877.  
  1878. begin
  1879. ClearDebug;
  1880. test := 'Line0' + #10 +
  1881. 'Line1' + #13#10 +
  1882. 'Line2' + #13 +
  1883. 'Line3' + #10 +
  1884. 'Line4' + #13 +
  1885. 'Line5' + #13#10 +
  1886. 'Line6' + #10 +
  1887. 'Line7' + #13#10 +
  1888. 'Line8' + #13 +
  1889. 'Line9';
  1890. positions := LinePositions(test);
  1891. h := High(positions);
  1892. for i := 0 to h do
  1893. WriteLn(Copy(test, positions[i], 5));
  1894. end.[/simba]
  1895. [/spoiler]
  1896. [spoiler="LineCount"]
  1897. [simba]function LineCount(str: string): Integer;
  1898. var
  1899. h, l, p, o, i, t, x, y: Integer;
  1900. s: TStringArray;
  1901. begin
  1902. Result := 1;
  1903. if (str <> '') then
  1904. begin
  1905. s := [#13#10, #13, #10];
  1906. h := High(s);
  1907. o := 1;
  1908. repeat
  1909. p := 0;
  1910. for x := 0 to h do
  1911. begin
  1912. t := PosEx(s[x], str, (l + o));
  1913. if (t < 1) then
  1914. begin
  1915. for y := x to (h - 1) do
  1916. s[y] := s[(y + 1)];
  1917. SetLength(s, h);
  1918. Dec(x);
  1919. Dec(h);
  1920. end else
  1921. if ((p = 0) or (t < p)) then
  1922. begin
  1923. p := t;
  1924. i := x;
  1925. end;
  1926. end;
  1927. if (p > 0) then
  1928. begin
  1929. Inc(Result);
  1930. l := p;
  1931. o := Length(s[i]);
  1932. end;
  1933. until (p <= 0);
  1934. SetLength(s, 0);
  1935. end;
  1936. end;
  1937.  
  1938. var
  1939. c: Integer;
  1940. test: string;
  1941.  
  1942. begin
  1943. ClearDebug;
  1944. test := 'Line0' + #10 +
  1945. 'Line1' + #13#10 +
  1946. 'Line2' + #13 +
  1947. 'Line3' + #10 +
  1948. 'Line4' + #13 +
  1949. 'Line5' + #13#10 +
  1950. 'Line6' + #10 +
  1951. 'Line7' + #13#10 +
  1952. 'Line8' + #13 +
  1953. 'Line9';
  1954. c := LineCount(test);
  1955. if (c > 1) then
  1956. WriteLn('Variable "test" contains ' + IntToStr(c) + ' lines!')
  1957. else
  1958. WriteLn('Variable "test" contains ' + IntToStr(c) + ' line!');
  1959. end.[/simba]
  1960. [/spoiler]
  1961. [spoiler="LineByPos"]
  1962. [simba]// Returns line from str by position. Results as 0 with invalid position (<1)
  1963. function LineByPos(str: string; position: Integer): Integer;
  1964. var
  1965. s: TStringArray;
  1966. i, n, o: Integer;
  1967. begin
  1968. if (position > 0) then
  1969. begin
  1970. Result := 1;
  1971. str := Copy(str, 1, position);
  1972. s := [#13#10, #13, #10];
  1973. for i := 0 to High(s) do
  1974. begin
  1975. o := Length(str);
  1976. {$IFNDEF Lape}
  1977. str := ReplaceWrap(str, s[i], '', [rfReplaceAll]);
  1978. {$ELSE}
  1979. str := Replace(str, s[i], '', [rfReplaceAll]);
  1980. {$ENDIF}
  1981. n := ((o - Length(str)) div Length(s[i]));
  1982. IncEx(Result, n);
  1983. end;
  1984. end else
  1985. Result := 0;
  1986. end;
  1987.  
  1988. var
  1989. i: Integer;
  1990. test: string;
  1991.  
  1992. begin
  1993. ClearDebug;
  1994. test := 'Line1' + #13#10 +
  1995. 'Line2' + #13 +
  1996. 'Line3' + #10 +
  1997. 'Line4' + #13 +
  1998. 'Line5' + #13#10 +
  1999. 'Line6' + #10 +
  2000. 'Line7' + #13#10 +
  2001. 'Line8' + #13 +
  2002. 'Line9';
  2003. for i := 0 to 10 do
  2004. WriteLn(LineByPos(test, Pos('Line' + IntToStr(i), test)));
  2005. end.[/simba]
  2006. [/spoiler]
  2007. [spoiler="PosByLine"]
  2008. [simba]function PosByLine(str: string; line: Integer): Integer;
  2009. var
  2010. s: TStringArray;
  2011. i, l, h, p, m, t, o: Integer;
  2012. begin
  2013. if (line > 0) then
  2014. begin
  2015. Result := 1;
  2016. t := (Length(str) + 1);
  2017. if ((t > 1) and (line > 1)) then
  2018. begin
  2019. l := 1;
  2020. s := [#13#10, #13, #10];
  2021. h := High(s);
  2022. repeat
  2023. m := t;
  2024. for i := 0 to h do
  2025. begin
  2026. p := PosEx(s[i], str, Result);
  2027. if ((p > 0) and (p < m)) then
  2028. begin
  2029. m := p;
  2030. o := Length(s[i]);
  2031. end;
  2032. end;
  2033. if (m < t) then
  2034. begin
  2035. Result := (m + o);
  2036. Inc(l);
  2037. end;
  2038. until ((m = t) or (l >= line));
  2039. if (l < line) then
  2040. Result := 0;
  2041. end;
  2042. end else
  2043. Result := 0;
  2044. end;
  2045.  
  2046. var
  2047. p, n13, n10, m, i: Integer;
  2048. test: string;
  2049.  
  2050. begin
  2051. ClearDebug;
  2052. test := 'Line1' + #13#10 +
  2053. 'Line2' + #13 +
  2054. 'Line3' + #10 +
  2055. 'Line4' + #13 +
  2056. 'Line5' + #13#10 +
  2057. 'Line6' + #10 +
  2058. 'Line7' + #13#10 +
  2059. 'Line8' + #13 +
  2060. 'Line9';
  2061. for i := 1 to 9 do
  2062. begin
  2063. p := PosByLine(test, i);
  2064. n13 := PosEx(#13, test, p);
  2065. if (n13 = 0) then
  2066. n13 := Length(test);
  2067. n10 := PosEx(#10, test, p);
  2068. if (n10 = 0) then
  2069. n10 := Length(test);
  2070. m := Min(n13, n10);
  2071. WriteLn('Line ' + IntToStr(i) + ': "' + Copy(test, p, ((m - p) + 1)) + '"');
  2072. end;
  2073. end.[/simba]
  2074. [/spoiler]
  2075. [spoiler="Indentation"]
  2076. [simba]const
  2077. TEXT = 'This' + #13#10 +
  2078. ' is' + #13#10 +
  2079. ' test' + #13#10 +
  2080. ' for' + #13#10 +
  2081. ' Indent()' + #13#10 +
  2082. ' function' + #13#10 +
  2083. '!';
  2084. INDENT = -1; // Indent TEXT with spaces? Value can be positive (indent), 0 (no change) or negative (unindent)
  2085.  
  2086. {==============================================================================]
  2087. Explanation: Indents str with spaces (just like the feature in SCAR, Ctrl+Shift+[I/U]).
  2088. shift is the amount of spaces. It can be positive value (indent), 0 (no change) or negative value (unindent).
  2089. [==============================================================================}
  2090. procedure Indentation(var str: string; shift: Integer);
  2091. var
  2092. d, tmp, nl: TStringArray;
  2093. p, h, i, x, o, m, l, y, z: Integer;
  2094. s: string;
  2095. begin
  2096. if ((str <> '') and (shift <> 0)) then
  2097. begin
  2098. d := [#13#10, #13, #10];
  2099. h := High(d);
  2100. o := 1;
  2101. SetLength(tmp, Length(str));
  2102. SetLength(nl, Length(str));
  2103. repeat
  2104. l := 0;
  2105. for x := 0 to h do
  2106. begin
  2107. p := Pos(d[x], str);
  2108. if (p < 1) then
  2109. begin
  2110. z := High(d);
  2111. if ((x <= z) and (x > -1)) then
  2112. begin
  2113. for y := x to (z - 1) do
  2114. d[y] := d[(y + 1)];
  2115. SetLength(d, z);
  2116. end;
  2117. Dec(x);
  2118. Dec(h);
  2119. end else
  2120. if ((l = 0) or (p < l)) then
  2121. begin
  2122. m := x;
  2123. l := p;
  2124. end;
  2125. end;
  2126. if (l > 0) then
  2127. begin
  2128. tmp[i] := Copy(str, 1, (l - 1));
  2129. nl[i] := string(d[m]);
  2130. Delete(str, 1, ((l + Length(d[m])) - 1));
  2131. Inc(i);
  2132. end else
  2133. tmp[i] := Copy(str, 1, Length(str));
  2134. until (l = 0);
  2135. str := '';
  2136. SetLength(tmp, (i + 1));
  2137. SetLength(nl, i);
  2138. if (shift > 0) then
  2139. begin
  2140. s := StringOfChar(' ', shift);
  2141. for x := 0 to i do
  2142. begin
  2143. str := (str + (s + tmp[x]));
  2144. if (x < i) then
  2145. str := (str + nl[x]);
  2146. end;
  2147. end else
  2148. begin
  2149. {$IFNDEF Lape}
  2150. shift := iAbs(shift);
  2151. {$ELSE}
  2152. shift := Abs(shift);
  2153. {$ENDIF}
  2154. for x := 0 to i do
  2155. begin
  2156. y := 0;
  2157. l := Length(tmp[x]);
  2158. while ((y < shift) and (y < l) and (tmp[x][(y + 1)] = ' ')) do
  2159. Inc(y);
  2160. if (y > 0) then
  2161. Delete(tmp[x], 1, y);
  2162. str := (str + tmp[x]);
  2163. if (x < i) then
  2164. str := (str + nl[x]);
  2165. end;
  2166. end;
  2167. SetLength(tmp, 0);
  2168. SetLength(nl, 0);
  2169. end;
  2170. end;
  2171.  
  2172. var
  2173. str: string;
  2174.  
  2175. begin
  2176. ClearDebug;
  2177. str := TEXT;
  2178. Indentation(str, INDENT);
  2179. WriteLn(str);
  2180. end.[/simba]
  2181. [/spoiler]
  2182. [spoiler="SplitEx"]
  2183. [simba]{==============================================================================]
  2184. Explanation: Splits string (str) from position stores the 2 halves to a and b variables. If includeCenter is set as true, char from position will be included to b variable.
  2185. [==============================================================================}
  2186. procedure SplitEx(str: string; var a, b: string; position: Integer; includeCenter: Boolean);
  2187. var
  2188. l, e: Integer;
  2189. begin
  2190. a := '';
  2191. b := '';
  2192. l := Length(str);
  2193. if (l > 0) then
  2194. begin
  2195. if (position < 1) then
  2196. position := 1;
  2197. a := Copy(str, 1, (position - 1));
  2198. if not includeCenter then
  2199. e := 1;
  2200. IncEx(position, e);
  2201. b := Copy(str, position, ((l - position) + 1));
  2202. end;
  2203. end;
  2204.  
  2205. var
  2206. str, j, l: string;
  2207.  
  2208. begin
  2209. ClearDebug;
  2210. str := 'Jani:labo';
  2211. SplitEx(str, j, l, Pos(':', str), True);
  2212. WriteLn('"' + j + '", "' + l + '"');
  2213. SplitEx(str, j, l, Pos(':', str), False);
  2214. WriteLn('"' + j + '", "' + l + '"');
  2215. end.[/simba]
  2216. [/spoiler]
  2217. [spoiler="Split"]
  2218. [simba]{==============================================================================]
  2219. Explanation: Splits string (str) from position stores the 2 halves to a and b variables.
  2220. NOTE: Does not include the char from position!
  2221. [==============================================================================}
  2222. procedure Split(str: string; var a, b: string; position: Integer);
  2223. var
  2224. l: Integer;
  2225. begin
  2226. a := '';
  2227. b := '';
  2228. l := Length(str);
  2229. if (l > 0) then
  2230. begin
  2231. if (position < 1) then
  2232. position := 1;
  2233. a := Copy(str, 1, (position - 1));
  2234. IncEx(position, 1);
  2235. b := Copy(str, position, ((l - position) + 1));
  2236. end;
  2237. end;
  2238.  
  2239. var
  2240. str, j, l: string;
  2241.  
  2242. begin
  2243. ClearDebug;
  2244. str := 'Jani:labo';
  2245. Split(str, j, l, Pos(':', str));
  2246. WriteLn('"' + j + '", "' + l + '"');
  2247. end.[/simba]
  2248. [/spoiler]
  2249. [spoiler="Quotatation"]
  2250. [simba]function Quotatation(str: string): string;
  2251. begin
  2252. {$IFNDEF Lape}
  2253. Result := ('''' + ReplaceWrap(str, '''', '''''', [rfReplaceAll]) + '''');
  2254. {$ELSE}
  2255. Result := ('''' + Replace(str, '''', '''''', [rfReplaceAll]) + '''');
  2256. {$ENDIF}
  2257. end;
  2258.  
  2259. var
  2260. text: string;
  2261.  
  2262. begin
  2263. ClearDebug;
  2264. text := 'It''s time to test Quotatation';
  2265. WriteLn(text);
  2266. WriteLn(Quotatation(text));
  2267. end.[/simba]
  2268. [/spoiler]
  2269. [spoiler="PregQuote"]
  2270. [simba]function PregQuote(str: string): string;
  2271. var
  2272. l, i: Integer;
  2273. r: string;
  2274. begin
  2275. Result := str;
  2276. r := '.\+*?[^]$(){}=!<>|:-';
  2277. l := Length(str);
  2278. if (l > 0) then
  2279. for i := l downto 1 do
  2280. if (Pos(str[i], r) > 0) then
  2281. Insert('\', Result, i);
  2282. end;
  2283.  
  2284. var
  2285. str: string;
  2286.  
  2287. begin
  2288. ClearDebug;
  2289. str := 'C:\Simba\';
  2290. writeln(PregQuote(str));
  2291. end.[/simba]
  2292. [/spoiler]
  2293. [spoiler="PregQuoteEx"]
  2294. [simba]function PregQuoteEx(str, regexChars: string): string;
  2295. var
  2296. l, i: Integer;
  2297. begin
  2298. Result := str;
  2299. l := Length(str);
  2300. if ((l > 0) and (regexChars <> '')) then
  2301. for i := l downto 1 do
  2302. if (Pos(str[i], regexChars) > 0) then
  2303. Insert('\', Result, i);
  2304. end;
  2305.  
  2306. var
  2307. str: string;
  2308.  
  2309. begin
  2310. ClearDebug;
  2311. str := 'C:\Simba\';
  2312. writeln(PregQuoteEx(str, '.\+*?[^]$(){}=!<>|:-'));
  2313. end.[/simba]
  2314. [/spoiler]
  2315. [spoiler="Find"]
  2316. [simba]const
  2317. TEXT = 'TestesTESTTestest test testest1 2testest test3 TEST Test Test.' + #13#10 + 'TEST!' + #13#10 + 'TeSt';
  2318. FIND_STR = 'test';
  2319.  
  2320. {==============================================================================]
  2321. Explanation: Important types for Find() function! Contains the string matching methods.
  2322. [==============================================================================}
  2323. type
  2324. TMatchMethod = (mmAll, mmIgnoreCase, mmOverlap, mmWholeWords, mmStrictWW, mmGreedyRegex);
  2325. TMatchMethods = set of TMatchMethod;
  2326.  
  2327. var
  2328. methods: array of TMatchMethods;
  2329.  
  2330. procedure SetupMethods;
  2331. begin
  2332. SetLength(methods, 6);
  2333. methods[0] := [];
  2334. methods[1] := [mmIgnoreCase];
  2335. methods[2] := [mmIgnoreCase, mmAll];
  2336. methods[3] := [mmIgnoreCase, mmAll, mmOverlap];
  2337. methods[4] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords];
  2338. methods[5] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW];
  2339. end;
  2340.  
  2341. {==============================================================================]
  2342. Explanation: Returns all the positions of found/matching strings (findStr) in text.
  2343. Uses a set of TMatchMethod (methods) for string matching.
  2344. Contains field for offset.
  2345. [==============================================================================}
  2346. function Find(text, findStr: string; methods: TMatchMethods; offset: Integer): TIntegerArray;
  2347. var
  2348. sb, sa: string;
  2349. r, i, l, f, o, p, d, x, y, abL, abR, abX, abP, spA, spB, spH, spL, spI, spR, spD: Integer;
  2350. re: TRegExp;
  2351. ma, mb, a, s, ol: Boolean;
  2352. c: TIntegerArray;
  2353. t: T2DIntegerArray;
  2354. begin
  2355. l := Length(text);
  2356. f := Length(findStr);
  2357. if ((l > 0) and (f > 0) and (offset <= (l - f))) then
  2358. begin
  2359. if (offset < 1) then
  2360. offset := 1;
  2361. for i := f downto 1 do
  2362. if (Pos(findStr[i], '.\+*?[^]$(){}=!<>|:-') > 0) then
  2363. Insert('\', findStr, i);
  2364. SetLength(Result, l);
  2365. re := TRegExp.Create;
  2366. re.InputString := text;
  2367. re.Expression := findStr;
  2368. if (mmIgnoreCase in methods) then
  2369. re.ModifierI := True;
  2370. re.ModifierM := True;
  2371. a := (mmAll in methods);
  2372. re.ModifierG := (mmGreedyRegex in methods);
  2373. ol := (mmOverlap in methods);
  2374. if not ol then
  2375. o := (Length(findStr) - 1);
  2376. Inc(o);
  2377. p := offset;
  2378. while re.ExecPos(p) do
  2379. begin
  2380. Result[r] := re.MatchPos[0];
  2381. p := (Result[r] + o);
  2382. Inc(r);
  2383. end;
  2384. p := Offset;
  2385. re.Free;
  2386. SetLength(Result, r);
  2387. if ((r > 0) and (mmWholeWords in methods)) then
  2388. begin
  2389. s := (mmStrictWW in methods);
  2390. if not s then
  2391. c := [65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, // A-Z
  2392. 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, // a-z
  2393. 48, 49, 50, 51, 52, 53, 54, 55, 56, 57]; // 0-9
  2394. if ol then
  2395. begin
  2396. spH := High(Result);
  2397. if (spH > -1) then
  2398. begin
  2399. SetLength(t, (spH + 1));
  2400. t[0] := [Integer(Result[0])];
  2401. if (spH > 0) then
  2402. begin
  2403. spR := 1;
  2404. for spI := 1 to spH do
  2405. begin
  2406. for spA := 0 to (spR - 1) do
  2407. begin
  2408. spL := Length(t[spA]);
  2409. for spB := 0 to (spL - 1) do
  2410. begin
  2411. spD := IAbs(Result[spI] - t[spA][spB]);
  2412. if (spD <= f) then
  2413. begin
  2414. SetLength(t[spA], (spL + 1));
  2415. t[spA][spL] := Integer(Result[spI]);
  2416. Break;
  2417. end;
  2418. end;
  2419. if (spB < spL) then
  2420. Break;
  2421. end;
  2422. if (spA >= spR) then
  2423. begin
  2424. t[spR] := [Integer(Result[spI])];
  2425. Inc(spR);
  2426. end;
  2427. end;
  2428. end;
  2429. SetLength(t, spR);
  2430. spH := High(t);
  2431. for spI := spH downto 0 do
  2432. begin
  2433. spB := Low(t[spI]);
  2434. spA := High(t[spI]);
  2435. abX := 1;
  2436. abP := t[spI][spB];
  2437. abL := Length(text);
  2438. if ((abL > 0) and (abP > 1)) then
  2439. begin
  2440. if ((abP - abX) < 1) then
  2441. abX := ((abP - abX) + (abX - 1));
  2442. if (abP > (abL + 1)) then
  2443. begin
  2444. abR := ((abP - abL) - 1);
  2445. abX := (abX - abR);
  2446. end;
  2447. sb := Copy(text, ((abP - abX) - abR), abX);
  2448. end else
  2449. sb := '';
  2450. abX := 1;
  2451. abP := (t[spI][spA] + f);
  2452. abL := Length(text);
  2453. if ((abL > 0) and (abP <= abL)) then
  2454. begin
  2455. if (abP < 1) then
  2456. begin
  2457. abX := (abX - iAbs(abP - 1));
  2458. abP := 1;
  2459. end;
  2460. if ((abX > 0) and ((abP + abX) > abL)) then
  2461. abX := (abX - (((abP + abX) - abL) - 1));
  2462. sa := Copy(text, abP, abX);
  2463. end else
  2464. sa := '';
  2465. if s then
  2466. begin
  2467. mb := (sb = '');
  2468. if not mb then
  2469. mb := ((sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
  2470. ma := (sa = '');
  2471. if not ma then
  2472. ma := ((sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
  2473. end else
  2474. begin
  2475. mb := (sb = '');
  2476. if not mb then
  2477. mb := not InIntArray(c, Ord(sb[1]));
  2478. ma := (sa = '');
  2479. if not ma then
  2480. ma := not InIntArray(c, Ord(sa[1]));
  2481. end;
  2482. if not (mb and ma) then
  2483. begin
  2484. for spD := spI to (spH - 1) do
  2485. t[spD] := t[(spD + 1)];
  2486. SetLength(t, spH);
  2487. Dec(spH);
  2488. end;
  2489. end;
  2490. spH := High(t);
  2491. if (spH > -1) then
  2492. begin
  2493. for spI := 0 to spH do
  2494. IncEx(spR, (High(t[spI]) + 1));
  2495. SetLength(Result, spR);
  2496. spR := 0;
  2497. for spI := 0 to spH do
  2498. begin
  2499. spL := High(t[spI]);
  2500. for spA := 0 to spL do
  2501. begin
  2502. Result[spR] := Integer(t[spI][spA]);
  2503. Inc(spR);
  2504. end;
  2505. end;
  2506. SetLength(Result, spR);
  2507. end else
  2508. SetLength(Result, 0);
  2509. end else
  2510. r := 0;
  2511. end else
  2512. begin
  2513. for x := (r - 1) downto 0 do
  2514. begin
  2515. abX := 1;
  2516. abP := Result[x];
  2517. abL := Length(text);
  2518. if ((abL > 0) and (abP > 1)) then
  2519. begin
  2520. if ((abP - abX) < 1) then
  2521. abX := ((abP - abX) + (abX - 1));
  2522. if (abP > (abL + 1)) then
  2523. begin
  2524. abR := ((abP - abL) - 1);
  2525. abX := (abX - abR);
  2526. end;
  2527. sb := Copy(text, ((abP - abX) - abR), abX);
  2528. end else
  2529. sb := '';
  2530. abX := 1;
  2531. abP := (Result[x] + f);
  2532. abL := Length(text);
  2533. if ((abL > 0) and (abP <= abL)) then
  2534. begin
  2535. if (abP < 1) then
  2536. begin
  2537. abX := (abX - iAbs(abP - 1));
  2538. abP := 1;
  2539. end;
  2540. if ((abX > 0) and ((abP + abX) > abL)) then
  2541. abX := (abX - (((abP + abX) - abL) - 1));
  2542. sa := Copy(text, abP, abX);
  2543. end else
  2544. sa := '';
  2545. if s then
  2546. begin
  2547. mb := (sb = '');
  2548. if not mb then
  2549. mb := ((sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
  2550. ma := (sa = '');
  2551. if not ma then
  2552. ma := ((sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
  2553. end else
  2554. begin
  2555. mb := (sb = '');
  2556. if not mb then
  2557. mb := not InIntArray(c, Ord(sb[1]));
  2558. ma := (sa = '');
  2559. if not ma then
  2560. ma := not InIntArray(c, Ord(sa[1]));
  2561. end;
  2562. if not (mb and ma) then
  2563. begin
  2564. y := (r - 1);
  2565. for d := x to (y - 1) do
  2566. Result[d] := Result[(d + 1)];
  2567. SetLength(Result, y);
  2568. Dec(r);
  2569. end;
  2570. end;
  2571. end;
  2572. end;
  2573. if (not a and (r > 0)) then
  2574. SetLength(Result, 1);
  2575. end else
  2576. SetLength(Result, 0);
  2577. end;
  2578.  
  2579. var
  2580. h, i: Integer;
  2581.  
  2582. begin
  2583. ClearDebug;
  2584. SetupMethods;
  2585. h := High(methods);
  2586. for i := 0 to h do
  2587. WriteLn('Matching positions of FIND_STR found in TEXT using methods[' + IntToStr(i) + ']: ' + ToStr(Find(TEXT, FIND_STR, methods[i], 1)));
  2588. end.[/simba]
  2589. [/spoiler]
  2590. [spoiler="FindEx"]
  2591. [simba]const
  2592. TEXT = 'TestesTESTTestest wwTest. -test! testest1 6test9 2testest test3 TEST Test test.' + #13#10 + ' TEST! ' + #13#10 + 'TeSt';
  2593. FIND_STR = 'test((\!)|(\.))';
  2594. USE_REGEX = True;
  2595.  
  2596. {==============================================================================]
  2597. Explanation: Important types for Find() function! Contains the string matching methods.
  2598. [==============================================================================}
  2599. type
  2600. TMatchMethod = (mmAll, mmIgnoreCase, mmOverlap, mmWholeWords, mmStrictWW, mmGreedyRegex);
  2601. TMatchMethods = set of TMatchMethod;
  2602. TRegexMatch = record
  2603. position, size: Integer;
  2604. text: string;
  2605. end;
  2606. TRegexMatchArray = array of TRegexMatch;
  2607. T2DRegexMatchArray = array of TRegexMatchArray;
  2608.  
  2609. var
  2610. methods: array of TMatchMethods;
  2611.  
  2612. procedure SetupMethods;
  2613. begin
  2614. SetLength(methods, 6);
  2615. methods[0] := [];
  2616. methods[1] := [mmIgnoreCase];
  2617. methods[2] := [mmIgnoreCase, mmAll];
  2618. methods[3] := [mmIgnoreCase, mmAll, mmOverlap];
  2619. methods[4] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords];
  2620. methods[5] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW];
  2621. end;
  2622.  
  2623. {==============================================================================]
  2624. Explanation: Returns all the positions of found/matching strings (findStr) in text.
  2625. Uses a set of TMatchMethod (methods) for string matching.
  2626. Contains field for offset.
  2627. If regex field is set as true, then this function searches for the regex you use.
  2628. [==============================================================================}
  2629. function FindEx(text, findStr: string; methods: TMatchMethods; offset: Integer; regex: Boolean): TIntegerArray;
  2630. var
  2631. rmArr: TRegexMatchArray;
  2632. rmArr2D: T2DRegexMatchArray;
  2633. sb, sa: string;
  2634. r, i, l, f, p, d, o, x, y, abL, abR, abX, abP, spA, spB, spH, spL, spI, spR, spD: Integer;
  2635. re: TRegExp;
  2636. ma, mb, a, s, ol: Boolean;
  2637. c: TIntegerArray;
  2638. t: T2DIntegerArray;
  2639. begin
  2640. l := Length(text);
  2641. f := Length(findStr);
  2642. if ((l > 0) and (f > 0) and (offset <= l)) then
  2643. begin
  2644. if (offset < 1) then
  2645. offset := 1;
  2646. if not regex then
  2647. begin
  2648. for i := f downto 1 do
  2649. if (Pos(findStr[i], '.\+*?[^]$(){}=!<>|:-') > 0) then
  2650. Insert('\', findStr, i);
  2651. SetLength(Result, l);
  2652. re := TRegExp.Create;
  2653. re.InputString := text;
  2654. re.Expression := findStr;
  2655. if (mmIgnoreCase in methods) then
  2656. re.ModifierI := True;
  2657. re.ModifierM := True;
  2658. a := (mmAll in methods);
  2659. re.ModifierG := (mmGreedyRegex in methods);
  2660. ol := (mmOverlap in methods);
  2661. if not ol then
  2662. o := (Length(findStr) - 1);
  2663. Inc(o);
  2664. p := offset;
  2665. while re.ExecPos(p) do
  2666. begin
  2667. Result[r] := re.MatchPos[0];
  2668. p := (Result[r] + o);
  2669. Inc(r);
  2670. end;
  2671. p := Offset;
  2672. re.Free;
  2673. SetLength(Result, r);
  2674. if ((r > 0) and (mmWholeWords in methods)) then
  2675. begin
  2676. s := (mmStrictWW in methods);
  2677. if not s then
  2678. c := [65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, // A-Z
  2679. 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, // a-z
  2680. 48, 49, 50, 51, 52, 53, 54, 55, 56, 57]; // 0-9
  2681. if ol then
  2682. begin
  2683. spH := High(Result);
  2684. if (spH > -1) then
  2685. begin
  2686. SetLength(t, (spH + 1));
  2687. t[0] := [Integer(Result[0])];
  2688. if (spH > 0) then
  2689. begin
  2690. spR := 1;
  2691. for spI := 1 to spH do
  2692. begin
  2693. for spA := 0 to (spR - 1) do
  2694. begin
  2695. spL := Length(t[spA]);
  2696. for spB := 0 to (spL - 1) do
  2697. begin
  2698. spD := IAbs(Result[spI] - t[spA][spB]);
  2699. if (spD <= f) then
  2700. begin
  2701. SetLength(t[spA], (spL + 1));
  2702. t[spA][spL] := Integer(Result[spI]);
  2703. Break;
  2704. end;
  2705. end;
  2706. if (spB < spL) then
  2707. Break;
  2708. end;
  2709. if (spA >= spR) then
  2710. begin
  2711. t[spR] := [Integer(Result[spI])];
  2712. Inc(spR);
  2713. end;
  2714. end;
  2715. end;
  2716. SetLength(t, spR);
  2717. spH := High(t);
  2718. for spI := spH downto 0 do
  2719. begin
  2720. spB := Low(t[spI]);
  2721. spA := High(t[spI]);
  2722. abX := 1;
  2723. abP := t[spI][spB];
  2724. abL := Length(text);
  2725. if ((abL > 0) and (abP > 1)) then
  2726. begin
  2727. if ((abP - abX) < 1) then
  2728. abX := ((abP - abX) + (abX - 1));
  2729. if (abP > (abL + 1)) then
  2730. begin
  2731. abR := ((abP - abL) - 1);
  2732. abX := (abX - abR);
  2733. end;
  2734. sb := Copy(text, ((abP - abX) - abR), abX);
  2735. end else
  2736. sb := '';
  2737. abX := 1;
  2738. abP := (t[spI][spA] + f);
  2739. abL := Length(text);
  2740. if ((abL > 0) and (abP <= abL)) then
  2741. begin
  2742. if (abP < 1) then
  2743. begin
  2744. abX := (abX - iAbs(abP - 1));
  2745. abP := 1;
  2746. end;
  2747. if ((abX > 0) and ((abP + abX) > abL)) then
  2748. abX := (abX - (((abP + abX) - abL) - 1));
  2749. sa := Copy(text, abP, abX);
  2750. end else
  2751. sa := '';
  2752. if s then
  2753. begin
  2754. mb := (sb = '');
  2755. if not mb then
  2756. mb := ((sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
  2757. ma := (sa = '');
  2758. if not ma then
  2759. ma := ((sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
  2760. end else
  2761. begin
  2762. mb := (sb = '');
  2763. if not mb then
  2764. mb := not InIntArray(c, Ord(sb[1]));
  2765. ma := (sa = '');
  2766. if not ma then
  2767. ma := not InIntArray(c, Ord(sa[1]));
  2768. end;
  2769. if not (mb and ma) then
  2770. begin
  2771. for spD := spI to (spH - 1) do
  2772. t[spD] := t[(spD + 1)];
  2773. SetLength(t, spH);
  2774. Dec(spH);
  2775. end;
  2776. end;
  2777. spH := High(t);
  2778. if (spH > -1) then
  2779. begin
  2780. for spI := 0 to spH do
  2781. IncEx(spR, (High(t[spI]) + 1));
  2782. SetLength(Result, spR);
  2783. spR := 0;
  2784. for spI := 0 to spH do
  2785. begin
  2786. spL := High(t[spI]);
  2787. for spA := 0 to spL do
  2788. begin
  2789. Result[spR] := Integer(t[spI][spA]);
  2790. Inc(spR);
  2791. end;
  2792. end;
  2793. SetLength(Result, spR);
  2794. end else
  2795. SetLength(Result, 0);
  2796. end else
  2797. r := 0;
  2798. end else
  2799. begin
  2800. for x := (r - 1) downto 0 do
  2801. begin
  2802. abX := 1;
  2803. abP := Result[x];
  2804. abL := Length(text);
  2805. if ((abL > 0) and (abP > 1)) then
  2806. begin
  2807. if ((abP - abX) < 1) then
  2808. abX := ((abP - abX) + (abX - 1));
  2809. if (abP > (abL + 1)) then
  2810. begin
  2811. abR := ((abP - abL) - 1);
  2812. abX := (abX - abR);
  2813. end;
  2814. sb := Copy(text, ((abP - abX) - abR), abX);
  2815. end else
  2816. sb := '';
  2817. abX := 1;
  2818. abP := (Result[x] + f);
  2819. abL := Length(text);
  2820. if ((abL > 0) and (abP <= abL)) then
  2821. begin
  2822. if (abP < 1) then
  2823. begin
  2824. abX := (abX - iAbs(abP - 1));
  2825. abP := 1;
  2826. end;
  2827. if ((abX > 0) and ((abP + abX) > abL)) then
  2828. abX := (abX - (((abP + abX) - abL) - 1));
  2829. sa := Copy(text, abP, abX);
  2830. end else
  2831. sa := '';
  2832. if s then
  2833. begin
  2834. mb := (sb = '');
  2835. if not mb then
  2836. mb := ((sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
  2837. ma := (sa = '');
  2838. if not ma then
  2839. ma := ((sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
  2840. end else
  2841. begin
  2842. mb := (sb = '');
  2843. if not mb then
  2844. mb := not InIntArray(c, Ord(sb[1]));
  2845. ma := (sa = '');
  2846. if not ma then
  2847. ma := not InIntArray(c, Ord(sa[1]));
  2848. end;
  2849. if not (mb and ma) then
  2850. begin
  2851. y := (r - 1);
  2852. for d := x to (y - 1) do
  2853. Result[d] := Result[(d + 1)];
  2854. SetLength(Result, y);
  2855. Dec(r);
  2856. end;
  2857. end;
  2858. end;
  2859. end;
  2860. if (not a and (r > 0)) then
  2861. SetLength(Result, 1);
  2862. end else
  2863. begin
  2864. SetLength(rmArr, l);
  2865. re := TRegExp.Create;
  2866. re.InputString := text;
  2867. re.Expression := findStr;
  2868. if (mmIgnoreCase in methods) then
  2869. re.ModifierI := True;
  2870. re.ModifierM := True;
  2871. a := (mmAll in methods);
  2872. re.ModifierG := (mmGreedyRegex in methods);
  2873. ol := (mmOverlap in methods);
  2874. p := offset;
  2875. while re.ExecPos(p) do
  2876. begin
  2877. rmArr[r].position := re.MatchPos[0];
  2878. rmArr[r].text := re.Match[0];
  2879. rmArr[r].size := re.MatchLen[0];
  2880. if ol then
  2881. p := (rmArr[r].position + 1)
  2882. else
  2883. p := (rmArr[r].position + rmArr[r].size);
  2884. Inc(r);
  2885. end;
  2886. p := Offset;
  2887. re.Free;
  2888. SetLength(rmArr, r);
  2889. if ((r > 0) and (mmWholeWords in methods)) then
  2890. begin
  2891. s := (mmStrictWW in methods);
  2892. if not s then
  2893. c := [65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, // A-Z
  2894. 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, // a-z
  2895. 48, 49, 50, 51, 52, 53, 54, 55, 56, 57]; // 0-9
  2896. if ol then
  2897. begin
  2898. spH := High(rmArr);
  2899. if (spH > -1) then
  2900. begin
  2901. SetLength(rmArr2D, (spH + 1));
  2902. rmArr2D[0] := [TRegexMatch(rmArr[0])];
  2903. if (spH > 0) then
  2904. begin
  2905. spR := 1;
  2906. for spI := 1 to spH do
  2907. begin
  2908. for spA := 0 to (spR - 1) do
  2909. begin
  2910. spL := Length(rmArr2D[spA]);
  2911. for spB := 0 to (spL - 1) do
  2912. begin
  2913. spD := IAbs(rmArr[spI].position - rmArr2D[spA][spB].position);
  2914. if (spD <= rmArr2D[spA][spB].size) then
  2915. begin
  2916. SetLength(rmArr2D[spA], (spL + 1));
  2917. rmArr2D[spA][spL] := TRegexMatch(rmArr[spI]);
  2918. Break;
  2919. end;
  2920. end;
  2921. if (spB < spL) then
  2922. Break;
  2923. end;
  2924. if (spA >= spR) then
  2925. begin
  2926. rmArr2D[spR] := [TRegexMatch(rmArr[spI])];
  2927. Inc(spR);
  2928. end;
  2929. end;
  2930. end;
  2931. SetLength(rmArr2D, spR);
  2932. spH := High(rmArr2D);
  2933. for spI := spH downto 0 do
  2934. begin
  2935. spB := Low(rmArr2D[spI]);
  2936. spA := High(rmArr2D[spI]);
  2937. abX := 1;
  2938. abP := rmArr2D[spI][spB].position;
  2939. abL := Length(text);
  2940. if ((abL > 0) and (abP > 1)) then
  2941. begin
  2942. if ((abP - abX) < 1) then
  2943. abX := ((abP - abX) + (abX - 1));
  2944. if (abP > (abL + 1)) then
  2945. begin
  2946. abR := ((abP - abL) - 1);
  2947. abX := (abX - abR);
  2948. end;
  2949. sb := Copy(text, ((abP - abX) - abR), abX);
  2950. end else
  2951. sb := '';
  2952. abX := 1;
  2953. abP := (rmArr2D[spI][spA].position + rmArr2D[spI][spA].size);
  2954. abL := Length(text);
  2955. if ((abL > 0) and (abP <= abL)) then
  2956. begin
  2957. if (abP < 1) then
  2958. begin
  2959. abX := (abX - iAbs(abP - 1));
  2960. abP := 1;
  2961. end;
  2962. if ((abX > 0) and ((abP + abX) > abL)) then
  2963. abX := (abX - (((abP + abX) - abL) - 1));
  2964. sa := Copy(text, abP, abX);
  2965. end else
  2966. sa := '';
  2967. if s then
  2968. begin
  2969. mb := (sb = '');
  2970. if not mb then
  2971. mb := ((sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
  2972. ma := (sa = '');
  2973. if not ma then
  2974. ma := ((sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
  2975. end else
  2976. begin
  2977. mb := (sb = '');
  2978. if not mb then
  2979. mb := not InIntArray(c, Ord(sb[1]));
  2980. ma := (sa = '');
  2981. if not ma then
  2982. ma := not InIntArray(c, Ord(sa[1]));
  2983. end;
  2984. if not (mb and ma) then
  2985. begin
  2986. for spD := spI to (spH - 1) do
  2987. rmArr2D[spD] := rmArr2D[(spD + 1)];
  2988. SetLength(rmArr2D, spH);
  2989. Dec(spH);
  2990. end;
  2991. end;
  2992. spH := High(rmArr2D);
  2993. if (spH > -1) then
  2994. begin
  2995. for spI := 0 to spH do
  2996. IncEx(spR, (High(rmArr2D[spI]) + 1));
  2997. SetLength(rmArr, spR);
  2998. spR := 0;
  2999. for spI := 0 to spH do
  3000. begin
  3001. spL := High(rmArr2D[spI]);
  3002. for spA := 0 to spL do
  3003. begin
  3004. rmArr[spR] := TRegexMatch(rmArr2D[spI][spA]);
  3005. Inc(spR);
  3006. end;
  3007. end;
  3008. SetLength(rmArr, spR);
  3009. r := spR;
  3010. end else
  3011. SetLength(rmArr, 0);
  3012. end else
  3013. r := 0;
  3014. end else
  3015. begin
  3016. for x := (r - 1) downto 0 do
  3017. begin
  3018. abX := 1;
  3019. abP := rmArr[x].position;
  3020. abL := Length(text);
  3021. if ((abL > 0) and (abP > 1)) then
  3022. begin
  3023. if ((abP - abX) < 1) then
  3024. abX := ((abP - abX) + (abX - 1));
  3025. if (abP > (abL + 1)) then
  3026. begin
  3027. abR := ((abP - abL) - 1);
  3028. abX := (abX - abR);
  3029. end;
  3030. sb := Copy(text, ((abP - abX) - abR), abX);
  3031. end else
  3032. sb := '';
  3033. abX := 1;
  3034. abP := (rmArr[x].position + rmArr[x].size);
  3035. abL := Length(text);
  3036. if ((abL > 0) and (abP <= abL)) then
  3037. begin
  3038. if (abP < 1) then
  3039. begin
  3040. abX := (abX - iAbs(abP - 1));
  3041. abP := 1;
  3042. end;
  3043. if ((abX > 0) and ((abP + abX) > abL)) then
  3044. abX := (abX - (((abP + abX) - abL) - 1));
  3045. sa := Copy(text, abP, abX);
  3046. end else
  3047. sa := '';
  3048. if s then
  3049. begin
  3050. mb := (sb = '');
  3051. if not mb then
  3052. mb := ((sb = ' ') or (sb = #13#10) or (sb = #13) or (sb = #10));
  3053. ma := (sa = '');
  3054. if not ma then
  3055. ma := ((sa = ' ') or (sa = #13#10) or (sa = #13) or (sa = #10));
  3056. end else
  3057. begin
  3058. mb := (sb = '');
  3059. if not mb then
  3060. mb := not InIntArray(c, Ord(sb[1]));
  3061. ma := (sa = '');
  3062. if not ma then
  3063. ma := not InIntArray(c, Ord(sa[1]));
  3064. end;
  3065. if not (mb and ma) then
  3066. begin
  3067. y := (r - 1);
  3068. for d := x to (y - 1) do
  3069. rmArr[d] := rmArr[(d + 1)];
  3070. SetLength(rmArr, y);
  3071. Dec(r);
  3072. end;
  3073. end;
  3074. end;
  3075. end;
  3076. r := Length(rmArr);
  3077. if (r > 0) then
  3078. begin
  3079. if not a then
  3080. r := 1;
  3081. SetLength(Result, r);
  3082. for i := 0 to (r - 1) do
  3083. Result[i] := rmArr[i].position;
  3084. end else
  3085. SetLength(Result, 0);
  3086. end;
  3087. end else
  3088. SetLength(Result, 0);
  3089. end;
  3090.  
  3091. var
  3092. h, i: Integer;
  3093.  
  3094. begin
  3095. ClearDebug;
  3096. SetupMethods;
  3097. h := High(methods);
  3098. for i := 0 to h do
  3099. WriteLn('Matching positions of FIND_STR found in TEXT using methods[' + IntToStr(i) + ']: ' + ToStr(FindEx(TEXT, FIND_STR, methods[i], 1, USE_REGEX)));
  3100. end.[/simba]
  3101. [/spoiler]
  3102. [spoiler="StringToHex"]
  3103. [simba]// by CynicRus
  3104. function StringToHex(s: string): string;
  3105. var
  3106. i: Integer;
  3107. begin
  3108. Result := '';
  3109. for i := 1 to Length(s) do
  3110. Result := Result + IntToHex(ord(s[i]));
  3111. end;
  3112.  
  3113. begin
  3114. ClearDebug;
  3115. WriteLn(StringToHex('That my string!'));
  3116. end.[/simba]
  3117. [/spoiler]
  3118. [spoiler="HexToString"]
  3119. [simba]// by CynicRus
  3120. function HexToString(s: string): string;
  3121. var
  3122. i: Integer;
  3123. begin
  3124. Result := '';
  3125. for i := 1 to Length(s) div 2 do
  3126. try
  3127. Result := Result + chr(StrToInt('$' + Copy(s, i*2-1, 2)));
  3128. except
  3129. Result := Result + '?';
  3130. end;
  3131. end;
  3132.  
  3133. begin
  3134. ClearDebug;
  3135. WriteLn(HexToString('54686174206D7920737472696E6721'));
  3136. end.[/simba]
  3137. [/spoiler]
  3138. [spoiler="WebCode"]
  3139. [simba]// by CynicRus
  3140. function WebCode(const Src: string): string;
  3141. var
  3142. i: Integer;
  3143. begin
  3144. Result := '';
  3145. for i := 1 to Length(Src) do
  3146. Result := (Result + '%' + IntToHex(Ord(Src[i])));
  3147. end;
  3148.  
  3149. begin
  3150. ClearDebug;
  3151. WriteLn(WebCode('that is string!'));
  3152. end.[/simba]
  3153. [/spoiler]
  3154. [spoiler="WebDecode"]
  3155. [simba]// by CynicRus
  3156. function WebHexToInt(HexChar: Char): Integer;
  3157. begin
  3158. if (HexChar < '0') then
  3159. Result := (Ord(HexChar) + 256 - Ord('0'))
  3160. else
  3161. if (HexChar <= Chr(Ord('A') - 1)) then
  3162. Result := Ord(HexChar) - Ord('0')
  3163. else
  3164. if (HexChar <= Chr(Ord('a') - 1)) then
  3165. Result := (Ord(HexChar) - Ord('A') + 10)
  3166. else
  3167. Result := (Ord(HexChar) - Ord('a') + 10);
  3168. end;
  3169.  
  3170. function WebDecode(const S: string): string;
  3171. var
  3172. i, idx, len, n_coded: Integer;
  3173. begin
  3174. len := 0;
  3175. n_coded := 0;
  3176. for i := 1 to Length(S) do
  3177. if (n_coded >= 1) then
  3178. begin
  3179. n_coded := (n_coded + 1);
  3180. if (n_coded >= 3) then
  3181. n_coded := 0;
  3182. end else
  3183. begin
  3184. len := (len + 1);
  3185. if (S[i] = '%') then
  3186. n_coded := 1;
  3187. end;
  3188. SetLength(Result, len);
  3189. idx := 0;
  3190. n_coded := 0;
  3191. for i := 1 to Length(S) do
  3192. if (n_coded >= 1) then
  3193. begin
  3194. n_coded := (n_coded + 1);
  3195. if (n_coded >= 3) then
  3196. begin
  3197. Result[idx] := Chr((WebHexToInt(S[(i - 1)]) * 16 + WebHexToInt(S[i])) mod 256);
  3198. n_coded := 0;
  3199. end;
  3200. end else
  3201. begin
  3202. idx := (idx + 1);
  3203. if (S[i] = '%') then
  3204. n_coded := 1;
  3205. if (S[i] = '+') then
  3206. Result[idx] := ' '
  3207. else
  3208. Result[idx] := S[i];
  3209. end;
  3210. end;
  3211.  
  3212. begin
  3213. ClearDebug;
  3214. WriteLn(WebDecode('%74%68%61%74%20%69%73%20%73%74%72%69%6E%67%21'));
  3215. end.[/simba]
  3216. [/spoiler]
  3217. [spoiler="ExplodeMulti"]
  3218. [simba]{==============================================================================]
  3219. Explanation: Explodes str with multiple separators/delimiters (d).
  3220. The importance order for d items is from left to right (=>).
  3221. So place the important ones first and then less important after those.
  3222. [==============================================================================}
  3223. function ExplodeMulti(d: TStringArray; str: string): TStringArray;
  3224. var
  3225. p, h, i, x, o, m, l, y, z: Integer;
  3226. begin
  3227. h := High(d);
  3228. if ((h > -1) and (str <> '')) then
  3229. begin
  3230. o := 1;
  3231. SetLength(Result, Length(str));
  3232. repeat
  3233. l := 0;
  3234. for x := 0 to h do
  3235. begin
  3236. p := Pos(d[x], str);
  3237. if (p < 1) then
  3238. begin
  3239. z := High(d);
  3240. if ((x <= z) and (x > -1)) then
  3241. begin
  3242. for y := x to (z - 1) do
  3243. d[y] := d[(y + 1)];
  3244. SetLength(d, z);
  3245. end;
  3246. Dec(x);
  3247. Dec(h);
  3248. end else
  3249. if ((l = 0) or (p < l)) then
  3250. begin
  3251. m := x;
  3252. l := p;
  3253. end;
  3254. end;
  3255. if (l > 0) then
  3256. begin
  3257. Result[i] := Copy(str, 1, (l - 1));
  3258. Delete(str, 1, ((l + Length(d[m])) - 1));
  3259. Inc(i);
  3260. end else
  3261. Result[i] := Copy(str, 1, Length(str));
  3262. until (l = 0);
  3263. SetLength(Result, (i + 1));
  3264. end else
  3265. Result := [string(str)];
  3266. end;
  3267.  
  3268. var
  3269. str: string;
  3270.  
  3271. begin
  3272. str := ('Line1' + #13#10 + 'Line2' + #13 + 'Line3' + #13#10 + 'Line4' + #10 + 'Line5');
  3273. WriteLn(ToStr(ExplodeMulti([#13#10, #13, #10], str)));
  3274. end.[/simba]
  3275. [/spoiler]
  3276. [spoiler="PosAll"]
  3277. [simba]function PosAll(s, str: string): TIntegerArray;
  3278. var
  3279. sL, strL, o, p, r: Integer;
  3280. begin
  3281. sL := Length(s);
  3282. strL := Length(str);
  3283. if (sL <= strL) then
  3284. begin
  3285. SetLength(Result, strL);
  3286. repeat
  3287. p := PosEx(s, str, (o + 1));
  3288. if (p > 0) then
  3289. begin
  3290. Result[r] := p;
  3291. o := p;
  3292. Inc(r);
  3293. end;
  3294. until (p <= 0);
  3295. end;
  3296. SetLength(Result, r);
  3297. end;
  3298.  
  3299. var
  3300. s, str: string;
  3301. TIA: TIntegerArray;
  3302. h, i: Integer;
  3303.  
  3304. begin
  3305. ClearDebug;
  3306. str := '|||| PosAll() Test ||| *** ||| Should work pretty well. ||||';
  3307. s := '||';
  3308. TIA := PosAll(s, str);
  3309. h := High(TIA);
  3310. if (h < 0) then
  3311. Exit;
  3312. str := '"' + s + '" positions in str: ';
  3313. for i := 0 to h do
  3314. if (i < h) then
  3315. str := str + IntToStr(TIA[i]) + ', '
  3316. else
  3317. str := str + IntToStr(TIA[i]) + '.';
  3318. WriteLn(str);
  3319. SetLength(TIA, 0);
  3320. end.[/simba]
  3321. [/spoiler]
  3322. [spoiler="PosAllEx"]
  3323. [simba]{==============================================================================]
  3324. Explanation: Returns all the s positions in str.
  3325. If overlap is set to true, strings can overlap.
  3326. ('aa', 'baaaah', False) => [2,3,4]
  3327. ('aa', 'baaaah', True) => [2,4]
  3328. [==============================================================================}
  3329. function PosAllEx(s, str: string; overlap: Boolean): TIntegerArray;
  3330. var
  3331. sL, strL, o, p, r: Integer;
  3332. begin
  3333. sL := Length(s);
  3334. strL := Length(str);
  3335. if (sL <= strL) then
  3336. begin
  3337. if not overlap then
  3338. begin
  3339. o := Length(s);
  3340. p := (p - (o - 1));
  3341. end else
  3342. o := 1;
  3343. SetLength(Result, ((strL div sL) + 1));
  3344. repeat
  3345. p := PosEx(s, str, (p + o));
  3346. if (p > 0) then
  3347. begin
  3348. Result[r] := p;
  3349. Inc(r);
  3350. end;
  3351. until (p <= 0);
  3352. end;
  3353. SetLength(Result, r);
  3354. end;
  3355.  
  3356. var
  3357. s, str: string;
  3358.  
  3359. begin
  3360. ClearDebug;
  3361. str := '|||| PosAllEx() Test ||| *** ||| Should work pretty well. ||||';
  3362. s := '||';
  3363. WriteLn('PosAll(s, str, True): ' + ToStr(PosAllEx('||', str, True)));
  3364. WriteLn('PosAll(s, str, False): ' + ToStr(PosAllEx('||', str, False)));
  3365. end.[/simba]
  3366. [/spoiler]
  3367. [spoiler="PosAllMulti"]
  3368. [simba]{==============================================================================]
  3369. Explanation: Returns all the positions by items from s array in str. Place s items in importance order (=>)
  3370. If overlap is set to true, strings can overlap.
  3371. (['aa'], 'baaaah', False) => [2,3,4]
  3372. (['aa'], 'baaaah', True) => [2,4]
  3373. [==============================================================================}
  3374. function PosAllMulti(s: TStringArray; str: string; overlap: Boolean): TIntegerArray;
  3375. var
  3376. h, l, p, o, x, i, t, r, y, d: Integer;
  3377. begin
  3378. h := High(s);
  3379. y := Length(str);
  3380. if ((y > 0) and (h > -1)) then
  3381. begin
  3382. SetLength(Result, y);
  3383. o := 1;
  3384. repeat
  3385. p := 0;
  3386. for x := 0 to h do
  3387. begin
  3388. t := PosEx(s[x], str, (l + o));
  3389. if (t < 1) then
  3390. begin
  3391. for d := x to (h - 1) do
  3392. s[d] := s[(d + 1)];
  3393. SetLength(s, h);
  3394. Dec(x);
  3395. Dec(h);
  3396. end else
  3397. if ((p = 0) or (t < p)) then
  3398. begin
  3399. p := t;
  3400. i := x;
  3401. end;
  3402. end;
  3403. if (p > 0) then
  3404. begin
  3405. Result[r] := p;
  3406. Inc(r);
  3407. l := p;
  3408. if not overlap then
  3409. o := Length(s[i]);
  3410. end;
  3411. until (p <= 0);
  3412. end;
  3413. SetLength(Result, r);
  3414. end;
  3415.  
  3416. var
  3417. str: string;
  3418.  
  3419. begin
  3420. ClearDebug;
  3421. str := 'HAHAHAH LOLOLOL!';
  3422. WriteLn(ToStr(PosAllMulti(['HAH', 'LOL'], str, True)) + ' [overlap = ON]');
  3423. WriteLn(ToStr(PosAllMulti(['HAH', 'LOL'], str, False)) + ' [overlap = OFF]');
  3424. end.[/simba]
  3425. [/spoiler]
  3426. [spoiler="TraceStrsEx"]
  3427. [simba]type
  3428. TRange = record
  3429. minimum, maximum: Integer;
  3430. end;
  3431. TRangeArray = array of TRange;
  3432. TRegexModifier = (rm_G, rm_I, rm_M, rm_S, rm_X, rm_R);
  3433.  
  3434. {==============================================================================]
  3435. Explanation: Function for tracing findStr's from data.
  3436. Contains also custom fields for regexTags and regexStrs;
  3437. each tag performs a regex action, that is set to regexStrs, during the search.
  3438. [==============================================================================}
  3439. function TraceStrsEx(findStr: string; regexTags: array of Char; regexStrs: TStringArray; data: string; modifiers: set of TRegexModifier): TRangeArray;
  3440. var
  3441. re: TRegExp;
  3442. p, l, r, s, c, h, t: Integer;
  3443. q: string;
  3444. begin
  3445. l := Length(data);
  3446. s := Length(findStr);
  3447. if ((l > 0) and (s > 0)) then
  3448. begin
  3449. h := High(regexTags);
  3450. if (High(regexStrs) < h) then
  3451. SetLength(regexStrs, (h + 1));
  3452. SetLength(Result, l);
  3453. q := '.\+*?[^]$(){}=!<>|:-';
  3454. for c := h downto 0 do
  3455. begin
  3456. t := Pos(q, regexTags[c]);
  3457. if (t > 0) then
  3458. Delete(q, t, 1);
  3459. end;
  3460. for c := s downto 1 do
  3461. if (Pos(findStr[c], q) > 0) then
  3462. Insert('\', findStr, c);
  3463. for t := 0 to h do
  3464. findStr := Replace(findStr, regexTags[t], regexStrs[t], [rfReplaceAll]);
  3465. re := TRegExp.Create;
  3466. re.ModifierI := (rm_I in modifiers);
  3467. re.ModifierG := (rm_G in modifiers);
  3468. re.ModifierM := (rm_M in modifiers);
  3469. re.ModifierS := (rm_S in modifiers);
  3470. re.ModifierX := (rm_X in modifiers);
  3471. re.ModifierR := (rm_R in modifiers);
  3472. re.Expression := findStr;
  3473. re.InputString := data;
  3474. p := 1;
  3475. if re.ExecPos(p) then
  3476. repeat
  3477. if (re.Match[0] <> '') then
  3478. begin
  3479. p := (re.MatchPos[0] + 1);
  3480. Result[r].minimum := re.MatchPos[0];
  3481. Result[r].maximum := (Result[r].minimum + (re.MatchLen[0] - 1));
  3482. Inc(r);
  3483. end;
  3484. until not re.ExecPos(p);
  3485. SetLength(Result, r);
  3486. re.Free;
  3487. end else
  3488. SetLength(Result, 0);
  3489. end;
  3490.  
  3491. var
  3492. str: string;
  3493.  
  3494. begin
  3495. ClearDebug;
  3496. str := ' MMouse ( x , y , 1, 1 );' + #13#10 + // Detects.
  3497. 'mmouse(x, y, 1, 1);' + #13#10 + // Detects.
  3498. 'MMOUSE ( x, y, 1, 1);' + #13#10 + // Detects.
  3499. 'MMouse(x,y,1,1)' + #13#10 + // Detects.
  3500. 'MMouse(x, y, 2, 1)' + #13#10 + // Doesn't detect, because now there is a higher value, than 1, involved (2).
  3501. 'MMouse(x, y, 1 + Random(100), 1 + Random(100));' // Doesn't detect, for same reasons as above. :)
  3502. WriteLn(ToStr(TraceStrsEx('@ ( x , y , 1 , 1 )', [' ', '@'], ['(\s*)', '(m)?mouse'], str, [rm_I])));
  3503. WriteLn(Copy(str, 3, 32));
  3504. WriteLn(Copy(str, 35, 1));
  3505. end.[/simba]
  3506. [/spoiler]
  3507. [spoiler="TraceStrs"]
  3508. [simba]type
  3509. TRange = record
  3510. minimum, maximum: Integer;
  3511. end;
  3512. TRangeArray = array of TRange;
  3513. TRegexModifier = (rm_G, rm_I, rm_M, rm_S, rm_X, rm_R);
  3514.  
  3515. {==============================================================================]
  3516. Explanation: Function for tracing findStr's from data.
  3517. Contains also custom fields for regexTag and regexStr;
  3518. tag performs a regex action, that is set to regexStr, during the search.
  3519. [==============================================================================}
  3520. function TraceStrs(findStr: string; regexTag: Char; regexStr, data: string; modifiers: set of TRegexModifier): TRangeArray;
  3521. var
  3522. re: TRegExp;
  3523. p, l, r, s, c, h, t: Integer;
  3524. q: string;
  3525. begin
  3526. l := Length(data);
  3527. s := Length(findStr);
  3528. if ((l > 0) and (s > 0)) then
  3529. begin
  3530. SetLength(Result, l);
  3531. q := '.\+*?[^]$(){}=!<>|:-';
  3532. t := Pos(regexTag, q);
  3533. if (t > 0) then
  3534. Delete(q, t, 1);
  3535. for c := s downto 1 do
  3536. if (Pos(findStr[c], q) > 0) then
  3537. Insert('\', findStr, c);
  3538. for t := 0 to h do
  3539. findStr := Replace(findStr, regexTag, regexStr, [rfReplaceAll]);
  3540. re := TRegExp.Create;
  3541. re.ModifierI := (rm_I in modifiers);
  3542. re.ModifierG := (rm_G in modifiers);
  3543. re.ModifierM := (rm_M in modifiers);
  3544. re.ModifierS := (rm_S in modifiers);
  3545. re.ModifierX := (rm_X in modifiers);
  3546. re.ModifierR := (rm_R in modifiers);
  3547. re.Expression := findStr;
  3548. re.InputString := data;
  3549. p := 1;
  3550. if re.ExecPos(p) then
  3551. repeat
  3552. if (re.Match[0] <> '') then
  3553. begin
  3554. p := (re.MatchPos[0] + 1);
  3555. Result[r].minimum := re.MatchPos[0];
  3556. Result[r].maximum := (Result[r].minimum + (re.MatchLen[0] - 1));
  3557. Inc(r);
  3558. end;
  3559. until not re.ExecPos(p);
  3560. SetLength(Result, r);
  3561. re.Free;
  3562. end else
  3563. SetLength(Result, 0);
  3564. end;
  3565.  
  3566. var
  3567. str: string;
  3568.  
  3569. begin
  3570. ClearDebug;
  3571. str := ' MMouse ( x , y , 1, 1 );' + #13#10 + // Detects.
  3572. 'mmouse(x, y, 1, 1);' + #13#10 + // Detects.
  3573. 'MMOUSE ( x, y, 1, 1);' + #13#10 + // Detects.
  3574. 'MMouse(x,y,1,1)' + #13#10 + // Detects.
  3575. 'MMouse(x, y, 2, 1)' + #13#10 + // Doesn't detect, because now there is a higher value, than 1, involved (2).
  3576. 'MMouse(x, y, 1 + Random(100), 1 + Random(100));' // Doesn't detect, for same reasons as above. :)
  3577. WriteLn(ToStr(TraceStrs('mmouse ( x , y , 1 , 1 )', ' ', '(\s*)', str, [rm_I])));
  3578. WriteLn(Copy(str, 3, 32));
  3579. WriteLn(Copy(str, 35, 1));
  3580. end.[/simba]
  3581. [/spoiler]
  3582. [spoiler="TraceStrPositions"]
  3583. [simba]type
  3584. TRegexModifier = (rm_G, rm_I, rm_M, rm_S, rm_X, rm_R);
  3585.  
  3586. {==============================================================================]
  3587. Explanation: Function for tracing findStr's from data.
  3588. Contains also custom fields for regexTag and regexStr;
  3589. tag performs a regex action, that is set to regexStr, during the search.
  3590. [==============================================================================}
  3591. function TraceStrPositions(findStr: string; regexTag: Char; regexStr, data: string; modifiers: set of TRegexModifier): TIntegerArray;
  3592. var
  3593. re: TRegExp;
  3594. p, l, r, s, c, h, t: Integer;
  3595. q: string;
  3596. begin
  3597. l := Length(data);
  3598. s := Length(findStr);
  3599. if ((l > 0) and (s > 0)) then
  3600. begin
  3601. SetLength(Result, l);
  3602. q := '.\+*?[^]$(){}=!<>|:-';
  3603. t := Pos(regexTag, q);
  3604. if (t > 0) then
  3605. Delete(q, t, 1);
  3606. for c := s downto 1 do
  3607. if (Pos(findStr[c], q) > 0) then
  3608. Insert('\', findStr, c);
  3609. for t := 0 to h do
  3610. findStr := Replace(findStr, regexTag, regexStr, [rfReplaceAll]);
  3611. re := TRegExp.Create;
  3612. re.ModifierI := (rm_I in modifiers);
  3613. re.ModifierG := (rm_G in modifiers);
  3614. re.ModifierM := (rm_M in modifiers);
  3615. re.ModifierS := (rm_S in modifiers);
  3616. re.ModifierX := (rm_X in modifiers);
  3617. re.ModifierR := (rm_R in modifiers);
  3618. re.Expression := findStr;
  3619. re.InputString := data;
  3620. p := 1;
  3621. if re.ExecPos(p) then
  3622. repeat
  3623. if (re.Match[0] <> '') then
  3624. begin
  3625. p := (re.MatchPos[0] + 1);
  3626. Result[r] := re.MatchPos[0];
  3627. Inc(r);
  3628. end;
  3629. until not re.ExecPos(p);
  3630. SetLength(Result, r);
  3631. re.Free;
  3632. end else
  3633. SetLength(Result, 0);
  3634. end;
  3635.  
  3636. var
  3637. str: string;
  3638.  
  3639. begin
  3640. ClearDebug;
  3641. str := ' MMouse ( x , y , 1, 1 );' + #13#10 + // Detects.
  3642. 'mmouse(x, y, 1, 1);' + #13#10 + // Detects.
  3643. 'MMOUSE ( x, y, 1, 1);' + #13#10 + // Detects.
  3644. 'MMouse(x,y,1,1)' + #13#10 + // Detects.
  3645. 'MMouse(x, y, 2, 1)' + #13#10 + // Doesn't detect, because now there is a higher value, than 1, involved (2).
  3646. 'MMouse(x, y, 1 + Random(100), 1 + Random(100));' // Doesn't detect, for same reasons as above. :)
  3647. WriteLn(ToStr(TraceStrPositions('mmouse ( x , y , 1 , 1 )', ' ', '(\s*)', str, [rm_I])));
  3648. end.[/simba]
  3649. [/spoiler]
  3650. [spoiler="TraceStrPositionsEx"]
  3651. [simba]type
  3652. TRegexModifier = (rm_G, rm_I, rm_M, rm_S, rm_X, rm_R);
  3653.  
  3654. {==============================================================================]
  3655. Explanation: Function for tracing findStr's from data.
  3656. Contains also custom fields for regexTags and regexStrs;
  3657. each tag performs a regex action, that is set to regexStrs, during the search.
  3658. [==============================================================================}
  3659. function TraceStrPositionsEx(findStr: string; regexTags: array of Char; regexStrs: TStringArray; data: string; modifiers: set of TRegexModifier): TIntegerArray;
  3660. var
  3661. re: TRegExp;
  3662. p, l, r, s, c, h, t: Integer;
  3663. q: string;
  3664. begin
  3665. l := Length(data);
  3666. s := Length(findStr);
  3667. if ((l > 0) and (s > 0)) then
  3668. begin
  3669. h := High(regexTags);
  3670. if (High(regexStrs) < h) then
  3671. SetLength(regexStrs, (h + 1));
  3672. SetLength(Result, l);
  3673. q := '.\+*?[^]$(){}=!<>|:-';
  3674. for c := h downto 0 do
  3675. begin
  3676. t := Pos(q, regexTags[c]);
  3677. if (t > 0) then
  3678. Delete(q, t, 1);
  3679. end;
  3680. for c := s downto 1 do
  3681. if (Pos(findStr[c], q) > 0) then
  3682. Insert('\', findStr, c);
  3683. for t := 0 to h do
  3684. findStr := Replace(findStr, regexTags[t], regexStrs[t], [rfReplaceAll]);
  3685. re := TRegExp.Create;
  3686. re.ModifierI := (rm_I in modifiers);
  3687. re.ModifierG := (rm_G in modifiers);
  3688. re.ModifierM := (rm_M in modifiers);
  3689. re.ModifierS := (rm_S in modifiers);
  3690. re.ModifierX := (rm_X in modifiers);
  3691. re.ModifierR := (rm_R in modifiers);
  3692. re.Expression := findStr;
  3693. re.InputString := data;
  3694. p := 1;
  3695. if re.ExecPos(p) then
  3696. repeat
  3697. if (re.Match[0] <> '') then
  3698. begin
  3699. p := (re.MatchPos[0] + 1);
  3700. Result[r] := re.MatchPos[0];
  3701. Inc(r);
  3702. end;
  3703. until not re.ExecPos(p);
  3704. SetLength(Result, r);
  3705. re.Free;
  3706. end else
  3707. SetLength(Result, 0);
  3708. end;
  3709.  
  3710. var
  3711. str: string;
  3712.  
  3713. begin
  3714. ClearDebug;
  3715. str := ' MMouse ( x , y , 1, 1 );' + #13#10 + // Detects.
  3716. 'mmouse(x, y, 1, 1);' + #13#10 + // Detects.
  3717. 'MMOUSE ( x, y, 1, 1);' + #13#10 + // Detects.
  3718. 'MMouse(x,y,1,1)' + #13#10 + // Detects.
  3719. 'MMouse(x, y, 2, 1)' + #13#10 + // Doesn't detect, because now there is a higher value, than 1, involved (2).
  3720. 'MMouse(x, y, 1 + Random(100), 1 + Random(100));' // Doesn't detect, for same reasons as above. :)
  3721. WriteLn(ToStr(TraceStrPositionsEx('mmouse ( x , y , 1 , 1 )', [' '], ['(\s*)'], str, [rm_I])));
  3722. end.[/simba]
  3723. [/spoiler]
  3724. [spoiler="AllBetween"]
  3725. [simba]function AllBetween(s1, s2, str: string): TStringArray;
  3726. var
  3727. s1L, s2L, sL, r, sp, start, fp, finish: Integer;
  3728. tmp: string;
  3729. begin
  3730. sL := Length(str);
  3731. s1L := Length(s1);
  3732. s2L := Length(s2);
  3733. if ((sL > 0) and (s1L > 0) and (s2L > 0) and (sL >= (s1L + s2L))) then
  3734. begin
  3735. SetLength(Result, (sL * (sL - (s1L + s2L))));
  3736. repeat
  3737. sp := PosEx(s1, str, (start + 1));
  3738. if (sp > 0) then
  3739. begin
  3740. start := sp;
  3741. finish := ((start + s1L) - 1);
  3742. repeat
  3743. fp := PosEx(s2, str, (finish + 1));
  3744. if (fp > 0) then
  3745. begin
  3746. finish := fp;
  3747. tmp := Copy(str, (start + s1L), (finish - (start + s1L)));
  3748. if (tmp <> '') then
  3749. begin
  3750. Result[r] := tmp;
  3751. Inc(r);
  3752. tmp := '';
  3753. end;
  3754. end;
  3755. until (fp <= 0);
  3756. end;
  3757. until (sp <= 0);
  3758. end;
  3759. SetLength(Result, r);
  3760. end;
  3761.  
  3762. var
  3763. str: string;
  3764. TSA: TStringArray;
  3765. h, i: Integer;
  3766.  
  3767. begin
  3768. ClearDebug;
  3769. str := '***AllBetween()**Test***';
  3770. TSA := AllBetween('*', '*', str);
  3771. h := High(TSA);
  3772. if (h < 0) then
  3773. Exit;
  3774. for i := 0 to h do
  3775. WriteLn('TSA[' + IntToStr(i) + ']: ' + TSA[i]);
  3776. SetLength(TSA, 0);
  3777. end.[/simba]
  3778. [/spoiler]
  3779. [spoiler="MultiBetween"]
  3780. [simba]function MultiBetween(str, s1, s2: string): TStringArray;
  3781. var
  3782. strL, s1L, s2L, o, n, e, r: Integer;
  3783. begin
  3784. s1L := Length(s1);
  3785. s2L := Length(s2);
  3786. strL := Length(str);
  3787. if ((s1 <> '') and (s2 <> '') and (strL > (s1L + s2L))) then
  3788. begin
  3789. SetLength(Result, (strL - (s1L + s2L)));
  3790. repeat
  3791. n := PosEx(s1, str, (n + 1));
  3792. if (n < 1) then
  3793. Break;
  3794. e := PosEx(s2, str, (n + 1));
  3795. if (e < 1) then
  3796. Break;
  3797. repeat
  3798. o := n;
  3799. n := PosEx(s1, str, (n + 1));
  3800. until ((n >= e) or (n < 1));
  3801. n := o;
  3802. Result[r] := Between(s1, s2, Copy(str, n, (s1L + (e + s2L))));
  3803. if (Result[r] <> '') then
  3804. Inc(r);
  3805. until ((e < 1) or (n < 1));
  3806. end;
  3807. SetLength(Result, r);
  3808. end;
  3809.  
  3810. var
  3811. h, i: Integer;
  3812. TSA: TStringArray;
  3813. Text: string;
  3814.  
  3815. begin
  3816. ClearDebug;
  3817. WriteLn('MultiBetween() Test1:');
  3818. Text := '<tag>test1<tag>..<tag>test2dgtsgtsgdsgs<tag>....<tag>test3<tag>.....<tag>test4<tag>.....';
  3819. TSA := MultiBetween(Text, '<tag>', '<tag>');
  3820. h := High(TSA);
  3821. for i := 0 to h do
  3822. WriteLn('TSA[' + IntToStr(i) + ']: ' + TSA[i]);
  3823. WriteLn('');
  3824. SetLength(TSA, 0);
  3825. WriteLn('MultiBetween() Test2:');
  3826. Text := '<tag>test1</tag>....<tag>test2dgtsgtsgdsgs</tag>....<tag>test3</tag>.....<tag>test4</tag>.....';
  3827. TSA := MultiBetween(Text, '<tag>', '</tag>');
  3828. h := High(TSA);
  3829. for i := 0 to h do
  3830. WriteLn('TSA[' + IntToStr(i) + ']: ' + TSA[i]);
  3831. WriteLn('');
  3832. SetLength(TSA, 0);
  3833. WriteLn('MultiBetween() Test3:');
  3834. Text := '||*|*||<|<||[|]||>|>||*|*||';
  3835. TSA := MultiBetween(Text, '|', '|');
  3836. h := High(TSA);
  3837. for i := 0 to h do
  3838. WriteLn('TSA[' + IntToStr(i) + ']: ' + TSA[i]);
  3839. SetLength(TSA, 0);
  3840. end.[/simba]
  3841. [/spoiler]
  3842. [spoiler="MultiBetweenEx"]
  3843. [simba]function MultiBetweenEx(str, s1, s2: string; method: Integer): TStringArray;
  3844. var
  3845. s1L, s2L, strL, s, o, n, e, r: Integer;
  3846. begin
  3847. strL := Length(str);
  3848. s1L := Length(s1);
  3849. if ((strL > Length(s1 + s2)) and (s1L >= 1) and (Length(s2) >= 1) and InRange(method, 0, 3)) then
  3850. begin
  3851. SetLength(Result, (strL - (s1L + s2L)));
  3852. case method of
  3853. 0:
  3854. repeat
  3855. n := PosEx(s1, str, (n + 1));
  3856. if (n < 1) then
  3857. Break;
  3858. e := PosEx(s2, str, (n + 1));
  3859. if (e < 1) then
  3860. Break;
  3861. repeat
  3862. o := n;
  3863. n := PosEx(s1, str, (n + 1));
  3864. until ((n >= e) or (n < 1));
  3865. n := o;
  3866. Result[r] := Between(s1, s2, Copy(str, n, (s1L + (e + s2L))));
  3867. if (Result[r] <> '') then
  3868. Inc(r);
  3869. until ((e < 1) or (n < 1));
  3870. 1..3:
  3871. repeat
  3872. case method of
  3873. 1, 2: s := PosEx(s1, str, (e + 1));
  3874. 3: s := PosEx(s1, str, (s + 1));
  3875. end;
  3876. e := PosEx(s2, str, (s + 1));
  3877. if ((s < 1) or (e < 1)) then
  3878. Break;
  3879. Result[r] := Copy(str, (s + s1L), (e - (s + s1L)));
  3880. if (Result[r] <> '') then
  3881. Inc(r)
  3882. else
  3883. if (method = 1) then
  3884. e := ((s + s1L) - 1);
  3885. until ((s < 1) or (e < 1));
  3886. end;
  3887. end;
  3888. SetLength(Result, r);
  3889. end;
  3890.  
  3891. var
  3892. m, h, i: Integer;
  3893. TSA: TStringArray;
  3894. Text: string;
  3895.  
  3896. begin
  3897. ClearDebug;
  3898. for m := 0 to 3 do
  3899. begin
  3900. WriteLn('*** METHOD ' + IntToStr(m) + ' ***');
  3901. WriteLn('MultiBetweenEx() Test1:');
  3902. Text := '<tag>test1<tag>..<tag>test2dgtsgtsgdsgs<tag>....<tag>test3<tag>.....<tag>test4<tag>.....';
  3903. TSA := MultiBetweenEx(Text, '<tag>', '<tag>', m);
  3904. h := High(TSA);
  3905. for i := 0 to h do
  3906. WriteLn('TSA[' + IntToStr(i) + ']: ' + TSA[i]);
  3907. WriteLn('');
  3908. SetLength(TSA, 0);
  3909. WriteLn('MultiBetweenEx() Test2:');
  3910. Text := '<tag>test1</tag>....<tag>test2dgtsgtsgdsgs</tag>....<tag>test3</tag>.....<tag>test4</tag>.....';
  3911. TSA := MultiBetweenEx(Text, '<tag>', '</tag>', m);
  3912. h := High(TSA);
  3913. for i := 0 to h do
  3914. WriteLn('TSA[' + IntToStr(i) + ']: ' + TSA[i]);
  3915. WriteLn('');
  3916. SetLength(TSA, 0);
  3917. WriteLn('MultiBetweenEx() Test3:');
  3918. Text := '||*|*||<|<||[|]||>|>||*|*||';
  3919. TSA := MultiBetweenEx(Text, '|', '|', m);
  3920. h := High(TSA);
  3921. for i := 0 to h do
  3922. WriteLn('TSA[' + IntToStr(i) + ']: ' + TSA[i]);
  3923. SetLength(TSA, 0);
  3924. WriteLn('*** METHOD ' + IntToStr(m) + ' ***');
  3925. if (m < 4) then
  3926. WriteLn('');
  3927. end;
  3928. end.[/simba]
  3929. [/spoiler]
  3930. [spoiler="GetWords"]
  3931. [simba]const // TEST_TEXT by slacky/warpie! ;)
  3932. TEST_TEXT = 'Ost World1 Amf#World2,but hello there.Are we friends?';
  3933.  
  3934. {==============================================================================]
  3935. Explanation: Returns the words from text as TStringArray.
  3936. [==============================================================================}
  3937. function GetWords(text: string): TStringArray;
  3938. var
  3939. l, i, r: Integer;
  3940. w: string;
  3941. begin
  3942. l := Length(text);
  3943. if (l > 0) then
  3944. begin
  3945. w := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_';
  3946. SetLength(Result, l);
  3947. for i := 1 to l do
  3948. if (Pos(text[i], w) > 0) then
  3949. begin
  3950. Result[r] := text[i];
  3951. for i := (i + 1) to l do
  3952. if (Pos(text[i], w) > 0) then
  3953. Result[r] := (Result[r] + text[i])
  3954. else
  3955. Break;
  3956. Inc(r);
  3957. end;
  3958. end;
  3959. SetLength(Result, r);
  3960. end;
  3961.  
  3962. begin
  3963. ClearDebug;
  3964. WriteLn('GetWords(TEST_TEXT): ' + ToStr(GetWords(TEST_TEXT)));
  3965. end.[/simba]
  3966. [/spoiler]
  3967. [spoiler="GetWordsEx"]
  3968. [simba]const // TEST_TEXT by slacky/warpie! ;)
  3969. TEST_TEXT = 'Ost World1 Amf#World2,but hello there.Are we friends?';
  3970. CHARSET = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_';
  3971.  
  3972. {==============================================================================]
  3973. Explanation: Returns the words from text as TStringArray.
  3974. Supports custom character set (wordCharacters)
  3975. [==============================================================================}
  3976. function GetWordsEx(text, wordCharacters: string): TStringArray;
  3977. var
  3978. l, i, r: Integer;
  3979. begin
  3980. l := Length(text);
  3981. if ((l > 0) and (wordCharacters <> '')) then
  3982. begin
  3983. SetLength(Result, l);
  3984. for i := 1 to l do
  3985. if (Pos(text[i], wordCharacters) > 0) then
  3986. begin
  3987. Result[r] := text[i];
  3988. for i := (i + 1) to l do
  3989. if (Pos(text[i], wordCharacters) > 0) then
  3990. Result[r] := (Result[r] + text[i])
  3991. else
  3992. Break;
  3993. Inc(r);
  3994. end;
  3995. end;
  3996. SetLength(Result, r);
  3997. end;
  3998.  
  3999. begin
  4000. ClearDebug;
  4001. WriteLn('GetWordsEx(TEST_TEXT, CHARSET): ' + ToStr(GetWordsEx(TEST_TEXT, CHARSET)));
  4002. end.[/simba]
  4003. [/spoiler]
  4004. [spoiler="CountWords"]
  4005. [simba]const // TEST_TEXT by slacky/warpie! ;)
  4006. TEST_TEXT = 'Ost World1 Amf#World2,but hello there.Are we friends?';
  4007.  
  4008. {==============================================================================]
  4009. Explanation: Returns count of words in text.
  4010. [==============================================================================}
  4011. function CountWords(text: string): Integer;
  4012. var
  4013. l, i: Integer;
  4014. w: string;
  4015. begin
  4016. Result := 0;
  4017. l := Length(text);
  4018. if (l > 0) then
  4019. begin
  4020. w := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_';
  4021. for i := 1 to l do
  4022. if (Pos(text[i], w) > 0) then
  4023. begin
  4024. Inc(Result);
  4025. for i := (i + 1) to l do
  4026. if (Pos(text[i], w) < 1) then
  4027. Break;
  4028. end;
  4029. end;
  4030. end;
  4031.  
  4032. begin
  4033. ClearDebug;
  4034. WriteLn('CountWords(TEST_TEXT): ' + ToStr(CountWords(TEST_TEXT)));
  4035. end.[/simba]
  4036. [/spoiler]
  4037. [spoiler="CountWordsEx"]
  4038. [simba]const // TEST_TEXT by slacky/warpie! ;)
  4039. TEST_TEXT = 'Ost World1 Amf#World2,but hello there.Are we friends?';
  4040. CHARSET = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_';
  4041.  
  4042. {==============================================================================]
  4043. Explanation: Returns count of words in text.
  4044. Supports custom character set (wordCharacters)
  4045. [==============================================================================}
  4046. function CountWordsEx(text, wordCharacters: string): Integer;
  4047. var
  4048. l, i: Integer;
  4049. begin
  4050. Result := 0;
  4051. l := Length(text);
  4052. if ((l > 0) and (wordCharacters <> '')) then
  4053. for i := 1 to l do
  4054. if (Pos(text[i], wordCharacters) > 0) then
  4055. begin
  4056. Inc(Result);
  4057. for i := (i + 1) to l do
  4058. if (Pos(text[i], wordCharacters) < 1) then
  4059. Break;
  4060. end;
  4061. end;
  4062.  
  4063. begin
  4064. ClearDebug;
  4065. WriteLn('CountWordsEx(TEST_TEXT, CHARSET): ' + ToStr(CountWordsEx(TEST_TEXT, CHARSET)));
  4066. end.[/simba]
  4067. [/spoiler]
  4068. [spoiler="TSAFill"]
  4069. [simba]{==============================================================================]
  4070. Explanation: Fills TSA items with x.
  4071. [==============================================================================}
  4072. procedure TSAFill(var TSA: TStringArray; x: string);
  4073. var
  4074. i, h: Integer;
  4075. begin
  4076. h := High(TSA);
  4077. for i := 0 to h do
  4078. TSA[i] := string(x);
  4079. end;
  4080.  
  4081. var
  4082. s: string;
  4083. h, i: Integer;
  4084. a: TStringArray;
  4085.  
  4086. begin
  4087. ClearDebug;
  4088. a := ['Test0', 'Test1', 'Test2', 'Test3', 'Test4'];
  4089. TSAFill(a, 'TEST');
  4090. h := High(a);
  4091. for i := 0 to h do
  4092. s := (s + '"' + a[i] + '" ');
  4093. WriteLn('a: ' + s);
  4094. end.[/simba]
  4095. [/spoiler]
  4096. [spoiler="TSAFillEx"]
  4097. [simba]{==============================================================================]
  4098. Explanation: Fills TSA items with x.
  4099. [==============================================================================}
  4100. procedure TSAFillEx(var TSA: TStringArray; x: TStringArray);
  4101. var
  4102. i, h, l: Integer;
  4103. begin
  4104. h := High(TSA);
  4105. l := Length(x);
  4106. for i := 0 to h do
  4107. TSA[i] := string(x[i mod l]);
  4108. end;
  4109.  
  4110. var
  4111. s: string;
  4112. h, i: Integer;
  4113. a: TStringArray;
  4114.  
  4115. begin
  4116. ClearDebug;
  4117. a := ['Test0', 'Test1', 'Test2', 'Test3', 'Test4', 'Test6', 'Test7', 'Test8', 'Test9'];
  4118. TSAFillEx(a, ['Test1', 'Test2', 'Test3']);
  4119. h := High(a);
  4120. for i := 0 to h do
  4121. s := (s + '"' + a[i] + '" ');
  4122. WriteLn('a: ' + s);
  4123. end.[/simba]
  4124. [/spoiler]
  4125. [spoiler="TSAOfString"]
  4126. [simba]{==============================================================================]
  4127. Explanation: Returns TSA of x, count being the size of the result.
  4128. [==============================================================================}
  4129. function TSAOfString(x: string; count: Integer): TStringArray;
  4130. var
  4131. i: Integer;
  4132. begin
  4133. if (count > 0) then
  4134. begin
  4135. SetLength(Result, count);
  4136. for i := 0 to (count - 1) do
  4137. Result[i] := string(x);
  4138. end else
  4139. SetLength(Result, 0);
  4140. end;
  4141.  
  4142. begin
  4143. ClearDebug;
  4144. WriteLn(ToStr(TSAOfString('Test', 4)));
  4145. end.[/simba]
  4146. [/spoiler]
  4147. [spoiler="TSAOfStringEx"]
  4148. [simba]{==============================================================================]
  4149. Explanation: Returns TSA with x items, count being the size of the result.
  4150. [==============================================================================}
  4151. function TSAOfStringEx(x: TStringArray; count: Integer): TStringArray;
  4152. var
  4153. i, l: Integer;
  4154. begin
  4155. l := Length(x);
  4156. if ((count > 0) and (l > 0)) then
  4157. begin
  4158. SetLength(Result, count);
  4159. for i := 0 to (count - 1) do
  4160. Result[i] := string(x[i mod l]);
  4161. end else
  4162. SetLength(Result, 0);
  4163. end;
  4164.  
  4165. begin
  4166. ClearDebug;
  4167. WriteLn(ToStr(TSAOfStringEx(['a', 'b', 'c'], 8)));
  4168. end.[/simba]
  4169. [/spoiler]
  4170. [spoiler="TSAClone"]
  4171. [simba]{==============================================================================]
  4172. Explanation: Returns copy ("clone") of TSA safely
  4173. [==============================================================================}
  4174. function TSAClone(TSA: TStringArray): TStringArray;
  4175. var
  4176. i, l: Integer;
  4177. begin
  4178. l := Length(TSA);
  4179. SetLength(Result, l);
  4180. for i := 0 to (l - 1) do
  4181. Result[i] := string(TSA[i]);
  4182. end;
  4183.  
  4184. var
  4185. tmp: TStringArray;
  4186. i: Integer;
  4187.  
  4188. begin
  4189. tmp := TSAClone(['Test1', 'Test2', 'Test3', 'Test4']);
  4190. WriteLn(ToStr(tmp));
  4191. SetLength(tmp, 0);
  4192. end.[/simba]
  4193. [/spoiler]
  4194. [spoiler="TSACopy"]
  4195. [simba]function TSACopy(TSA: TStringArray; startIndex, count: Integer): TStringArray;
  4196. var
  4197. i, l, t: Integer;
  4198. begin
  4199. l := Length(TSA);
  4200. if (startIndex < 0) then
  4201. startIndex := 0;
  4202. if ((l >= startIndex) and (count > 0)) then
  4203. begin
  4204. t := (l - startIndex);
  4205. if (count > t) then
  4206. count := t;
  4207. SetLength(Result, count);
  4208. for i := startIndex to ((startIndex + count) - 1) do
  4209. Result[(i - startIndex)] := string(TSA[i]);
  4210. end else
  4211. SetLength(Result, 0);
  4212. end;
  4213.  
  4214. var
  4215. TSA: TStringArray;
  4216. i: Integer;
  4217.  
  4218. begin
  4219. ClearDebug;
  4220. TSA := TSACopy(['TEST1', 'TEST2', 'TEST3', 'TEST4', 'TEST5', 'TEST6', 'TEST7'], 2, 3);
  4221. WriteLn(ToStr(TSA));
  4222. SetLength(TSA, 0);
  4223. end.[/simba]
  4224. [/spoiler]
  4225. [spoiler="TSACopyEx"]
  4226. [simba]{==============================================================================]
  4227. Explanation: Copies TSA from pos1 to pos2. Reverse copies with pos1>pos2 (flexible!).
  4228. [==============================================================================}
  4229. function TSACopyEx(TSA: TStringArray; pos1, pos2: Integer): TStringArray;
  4230. var
  4231. i, l: Integer;
  4232. begin
  4233. l := Length(TSA);
  4234. if (l > 0) then
  4235. begin
  4236. if (pos1 < 0) then
  4237. pos1 := 0;
  4238. if (pos1 > (l - 1)) then
  4239. pos1 := (l - 1);
  4240. if (pos2 < 0) then
  4241. pos2 := 0;
  4242. if (pos2 > (l - 1)) then
  4243. pos2 := (l - 1);
  4244. if (pos1 <> pos2) then
  4245. begin
  4246. {$IFNDEF Lape}
  4247. SetLength(Result, (IAbs(pos1 - pos2) + 1));
  4248. {$ELSE}
  4249. SetLength(Result, (Abs(pos1 - pos2) + 1));
  4250. {$ENDIF}
  4251. if (pos1 < pos2) then
  4252. begin
  4253. for i := pos1 to pos2 do
  4254. Result[(i - pos1)] := string(TSA[i]);
  4255. end else
  4256. for i := pos1 downto pos2 do
  4257. Result[(pos1 - i)] := string(TSA[i]);
  4258. end else
  4259. Result := [string(TSA[pos1])];
  4260. end else
  4261. SetLength(Result, 0);
  4262. end;
  4263.  
  4264. var
  4265. i: Integer;
  4266.  
  4267. begin
  4268. for i := 0 to 5 do
  4269. WriteLn(ToStr(TSACopyEx(['A', 'B', 'C', 'D', 'E', 'F'], i, 5)));
  4270. for i := 5 downto 0 do
  4271. WriteLn(ToStr(TSACopyEx(['A', 'B', 'C', 'D', 'E', 'F'], 5, i)));
  4272. end.[/simba]
  4273. [/spoiler]
  4274. [spoiler="TSAGet"]
  4275. [simba]{==============================================================================]
  4276. Explanation: Returns array of items from TSA by IDs. Ignores invalid ID's.
  4277. [==============================================================================}
  4278. function TSAGet(TSA: TStringArray; IDs: TIntegerArray): TStringArray;
  4279. var
  4280. i, h, h2, r: Integer;
  4281. begin
  4282. h := High(TSA);
  4283. h2 := High(IDs);
  4284. if ((h2 > -1) and (h > -1)) then
  4285. begin
  4286. SetLength(Result, (h2 + 1));
  4287. for i := 0 to h2 do
  4288. if ((IDs[i] <= h) and (IDs[i] > -1)) then
  4289. begin
  4290. Result[r] := string(TSA[IDs[i]]);
  4291. Inc(r);
  4292. end;
  4293. end;
  4294. SetLength(Result, r);
  4295. end;
  4296.  
  4297. var
  4298. tmp: TStringArray;
  4299. h, i: Integer;
  4300.  
  4301. begin
  4302. ClearDebug;
  4303. tmp := TSAGet(['Test0', 'Test1', 'Test2', 'Test3', 'Test4', 'Test5', 'Test6', 'Test7', 'Test8', 'Test9'], [100000, 1, 2, -1, 3, 4, 999]);
  4304. h := High(tmp);
  4305. for i := 0 to h do
  4306. WriteLn(tmp[i]);
  4307. end.[/simba]
  4308. [/spoiler]
  4309. [spoiler="TSAAdd"]
  4310. [simba]{==============================================================================]
  4311. Explanation: Adds all addTSA items to TSA. Returns the highest index in the end.
  4312. [==============================================================================}
  4313. function TSAAdd(var TSA: TStringArray; addTSA: TStringArray): Integer;
  4314. var
  4315. h, l, i: Integer;
  4316. begin
  4317. h := High(addTSA);
  4318. if (h > -1) then
  4319. begin
  4320. l := Length(TSA);
  4321. SetLength(TSA, (l + (h + 1)));
  4322. for i := 0 to h do
  4323. TSA[(i + l)] := string(addTSA[i]);
  4324. end;
  4325. Result := High(TSA);
  4326. end;
  4327.  
  4328. var
  4329. TSA: TStringArray;
  4330.  
  4331. begin
  4332. ClearDebug;
  4333. TSAAdd(TSA, ['Test1', 'Test2', 'Test3']);
  4334. WriteLn('TSA: ' + ToStr(TSA));
  4335. TSAAdd(TSA, ['Test4', 'Test5', 'Test6', 'Test7']);
  4336. WriteLn('TSA: ' + ToStr(TSA));
  4337. TSAAdd(TSA, ['Test8', 'Test9']);
  4338. WriteLn('TSA: ' + ToStr(TSA));
  4339. end.[/simba]
  4340. [/spoiler]
  4341. [spoiler="TSAReverse"]
  4342. [simba]procedure TSAReverse(var TSA: TStringArray);
  4343. var
  4344. g, h, i: Integer;
  4345. begin
  4346. h := High(TSA);
  4347. if (h < 1) then
  4348. Exit;
  4349. g := (h div 2);
  4350. for i := 0 to g do
  4351. Swap(TSA[i], TSA[(h - i)]);
  4352. end;
  4353.  
  4354. var
  4355. TSA: TStringArray;
  4356.  
  4357. begin
  4358. ClearDebug;
  4359. TSA := ['Test10', 'Test9', 'Test8', 'Test7', 'Test6', 'Test5', 'Test4', 'Test3', 'Test2', 'Test1'];
  4360. TSAReverse(TSA);
  4361. WriteLn(TSA);
  4362. SetLength(TSA, 0);
  4363. end.[/simba]
  4364. [/spoiler]
  4365. [spoiler="TSACombine"]
  4366. [simba]function TSACombine(TSA1, TSA2: TStringArray): TStringArray;
  4367. var
  4368. l1, l2, i: Integer;
  4369. begin
  4370. l1 := Length(TSA1);
  4371. l2 := Length(TSA2);
  4372. SetLength(Result, (l1 + l2));
  4373. for i := 0 to (l1 - 1) do
  4374. Result[i] := string(TSA1[i]);
  4375. for i := 0 to (l2 - 1) do
  4376. Result[(l1 + i)] := string(TSA2[i]);
  4377. end;
  4378.  
  4379. begin
  4380. WriteLn(ToStr(TSACombine(['one', 'two'], ['three'])));
  4381. end.[/simba]
  4382. [/spoiler]
  4383. [spoiler="TSAConcat"]
  4384. [simba]function TSAConcat(TSA: TStringArray): string;
  4385. var
  4386. h, i: Integer;
  4387. begin
  4388. Result := '';
  4389. h := High(TSA);
  4390. for i := 0 to h do
  4391. Result := (Result + string(TSA[i]));
  4392. end;
  4393.  
  4394. var
  4395. TSA: TStringArray;
  4396.  
  4397. begin
  4398. TSA := ['Test1', ', ', 'Test2', ', ', 'Test3', '!'];
  4399. ClearDebug;
  4400. WriteLn(TSAConcat(TSA));
  4401. SetLength(TSA, 0);
  4402. end.[/simba]
  4403. [/spoiler]
  4404. [spoiler="TSAConcatEx"]
  4405. [simba]{==============================================================================]
  4406. Explanation: Returns string of all TSA items binded together. Places glue between the indexes.
  4407. [==============================================================================}
  4408. function TSAConcatEx(TSA: TStringArray; glue: string): string;
  4409. var
  4410. h, i: Integer;
  4411. begin
  4412. Result := '';
  4413. h := High(TSA);
  4414. if (h > -1) then
  4415. begin
  4416. for i := 0 to (h - 1) do
  4417. Result := (Result + string(TSA[i]) + string(glue));
  4418. Result := (Result + string(TSA[i]));
  4419. end;
  4420. end;
  4421.  
  4422. begin
  4423. ClearDebug;
  4424. WriteLn(TSAConcatEx(['This', 'is', 'a', 'test!'], ' '));
  4425. end.[/simba]
  4426. [/spoiler]
  4427. [spoiler="TSATrimEx"]
  4428. [simba]{==============================================================================]
  4429. Explanation: Trims all TSA items.
  4430. If delEmpty is set as true, procedure will delete all empty items.
  4431. [==============================================================================}
  4432. procedure TSATrimEx(var TSA: TStringArray; delEmpty: Boolean);
  4433. var
  4434. l, i, r: Integer;
  4435. tmp: TStringArray;
  4436. begin
  4437. l := Length(TSA);
  4438. if (l > 0) then
  4439. if delEmpty then
  4440. begin
  4441. SetLength(tmp, l);
  4442. for i := 0 to (l - 1) do
  4443. if (TSA[i] <> '') then
  4444. begin
  4445. tmp[r] := Trim(TSA[i]);
  4446. if (tmp[r] <> '') then
  4447. Inc(r);
  4448. end;
  4449. SetLength(tmp, r);
  4450. SetLength(TSA, r);
  4451. for i := 0 to (r - 1) do
  4452. TSA[i] := string(tmp[i]);
  4453. SetLength(tmp, 0);
  4454. end else
  4455. for i := 0 to (l - 1) do
  4456. TSA[i] := Trim(TSA[i]);
  4457. end;
  4458.  
  4459. var
  4460. TSA: TStringArray;
  4461.  
  4462. begin
  4463. ClearDebug;
  4464. TSA := Explode(',', ' This , is , a , test ,, ! ');
  4465. TSATrimEx(TSA, False);
  4466. WriteLn(ToStr(TSA));
  4467. TSA := Explode(',', ' This , is , a , test ,, ! ');
  4468. TSATrimEx(TSA, True);
  4469. WriteLn(ToStr(TSA));
  4470. TSA := Explode(',', ' This , is , a , test ');
  4471. WriteLn(ToStr(TSA));
  4472. SetLength(TSA, 0);
  4473. end.[/simba]
  4474. [/spoiler]
  4475. [spoiler="TSATrim"]
  4476. [simba]{==============================================================================]
  4477. Explanation: Trims all TSA items.
  4478. [==============================================================================}
  4479. procedure TSATrim(var TSA: TStringArray);
  4480. var
  4481. h, i: Integer;
  4482. begin
  4483. h := High(TSA);
  4484. for i := 0 to h do
  4485. TSA[i] := Trim(TSA[i]);
  4486. end;
  4487.  
  4488. var
  4489. TSA: TStringArray;
  4490.  
  4491. begin
  4492. ClearDebug;
  4493. TSA := Explode(',', ' This , is , a , test ');
  4494. TSATrim(TSA);
  4495. WriteLn(ToStr(TSA));
  4496. TSA := Explode(',', ' This , is , a , test ');
  4497. WriteLn(ToStr(TSA));
  4498. SetLength(TSA, 0);
  4499. end.[/simba]
  4500. [/spoiler]
  4501. [spoiler="TSAContains"]
  4502. [simba]function TSAContains(TSA: TStringArray; x: string): Boolean;
  4503. var
  4504. i, h: Integer;
  4505. begin
  4506. h := High(TSA);
  4507. for i := 0 to h do
  4508. begin
  4509. Result := (TSA[i] = x);
  4510. if Result then
  4511. Exit;
  4512. end;
  4513. Result := False;
  4514. end;
  4515.  
  4516. var
  4517. i: Integer;
  4518. s: string;
  4519. TSA: TStringArray;
  4520.  
  4521. begin
  4522. ClearDebug;
  4523. TSA := ['Test0', 'Test1', 'Test2', 'Test3', 'Test4',
  4524. 'Test5', 'Test6', 'Test7', 'Test8', 'Test9'];
  4525. for i := -1 to 10 do
  4526. begin
  4527. s := 'Test' + IntToStr(i);
  4528. if TSAContains(TSA, s) then
  4529. WriteLn('TSA contains "' + s + '"!')
  4530. else
  4531. WriteLn('TSA doesn''t contain "' + s + '".');
  4532. end;
  4533. SetLength(TSA, 0);
  4534. end.[/simba]
  4535. [/spoiler]
  4536. [spoiler="TSAContainsEx"]
  4537. [simba]{==============================================================================]
  4538. Explanation: Returns true if TSA contains ANY string from strs.
  4539. CASE-SENSITIVE.
  4540. [==============================================================================}
  4541. function TSAContainsEx(TSA, strs: TStringArray): Boolean;
  4542. var
  4543. a, b, x, y: Integer;
  4544. begin
  4545. b := High(TSA);
  4546. y := High(strs);
  4547. Result := True;
  4548. if ((b > -1) and (y > -1)) then
  4549. for a := 0 to b do
  4550. for x := 0 to y do
  4551. if (TSA[a] = strs[x]) then
  4552. Exit;
  4553. Result := False;
  4554. end;
  4555.  
  4556. begin
  4557. ClearDebug;
  4558. if TSAContainsEx(['Lets', 'test', 'TSAContainsEx()', 'function', '!'], ['TSAContainsEx()', '!']) then
  4559. WriteLn('YEP!');
  4560. end.[/simba]
  4561. [/spoiler]
  4562. [spoiler="TSAContainsTSA"]
  4563. [simba]{==============================================================================]
  4564. Explanation: Returns true if TSA contains WHOLE chain of strings (arr) in it.
  4565. CASE-SENSITIVE.
  4566. [==============================================================================}
  4567. function TSAContainsTSA(TSA, arr: TStringArray): Boolean;
  4568. var
  4569. a, b, x, y, z: Integer;
  4570. begin
  4571. z := High(TSA);
  4572. y := High(arr);
  4573. if ((z >= y) and (z > -1)) then
  4574. begin
  4575. b := (z - y);
  4576. for a := 0 to b do
  4577. begin
  4578. for x := 0 to y do
  4579. if (TSA[(a + x)] <> arr[x]) then
  4580. Break;
  4581. if (x > y) then
  4582. Break;
  4583. end;
  4584. Result := (a <= b);
  4585. end else
  4586. Result := False;
  4587. end;
  4588.  
  4589. begin
  4590. ClearDebug;
  4591. if TSAContainsTSA(['Lets', 'test', 'TSAContainsEx()', 'function', '!'], ['TSAContainsEx()', '!']) then
  4592. WriteLn('NOOOO!');
  4593. if TSAContainsTSA(['Lets', 'test', 'TSAContainsEx()', 'function', '!'], ['TSAContainsEx()', 'function', '!']) then
  4594. WriteLn('YEEAH!');
  4595. end.[/simba]
  4596. [/spoiler]
  4597. [spoiler="TSADelete"]
  4598. [simba]procedure TSADelete(var TSA: TStringArray; x: Integer);
  4599. var
  4600. i, h: Integer;
  4601. begin
  4602. h := High(TSA);
  4603. if ((x > h) or (x < 0)) then
  4604. Exit;
  4605. for i := x to (h - 1) do
  4606. TSA[i] := TSA[(i + 1)];
  4607. SetLength(TSA, h);
  4608. end;
  4609.  
  4610. var
  4611. TSA: TStringArray;
  4612.  
  4613. begin
  4614. ClearDebug;
  4615. TSA := ['ID0', 'ID1', 'ID5', 'ID2', 'ID3', 'ID8', 'ID4'];
  4616. TSADelete(TSA, 5);
  4617. TSADelete(TSA, 2);
  4618. WriteLn(ToStr(TSA));
  4619. end.[/simba]
  4620. [/spoiler]
  4621. [spoiler="TSARemove"]
  4622. [simba]procedure TSARemove(var TSA: TStringArray; x: TIntegerArray);
  4623. var
  4624. i, i2, h, h2: Integer;
  4625. begin
  4626. h := High(TSA);
  4627. h2 := High(x);
  4628. if ((h < 0) or (h2 < 0)) then
  4629. Exit;
  4630. for i2 := 0 to h2 do
  4631. if ((x[i2] <= h) and (x[i2] > -1)) then
  4632. begin
  4633. for i := x[i2] to (h - 1) do
  4634. TSA[i] := TSA[(i + 1)];
  4635. Dec(h);
  4636. end;
  4637. SetLength(TSA, (h + 1));
  4638. end;
  4639.  
  4640. var
  4641. TSA: TStringArray;
  4642.  
  4643. begin
  4644. ClearDebug;
  4645. TSA := ['ID0', 'ID1', 'ID5', 'ID2', 'ID3', 'ID8', 'ID4', 'ID5', 'ID999', 'ID6'];
  4646. TSARemove(TSA, [8, 5, 2]);
  4647. WriteLn(ToStr(TSA));
  4648. SetLength(TSA, 0);
  4649. end.[/simba]
  4650. [/spoiler]
  4651. [spoiler="TSAAppend"]
  4652. [simba]procedure TSAAppend(var TSA: TStringArray; x: string);
  4653. var
  4654. aL: Integer;
  4655. begin
  4656. aL := (Length(TSA) + 1);
  4657. SetLength(TSA, aL);
  4658. TSA[(aL - 1)] := string(x);
  4659. end;
  4660.  
  4661. var
  4662. TSA: TStringArray;
  4663.  
  4664. begin
  4665. ClearDebug;
  4666. TSA := ['ID0', 'ID1', 'ID2', 'ID3', 'ID4'];
  4667. TSAAppend(TSA, 'ID5');
  4668. WriteLn(ToStr(TSA));
  4669. end.[/simba]
  4670. [/spoiler]
  4671. [spoiler="TSAInsert"]
  4672. [simba]procedure TSAInsert(var TSA: TStringArray; index: Integer; str: string);
  4673. var
  4674. i, l: Integer;
  4675. begin
  4676. l := Length(TSA);
  4677. SetLength(TSA, (l + 1));
  4678. if (index < 0) then
  4679. index := 0;
  4680. if (index > l) then
  4681. index := l;
  4682. if (l > index) then
  4683. for i := (l - 1) downto index do
  4684. TSA[(i + 1)] := string(TSA[i]);
  4685. TSA[index] := string(str);
  4686. end;
  4687.  
  4688. var
  4689. i: Integer;
  4690. TSA: TStringArray;
  4691.  
  4692. begin
  4693. ClearDebug;
  4694. for i := 0 to 10 do
  4695. TSAInsert(TSA, Random(10 + 1), 'i = ' + IntToStr(i));
  4696. WriteLn(ToStr(TSA));
  4697. SetLength(TSA, 0);
  4698. end.[/simba]
  4699. [/spoiler]
  4700. [spoiler="TSAPlant"]
  4701. [simba]{==============================================================================]
  4702. Explanation: Plants/places strs to index position in TSA. Like TSAInsert(), with an exception that this inserts array of strings.
  4703. [==============================================================================}
  4704. function TSAPlant(var TSA: TStringArray; index: Integer; strs: TStringArray): Integer;
  4705. var
  4706. i, l, h: Integer;
  4707. begin
  4708. h := High(strs);
  4709. if (h > -1) then
  4710. begin
  4711. l := Length(TSA);
  4712. SetLength(TSA, (l + (h + 1)));
  4713. if (index < 0) then
  4714. index := 0;
  4715. if (index > l) then
  4716. index := l;
  4717. for i := (l + (h + 1) - 1) downto (index + (h + 1)) do
  4718. TSA[i] := string(TSA[(i - (h + 1))]);
  4719. for i := 0 to h do
  4720. TSA[(i + index)] := string(strs[i]);
  4721. end;
  4722. Result := High(TSA);
  4723. end;
  4724.  
  4725. var
  4726. str: string;
  4727. TSA: TStringArray;
  4728. h, i: Integer;
  4729.  
  4730. begin
  4731. ClearDebug;
  4732. TSA := ['1', '2', '7'];
  4733. TSAPlant(TSA, 2, ['3', '4', '5', '6']);
  4734. TSAPlant(TSA, 7, ['8', '9']);
  4735. TSAPlant(TSA, 0, ['0']);
  4736. h := High(TSA);
  4737. for i := 0 to h do
  4738. str := (str + TSA[i]);
  4739. SetLength(TSA, 0);
  4740. WriteLn(str);
  4741. end.[/simba]
  4742. [/spoiler]
  4743. [spoiler="TSAMove"]
  4744. [simba]{==============================================================================]
  4745. Explanation: Moves oldIndex to newIndex in TSA. Returns true, if movement was succesfully done!
  4746. [==============================================================================}
  4747. function TSAMove(var TSA: TStringArray; oldIndex, newIndex: Integer): Boolean;
  4748. var
  4749. h, i: Integer;
  4750. begin
  4751. h := High(TSA);
  4752. Result := ((h > 0) and (oldIndex <> newIndex) and InRange(oldIndex, 0, h) and InRange(newIndex, 0, h));
  4753. if Result then
  4754. if (oldIndex > newIndex) then
  4755. begin
  4756. for i := oldIndex downto (newIndex + 1) do
  4757. Swap(TSA[i], TSA[(i - 1)]);
  4758. end else
  4759. for i := oldIndex to (newIndex - 1) do
  4760. Swap(TSA[i], TSA[(i + 1)]);
  4761. end;
  4762.  
  4763. var
  4764. tmp: TStringArray;
  4765.  
  4766. begin
  4767. tmp := ['Test0', 'Test2', 'Test3', 'Test4', 'Test1', 'Test5'];
  4768. TSAMove(tmp, 4, 1);
  4769. WriteLn(ToStr(tmp));
  4770. end.[/simba]
  4771. [/spoiler]
  4772. [spoiler="TSASame"]
  4773. [simba]{==============================================================================]
  4774. Explanation: Returns true if TSA1 is identical with TSA2.
  4775. [==============================================================================}
  4776. function TSASame(TSA1, TSA2: TStringArray): Boolean;
  4777. var
  4778. h, i: Integer;
  4779. begin
  4780. Result := False;
  4781. h := High(TSA1);
  4782. if (h = High(TSA2)) then
  4783. begin
  4784. for i := 0 to h do
  4785. if (TSA1[i] <> TSA2[i]) then
  4786. Exit;
  4787. Result := True;
  4788. end;
  4789. end;
  4790.  
  4791. begin
  4792. ClearDebug;
  4793. if TSASame(['a', 'b', 'c'], ['a', 'b', 'c', 'd']) then
  4794. WriteLn('WTF!');
  4795. if TSASame(['a', 'b', 'c', 'd'], ['a', 'b', 'c']) then
  4796. WriteLn('WTF!');
  4797. if TSASame(['a', 'b', 'c', 'd'], ['a', 'b', 'c', 'd']) then
  4798. WriteLn('YAY!');
  4799. end.[/simba]
  4800. [/spoiler]
  4801. [spoiler="TSAUnique"]
  4802. [simba]procedure TSAUnique(var TSA: TStringArray);
  4803. var
  4804. h, h2, i, i2, i3, d: Integer;
  4805. begin
  4806. h := High(TSA);
  4807. if (h < 1) then
  4808. Exit;
  4809. for i := (h - d) downto 1 do
  4810. for i2 := (i - 1) downto 0 do
  4811. if (TSA[i] = TSA[i2]) then
  4812. begin
  4813. h2 := High(TSA);
  4814. for i3 := i to (h2 - 1) do
  4815. TSA[i3] := TSA[(i3 + 1)];
  4816. SetLength(TSA, h2);
  4817. Inc(d);
  4818. Break;
  4819. end;
  4820. end;
  4821.  
  4822. var
  4823. TSA: TStringArray;
  4824.  
  4825. begin
  4826. ClearDebug;
  4827. TSA := ['Test0', 'Test1', 'Test1', 'Test2', 'Test0', 'Test3', 'Test3', 'Test2', 'Test4'];
  4828. TSAUnique(TSA);
  4829. WriteLn(ToStr(TSA));
  4830. SetLength(TSA, 0);
  4831. end.[/simba]
  4832. [/spoiler]
  4833. [spoiler="TSAAllUnique"]
  4834. [simba]function TSAAllUnique(TSA: TStringArray): Boolean;
  4835. var
  4836. h, i, i2: Integer;
  4837. begin
  4838. h := High(TSA);
  4839. if (h < 1) then
  4840. begin
  4841. Result := (h = 0);
  4842. Exit;
  4843. end;
  4844. Result := False;
  4845. for i := 0 to (h - 1) do
  4846. for i2 := (i + 1) to h do
  4847. if (i <> i2) then
  4848. begin
  4849. Result := (TSA[i] <> TSA[i2]);
  4850. if not Result then
  4851. Exit;
  4852. end;
  4853. end;
  4854.  
  4855. var
  4856. ATSA: T2DStringArray;
  4857. h, i: Integer;
  4858.  
  4859. begin
  4860. ClearDebug;
  4861. SetLength(ATSA, 9);
  4862. ATSA[0] := ['Test0', 'Test1', 'Test2', 'Test3'];
  4863. ATSA[1] := ['Test0', 'Test1', 'Test2', 'Test1'];
  4864. ATSA[2] := ['Test0', 'Test1', 'Test2', 'Test2'];
  4865. ATSA[3] := ['Test0', 'Test1', 'Test1', 'Test2'];
  4866. ATSA[4] := ['Test0', 'Test1', 'Test1', 'Test1'];
  4867. ATSA[5] := ['Test1', 'Test1', 'Test1', 'Test1'];
  4868. ATSA[6] := ['Test1', 'Test2', 'Test3', 'Test4'];
  4869. ATSA[7] := ['Test'];
  4870. ATSA[8] := [];
  4871. h := High(ATSA);
  4872. for i := 0 to h do
  4873. begin
  4874. if TSAAllUnique(ATSA[i]) then
  4875. WriteLn('ATSA[' + IntToSTr(i) + ']: ALL values are unique!')
  4876. else
  4877. WriteLn('ATSA[' + IntToStr(i) + ']: ALL values are NOT unique.');
  4878. SetLength(ATSA[i], 0);
  4879. end;
  4880. SetLength(ATSA, 0);
  4881. end.[/simba]
  4882. [/spoiler]
  4883. [spoiler="TSAAllSame"]
  4884. [simba]function TSAAllSame(TSA: TStringArray): Boolean;
  4885. var
  4886. h, i: Integer;
  4887. begin
  4888. h := High(TSA);
  4889. if (h < 1) then
  4890. begin
  4891. Result := (h = 0);
  4892. Exit;
  4893. end;
  4894. Result := False;
  4895. for i := 1 to h do
  4896. if (TSA[i] <> TSA[0]) then
  4897. Exit;
  4898. Result := True;
  4899. end;
  4900.  
  4901. var
  4902. ATSA: T2DStringArray;
  4903. h, i: Integer;
  4904.  
  4905. begin
  4906. ClearDebug;
  4907. SetLength(ATSA, 9);
  4908. ATSA[0] := ['Test0', 'Test1', 'Test2', 'Test3'];
  4909. ATSA[1] := ['Test0', 'Test1', 'Test2', 'Test1'];
  4910. ATSA[2] := ['Test0', 'Test1', 'Test2', 'Test2'];
  4911. ATSA[3] := ['Test0', 'Test1', 'Test1', 'Test2'];
  4912. ATSA[4] := ['Test0', 'Test1', 'Test1', 'Test1'];
  4913. ATSA[5] := ['Test1', 'Test1', 'Test1', 'Test1'];
  4914. ATSA[6] := ['Test1', 'Test2', 'Test3', 'Test4'];
  4915. ATSA[7] := ['Test'];
  4916. ATSA[8] := [];
  4917. h := High(ATSA);
  4918. for i := 0 to h do
  4919. begin
  4920. if TSAAllSame(ATSA[i]) then
  4921. WriteLn('ATSA[' + IntToSTr(i) + ']: ALL values are same!')
  4922. else
  4923. WriteLn('ATSA[' + IntToStr(i) + ']: ALL values are NOT same.');
  4924. SetLength(ATSA[i], 0);
  4925. end;
  4926. SetLength(ATSA, 0);
  4927. end.[/simba]
  4928. [/spoiler]
  4929. [spoiler="TSAPos"]
  4930. [simba]{==============================================================================]
  4931. Explanation: Returns index position of TSA which matched str.
  4932. Returns -1 if any of TSA items doesnt match with str.
  4933. [==============================================================================}
  4934. function TSAPos(TSA: TStringArray; str: string): Integer;
  4935. var
  4936. h: Integer;
  4937. begin
  4938. h := High(TSA);
  4939. for Result := 0 to h do
  4940. if (TSA[Result] = str) then
  4941. Exit;
  4942. Result := -1;
  4943. end;
  4944.  
  4945. begin
  4946. WriteLn(TSAPos(['a', 'b', 'c', 'd', 'e', 'f', 'g'], '_'));
  4947. WriteLn(TSAPos(['a', 'b', 'c', 'd', 'e', 'f', 'g'], 'a'));
  4948. WriteLn(TSAPos(['a', 'b', 'c', 'd', 'e', 'f', 'g'], 'b'));
  4949. WriteLn(TSAPos(['a', 'b', 'c', 'd', 'e', 'f', 'g'], 'c'));
  4950. WriteLn(TSAPos(['a', 'b', 'c', 'd', 'e', 'f', 'g'], 'd'));
  4951. WriteLn(TSAPos(['a', 'b', 'c', 'd', 'e', 'f', 'g'], 'x'));
  4952. end.[/simba]
  4953. [/spoiler]
  4954. [spoiler="TSAPosEx"]
  4955. [simba]{==============================================================================]
  4956. Explanation: Returns all positions of TSA which match with str.
  4957. [==============================================================================}
  4958. function TSAPosEx(TSA: TStringArray; str: string): TIntegerArray;
  4959. var
  4960. i, r, h: Integer;
  4961. begin
  4962. h := High(TSA);
  4963. if (h > -1) then
  4964. begin
  4965. SetLength(Result, (h + 1));
  4966. for i := 0 to h do
  4967. if (TSA[i] = str) then
  4968. begin
  4969. Result[r] := i;
  4970. Inc(r);
  4971. end;
  4972. end;
  4973. SetLength(Result, r);
  4974. end;
  4975.  
  4976. begin
  4977. WriteLn(ToStr(TSAPosEx(['a', 'b', 'c', 'd', 'c', 'b', 'a'], '_')));
  4978. WriteLn(ToStr(TSAPosEx(['a', 'b', 'c', 'd', 'c', 'b', 'a'], 'a')));
  4979. WriteLn(ToStr(TSAPosEx(['a', 'b', 'c', 'd', 'c', 'b', 'a'], 'b')));
  4980. WriteLn(ToStr(TSAPosEx(['a', 'b', 'c', 'd', 'c', 'b', 'a'], 'c')));
  4981. WriteLn(ToStr(TSAPosEx(['a', 'b', 'c', 'd', 'c', 'b', 'a'], 'd')));
  4982. WriteLn(ToStr(TSAPosEx(['a', 'b', 'c', 'd', 'c', 'b', 'a'], 'x')));
  4983. end.[/simba]
  4984. [/spoiler]
  4985. [spoiler="TSAPosAll"]
  4986. [simba]function TSAPosAll(s: string; TSA: TStringArray): T2DIntegerArray;
  4987. var
  4988. h, i, l, p, r, sL, t: Integer;
  4989. begin
  4990. h := High(TSA);
  4991. sL := Length(s);
  4992. if ((h > -1) and (sL > 0)) then
  4993. begin
  4994. SetLength(Result, (h + 1));
  4995. for i := 0 to h do
  4996. begin
  4997. l := Length(TSA[i]);
  4998. if (l >= sL) then
  4999. begin
  5000. SetLength(Result[r], (l + 1));
  5001. repeat
  5002. p := PosEx(s, TSA[i], (p + 1));
  5003. if (p > 0) then
  5004. begin
  5005. Result[r][(t + 1)] := p;
  5006. Inc(t);
  5007. end;
  5008. until (p <= 0);
  5009. if (t > 0) then
  5010. begin
  5011. Result[r][0] := i;
  5012. SetLength(Result[r], (t + 1));
  5013. Inc(r);
  5014. t := 0;
  5015. end else
  5016. SetLength(Result[r], 0);
  5017. end;
  5018. end;
  5019. end;
  5020. SetLength(Result, r);
  5021. end;
  5022.  
  5023. var
  5024. TSA: TStringArray;
  5025. ATIA: T2DIntegerArray;
  5026. h, h2, i, i2: Integer;
  5027. str: string;
  5028.  
  5029. begin
  5030. ClearDebug;
  5031. TSA := ['|', '| |', '| | |', '| | | |', '| | | | |',
  5032. '||', '|| ||', '|| || ||', '|| || || ||',
  5033. '|||', '||| |||', '||| ||| |||',
  5034. '||||', '|||| ||||', '|||| |||| ||||'];
  5035. ATIA := TSAPosAll('||', TSA);
  5036. h := High(ATIA);
  5037. for i := 0 to h do
  5038. begin
  5039. h2 := High(ATIA[i]);
  5040. if (h2 > 0) then
  5041. begin
  5042. str := 'Positions in TSA[' + IntToStr(ATIA[i][0]) + ']: ';
  5043. for i2 := 1 to h2 do
  5044. if (i2 < h2) then
  5045. str := (str + IntToStr(ATIA[i][i2]) + ', ')
  5046. else
  5047. str := (str + IntToStr(ATIA[i][i2]));
  5048. WriteLn(str + ' (' + TSA[ATIA[i][0]] + ')');
  5049. str := '';
  5050. end;
  5051. SetLength(ATIA[i], 0);
  5052. end;
  5053. SetLength(ATIA, 0);
  5054. end.[/simba]
  5055. [/spoiler]
  5056. [spoiler="TSAExtractStrings"]
  5057. [simba]{==============================================================================]
  5058. Explanation: Keeps all strings in TSA that are found in strings.
  5059. [==============================================================================}
  5060. procedure TSAExtractStrings(var TSA: TStringArray; strings: TStringArray);
  5061. var
  5062. a, b, c, x, y: Integer;
  5063. begin
  5064. b := High(TSA);
  5065. y := High(strings);
  5066. if ((b > -1) and (y > -1)) then
  5067. for a := 0 to b do
  5068. begin
  5069. for x := 0 to y do
  5070. if (TSA[a] = strings[x]) then
  5071. Break;
  5072. if (x <= y) then
  5073. begin
  5074. TSA[c] := TSA[a];
  5075. Inc(c);
  5076. end;
  5077. end;
  5078. SetLength(TSA, c);
  5079. end;
  5080.  
  5081. var
  5082. TSA, filter: TStringArray;
  5083.  
  5084. begin
  5085. ClearDebug;
  5086. filter := ['Test2', 'Test3', 'Test4', 'Test5', 'Test6', 'Test7'];
  5087. TSA := ['Test0', 'Test1', 'Test2', 'Test3', 'Test4', 'Test5', 'Test6', 'Test7', 'Test8', 'Test9'];
  5088. TSAExtractStrings(TSA, filter);
  5089. WriteLn(ToStr(TSA));
  5090. end.[/simba]
  5091. [/spoiler]
  5092. [spoiler="TSAFilterStrings"]
  5093. [simba]{==============================================================================]
  5094. Explanation: Removes all strings from TSA that are found in strings.
  5095. [==============================================================================}
  5096. procedure TSAFilterStrings(var TSA: TStringArray; strings: TStringArray);
  5097. var
  5098. a, b, c, x, y: Integer;
  5099. begin
  5100. b := High(TSA);
  5101. y := High(strings);
  5102. if ((b > -1) and (y > -1)) then
  5103. for a := 0 to b do
  5104. begin
  5105. for x := 0 to y do
  5106. if (TSA[a] = strings[x]) then
  5107. Break;
  5108. if (x > y) then
  5109. begin
  5110. TSA[c] := TSA[a];
  5111. Inc(c);
  5112. end;
  5113. end;
  5114. SetLength(TSA, c);
  5115. end;
  5116.  
  5117. var
  5118. TSA, filter: TStringArray;
  5119.  
  5120. begin
  5121. ClearDebug;
  5122. filter := ['Test2', 'Test3', 'Test4', 'Test5', 'Test6', 'Test7'];
  5123. TSA := ['Test0', 'Test1', 'Test2', 'Test3', 'Test4', 'Test5', 'Test6', 'Test7', 'Test8', 'Test9'];
  5124. TSAFilterStrings(TSA, filter);
  5125. WriteLn(ToStr(TSA));
  5126. end.[/simba]
  5127. [/spoiler]
  5128. [spoiler="TSAToParts"]
  5129. [simba]type
  5130. TPartitionMethod = (pm_PartSize, pm_PartAmount);
  5131.  
  5132. {==============================================================================]
  5133. Explanation: Breaks TSA to parts (TSA => ATSA). Contains 2 methods:
  5134. -pm_PartSize (Breaks TSA to ATSA by size of the parts) [x = size]
  5135. -pm_PartAmount (Breaks TSA to ATSA by amount of the parts) [x = amount]
  5136. [==============================================================================}
  5137. function TSAToParts(TSA: TStringArray; method: TPartitionMethod; x: Integer): T2DStringArray;
  5138. var
  5139. a, e, h, h2, i, i2, p, z, l: Integer;
  5140. f: Boolean;
  5141. begin
  5142. h := High(TSA);
  5143. if ((h > -1) and (x > 0)) then
  5144. begin
  5145. case method of
  5146. pm_PartSize:
  5147. if (x <= h) then
  5148. begin
  5149. Inc(h);
  5150. p := (h div x);
  5151. if ((p * x) < h) then
  5152. Inc(p);
  5153. SetLength(Result, p);
  5154. for i := 0 to (p - 1) do
  5155. for i2 := 0 to (x - 1) do
  5156. begin
  5157. SetLength(Result[i], x);
  5158. if (a < h) then
  5159. begin
  5160. Result[i][i2] := string(TSA[a]);
  5161. Inc(a);
  5162. end else
  5163. begin
  5164. SetLength(Result[i], i2);
  5165. Exit;
  5166. end;
  5167. end;
  5168. end else
  5169. f := True;
  5170. pm_PartAmount:
  5171. if (h > -1) then
  5172. begin
  5173. if (h < (x - 1)) then
  5174. x := (h + 1);
  5175. p := Floor((h + 1) / x);
  5176. if (p = 0) then
  5177. p := 1;
  5178. e := ((h + 1) - (p * x));
  5179. if (e >= (h + 1)) then
  5180. e := 0;
  5181. SetLength(Result, x);
  5182. for i := 0 to (x - 1) do
  5183. begin
  5184. if ((e >= (i + 1)) and (e > 0)) then
  5185. SetLength(Result[i], (p + 1))
  5186. else
  5187. if (i <= h) then
  5188. SetLength(Result[i], p);
  5189. h2 := High(Result[i]);
  5190. for i2 := 0 to h2 do
  5191. begin
  5192. Result[i][i2] := string(TSA[a]);
  5193. Inc(a);
  5194. end;
  5195. end;
  5196. end else
  5197. f := True;
  5198. end;
  5199. if f then
  5200. begin
  5201. SetLength(Result, 1);
  5202. l := Length(TSA);
  5203. SetLength(Result[0], l);
  5204. for z := 0 to (l - 1) do
  5205. Result[0][z] := string(TSA[z]);
  5206. end;
  5207. end else
  5208. SetLength(Result, 0);
  5209. end;
  5210.  
  5211. var
  5212. str: string;
  5213. TSA: TStringArray;
  5214. ATSA: T2DStringArray;
  5215. x, h, h2, i, i2: Integer;
  5216.  
  5217. begin
  5218. ClearDebug;
  5219. TSA := ['Test0', 'Test1', 'Test2', 'Test3', 'Test4', 'Test5', 'Test6',
  5220. 'Test7', 'Test8', 'Test9', 'Test10', 'Test11', 'Test12', 'Test13',
  5221. 'Test14', 'Test15', 'Test16', 'Test17', 'Test18', 'Test19', 'Test20'];
  5222. for x := 10 downto 3 do
  5223. begin
  5224. WriteLn('TSAToParts(TSA, pm_PartAmount, ' + IntToStr(x) + '):');
  5225. ATSA := TSAToParts(TSA, pm_PartAmount, x);
  5226. h := High(ATSA);
  5227. for i := 0 to h do
  5228. begin
  5229. h2 := High(ATSA[i]);
  5230. str := '';
  5231. str := 'ATSA[' + IntToStr(i) + ']: ';
  5232. for i2 := 0 to h2 do
  5233. if (i2 < h2) then
  5234. str := (str + '''' + ATSA[i][i2] + ''', ')
  5235. else
  5236. str := (str + '''' + ATSA[i][i2] + '''');
  5237. WriteLn(str);
  5238. SetLength(ATSA[i], 0);
  5239. end;
  5240. SetLength(ATSA, 0);
  5241. WriteLn('');
  5242. WriteLn('TSAToParts(TSA, pm_PartSize, ' + IntToStr(x) + '):');
  5243. ATSA := TSAToParts(TSA, pm_PartSize, x);
  5244. h := High(ATSA);
  5245. for i := 0 to h do
  5246. begin
  5247. h2 := High(ATSA[i]);
  5248. str := '';
  5249. str := 'ATSA[' + IntToStr(i) + ']: ';
  5250. for i2 := 0 to h2 do
  5251. if (i2 < h2) then
  5252. str := (str + '''' + ATSA[i][i2] + ''', ')
  5253. else
  5254. str := (str + '''' + ATSA[i][i2] + '''');
  5255. WriteLn(str);
  5256. SetLength(ATSA[i], 0);
  5257. end;
  5258. SetLength(ATSA, 0);
  5259. WriteLn('');
  5260. end;
  5261. SetLength(TSA, 0);
  5262. end.[/simba]
  5263. [/spoiler]
  5264. [spoiler="TSAToATSAByName"]
  5265. [simba]function TSAToATSAByName(TSA: TStringArray): T2DStringArray;
  5266. var
  5267. i, i2, i3, h, h2, hR, l: Integer;
  5268. begin
  5269. SetLength(Result, 0);
  5270. h := High(TSA);
  5271. for i := 0 to h do
  5272. begin
  5273. hR := High(Result);
  5274. for i2 := 0 to hR do
  5275. begin
  5276. h2 := High(Result[i2]);
  5277. for i3 := 0 to h2 do
  5278. if (TSA[i] = Result[i2][i3]) then
  5279. Break;
  5280. if (i3 <= h2) then
  5281. begin
  5282. l := Length(Result[i2]);
  5283. SetLength(Result[i2], (l + 1));
  5284. Result[i2][l] := string(TSA[i]);
  5285. Break;
  5286. end;
  5287. end;
  5288. if (i2 > hR) then
  5289. begin
  5290. SetLength(Result, (hR + 2));
  5291. Result[(hR + 1)] := [string(TSA[i])];
  5292. end;
  5293. end;
  5294. end;
  5295.  
  5296. var
  5297. TSA: TStringArray;
  5298. ATSA: T2DStringArray;
  5299. h, h2, i, i2: Integer;
  5300.  
  5301. begin
  5302. ClearDebug;
  5303. TSA := ['Test1', 'Test1', 'Test2', 'Test0', 'Test1', 'Test3', 'Test0',
  5304. 'Test4', 'Test2', 'Test2', 'Test4', 'Test10', 'Test5', 'Test9',
  5305. 'Test5', 'Test8', 'Test8', 'Test8', 'Test6', 'Test7', 'Test0',
  5306. 'Test10', 'Test1', 'Test5', 'Test6', 'Test3', 'Test'];
  5307. ATSA := TSAToATSAByName(TSA);
  5308. SetLength(TSA, 0);
  5309. h := High(ATSA);
  5310. for i := 0 to h do
  5311. begin
  5312. h2 := High(ATSA[i]);
  5313. for i2 := 0 to h2 do
  5314. WriteLn('ATSA[' + IntToStr(i) + '][' + IntToStr(i2) + ']: ' + ATSA[i][i2]);
  5315. SetLength(ATSA[i], 0);
  5316. end;
  5317. SetLength(ATSA, 0);
  5318. end.[/simba]
  5319. [/spoiler]
  5320. [spoiler="TSAToATSAByLength"]
  5321. [simba]function TSAToATSAByLength(TSA: TStringArray): T2DStringArray;
  5322. var
  5323. i, i2, i3, h, h2, hR, l, t: Integer;
  5324. begin
  5325. SetLength(Result, 0);
  5326. h := High(TSA);
  5327. for i := 0 to h do
  5328. begin
  5329. t := Length(TSA[i]);
  5330. hR := High(Result);
  5331. for i2 := 0 to hR do
  5332. begin
  5333. h2 := High(Result[i2]);
  5334. for i3 := 0 to h2 do
  5335. if (t = Length(Result[i2][i3])) then
  5336. Break;
  5337. if (i3 <= h2) then
  5338. begin
  5339. l := Length(Result[i2]);
  5340. SetLength(Result[i2], (l + 1));
  5341. Result[i2][l] := string(TSA[i]);
  5342. Break;
  5343. end;
  5344. end;
  5345. if (i2 > hR) then
  5346. begin
  5347. SetLength(Result, (hR + 2));
  5348. Result[(hR + 1)] := [string(TSA[i])];
  5349. end;
  5350. end;
  5351. end;
  5352.  
  5353. var
  5354. TSA: TStringArray;
  5355. ATSA: T2DStringArray;
  5356. h, h2, i, i2: Integer;
  5357.  
  5358. begin
  5359. ClearDebug;
  5360. TSA := ['Test1', 'Test1', 'Test2', 'Test0', 'Test1', 'Test3', 'Test0',
  5361. 'Test4', 'Test2', 'Test2', 'Test4', 'Test10', 'Test5', 'Test9',
  5362. 'Test5', 'Test8', 'Test8', 'Test8', 'Test6', 'Test7', 'Test0',
  5363. 'Test10', 'Test1', 'Test5', 'Test6', 'Test3', 'Test'];
  5364. ATSA := TSAToATSAByLength(TSA);
  5365. SetLength(TSA, 0);
  5366. h := High(ATSA);
  5367. for i := 0 to h do
  5368. begin
  5369. h2 := High(ATSA[i]);
  5370. for i2 := 0 to h2 do
  5371. WriteLn('ATSA[' + IntToStr(i) + '][' + IntToStr(i2) + ']: ' + ATSA[i][i2]);
  5372. SetLength(ATSA[i], 0);
  5373. end;
  5374. SetLength(ATSA, 0);
  5375. end.[/simba]
  5376. [/spoiler]
  5377. [spoiler="ATSAMerge"]
  5378. [simba]function ATSAMerge(ATSA: T2DStringArray): TStringArray;
  5379. var
  5380. i, i2, h, h2, r: Integer;
  5381. begin
  5382. h := High(ATSA);
  5383. if (h > -1) then
  5384. begin
  5385. for i := 0 to h do
  5386. IncEx(r, (High(ATSA[i]) + 1));
  5387. SetLength(Result, r);
  5388. r := 0;
  5389. for i := 0 to h do
  5390. begin
  5391. h2 := High(ATSA[i]);
  5392. for i2 := 0 to h2 do
  5393. begin
  5394. Result[r] := string(ATSA[i][i2]);
  5395. Inc(r);
  5396. end;
  5397. end;
  5398. end else
  5399. SetLength(Result, 0);
  5400. end;
  5401.  
  5402. var
  5403. ATSA: T2DStringArray;
  5404. TSA: TStringArray;
  5405. h, i: Integer;
  5406.  
  5407. begin
  5408. ClearDebug;
  5409. SetLength(ATSA, 4);
  5410. ATSA[0] := ['Test0'];
  5411. ATSA[1] := ['Test1', 'Test2'];
  5412. ATSA[2] := ['Test3', 'Test4', 'Test5'];
  5413. ATSA[3] := ['Test6', 'Test7', 'Test8', 'Test9'];
  5414. TSA := ATSAMerge(ATSA);
  5415. SetLength(ATSA, 0);
  5416. h := High(TSA);
  5417. for i := 0 to h do
  5418. WriteLn('TSA[' + IntToStr(i) + ']: ' + TSA[i]);
  5419. SetLength(TSA, 0);
  5420. end.[/simba]
  5421. [/spoiler]
  5422.  
  5423. More to come later... :stirthepot:
  5424. Feel free to use/take/improve/anything - it's all open-source - I don't even need credit.
  5425.  
  5426. Enjoy!
  5427. -Jani
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!