/components/jcf2/Utils/JcfStringUtils.pas

http://github.com/graemeg/lazarus · Pascal · 638 lines · 466 code · 75 blank · 97 comment · 38 complexity · 39f9ee259401826e444d55570e2a1785 MD5 · raw file

  1. unit JcfStringUtils;
  2. {(*}
  3. (*------------------------------------------------------------------------------
  4. Delphi Code formatter source code
  5. The Original Code is JcfStringUtils, released October 2008.
  6. The Initial Developer of the Original Code is Paul Ishenin
  7. Portions created by Paul Ishenin are Copyright (C) 1999-2008 Paul Ishenin
  8. All Rights Reserved.
  9. Contributor(s): Anthony Steele.
  10. The contents of this file are subject to the Mozilla Public License Version 1.1
  11. (the "License"). you may not use this file except in compliance with the License.
  12. You may obtain a copy of the License at http://www.mozilla.org/NPL/
  13. Software distributed under the License is distributed on an "AS IS" basis,
  14. WITHOUT WARRANTY OF ANY KIND, either express or implied.
  15. See the License for the specific language governing rights and limitations
  16. under the License.
  17. Alternatively, the contents of this file may be used under the terms of
  18. the GNU General Public License Version 2 or later (the "GPL")
  19. See http://www.gnu.org/licenses/gpl.html
  20. ------------------------------------------------------------------------------*)
  21. {*)}
  22. {$I JcfGlobal.inc}
  23. {
  24. This unit contains string utility code
  25. For use when the JCL string functions are not avaialable
  26. }
  27. interface
  28. uses
  29. SysUtils, Classes;
  30. const
  31. NativeNull = Char(#0);
  32. NativeSoh = Char(#1);
  33. NativeStx = Char(#2);
  34. NativeEtx = Char(#3);
  35. NativeEot = Char(#4);
  36. NativeEnq = Char(#5);
  37. NativeAck = Char(#6);
  38. NativeBell = Char(#7);
  39. NativeBackspace = Char(#8);
  40. NativeTab = Char(#9);
  41. NativeLineFeed = AnsiChar(#10);
  42. NativeVerticalTab = Char(#11);
  43. NativeFormFeed = Char(#12);
  44. NativeCarriageReturn = AnsiChar(#13);
  45. NativeCrLf = AnsiString(#13#10);
  46. NativeSo = Char(#14);
  47. NativeSi = Char(#15);
  48. NativeDle = Char(#16);
  49. NativeDc1 = Char(#17);
  50. NativeDc2 = Char(#18);
  51. NativeDc3 = Char(#19);
  52. NativeDc4 = Char(#20);
  53. NativeNak = Char(#21);
  54. NativeSyn = Char(#22);
  55. NativeEtb = Char(#23);
  56. NativeCan = Char(#24);
  57. NativeEm = Char(#25);
  58. NativeEndOfFile = Char(#26);
  59. NativeEscape = Char(#27);
  60. NativeFs = Char(#28);
  61. NativeGs = Char(#29);
  62. NativeRs = Char(#30);
  63. NativeUs = Char(#31);
  64. NativeSpace = Char(' ');
  65. NativeComma = Char(',');
  66. NativeBackslash = Char('\');
  67. NativeForwardSlash = Char('/');
  68. {$IFDEF MSWINDOWS}
  69. NativeLineBreak = NativeCrLf;
  70. PathSeparator = '\';
  71. {$ENDIF MSWINDOWS}
  72. {$IFDEF UNIX}
  73. NativeLineBreak = NativeLineFeed;
  74. PathSeparator = '/';
  75. {$ENDIF UNIX}
  76. DirDelimiter = PathSeparator;
  77. NativeHexDigits = ['0'..'9', 'A'..'F', 'a'..'f'];
  78. NativeWhiteSpace = [NativeTab, NativeLineFeed, NativeVerticalTab,
  79. NativeFormFeed, NativeCarriageReturn, NativeSpace];
  80. NativeDoubleQuote = Char('"');
  81. NativeSingleQuote = Char('''');
  82. {$IFNDEF DELPHI12}
  83. {$IFNDEF DELPHI14}
  84. function CharInSet(const C: Char; const testSet: TSysCharSet): Boolean;
  85. {$ENDIF}
  86. {$ENDIF}
  87. function CharIsAlpha(const C: Char): Boolean;
  88. function CharIsAlphaNum(const C: Char): Boolean;
  89. function CharIsWordChar(const c: Char): Boolean;
  90. function CharIsControl(const C: Char): Boolean;
  91. function CharIsDigit(const C: Char): Boolean;
  92. function CharIsReturn(const C: Char): Boolean;
  93. function CharIsWhiteSpace(const C: Char): Boolean;
  94. function CharIsWhiteSpaceNoReturn(const c: Char): boolean;
  95. function CharIsPuncChar(const c: Char): boolean;
  96. function StrIsAlpha(const S: string): Boolean;
  97. function StrIsAlphaNum(const S: string): Boolean;
  98. function CharIsHexDigitDot(const c: Char): Boolean;
  99. function CharIsBinDigit(const c: Char): Boolean;
  100. function StrTrimQuotes(const S: string): string;
  101. function StrAfter(const SubStr, S: string): string;
  102. function StrBefore(const SubStr, S: string): string;
  103. function StrChopRight(const S: string; N: Integer): string;
  104. function StrLastPos(const SubStr, S: string): Integer;
  105. function StrIPos(const SubStr, S: string): integer;
  106. function StrLeft(const S: string; Count: Integer): string;
  107. function StrRestOf(const S: string; N: Integer ): string;
  108. function StrRight(const S: string; Count: Integer): string;
  109. function StrDoubleQuote(const S: string): string;
  110. function StrSmartCase(const S: string; Delimiters: TSysCharSet): string;
  111. function StrCharCount(const S: string; C: Char): Integer;
  112. function StrStrCount(const S, SubS: string): Integer;
  113. function StrRepeat(const S: string; Count: Integer): string;
  114. procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags = []);
  115. function StrSearch(const Substr, S: string; const Index: Integer = 1): Integer;
  116. function BooleanToStr(B: Boolean): string;
  117. function StrToBoolean(const S: string): Boolean;
  118. function StrFind(const Substr, S: string; const Index: Integer = 1): Integer;
  119. function StrIsOneOf(const S: string; const List: array of string): Boolean;
  120. procedure TrimStrings(const List: TStrings; DeleteIfEmpty: Boolean = True);
  121. function FileToString(const FileName: string): AnsiString;
  122. procedure StringToFile(const FileName: string; const Contents: AnsiString);
  123. function StrFillChar(const C: Char; Count: Integer): string;
  124. function IntToStrZeroPad(Value, Count: Integer): String;
  125. function StrPadLeft(const pcOriginal: string;
  126. const piDesiredLength: integer; const pcPad: Char): string;
  127. //function WideStringReplace(const S, OldPattern, NewPattern: WideString; Flags: TReplaceFlags): WideString;
  128. function PathExtractFileNameNoExt(const Path: string): string;
  129. function PadNumber(const pi: integer): string;
  130. function StrHasAlpha(const str: String): boolean;
  131. type
  132. EJcfConversionError = class(Exception)
  133. end;
  134. implementation
  135. uses
  136. {$ifdef MSWINDOWS}
  137. //Windows, ShellApi
  138. {$endif}
  139. {$ifdef Unix}
  140. //Unix
  141. {$endif}
  142. LCLIntf, fileutil;
  143. {$IFNDEF DELPHI12}
  144. {$IFNDEF DELPHI14}
  145. // define CharInSet for Delphi 2007 or earlier
  146. function CharInSet(const C: Char; const testSet: TSysCharSet): Boolean;
  147. begin
  148. Result := C in testSet;
  149. end;
  150. {$ENDIF}
  151. {$ENDIF}
  152. function CharIsAlpha(const C: Char): Boolean;
  153. begin
  154. Result := CharInSet(C, ['a'..'z','A'..'Z']);
  155. end;
  156. function CharIsAlphaNum(const C: Char): Boolean;
  157. begin
  158. Result := CharIsAlpha(C) or CharIsDigit(C);
  159. end;
  160. function CharIsWordChar(const c: Char): Boolean;
  161. begin
  162. Result := CharIsAlpha(c) or (c = '_');
  163. end;
  164. function CharIsControl(const C: Char): Boolean;
  165. begin
  166. Result := C <= #31;
  167. end;
  168. function CharIsDigit(const C: Char): Boolean;
  169. begin
  170. Result := CharInSet(C, ['0'..'9']);
  171. end;
  172. function CharIsReturn(const C: Char): Boolean;
  173. begin
  174. Result := CharInSet(C, [NativeLineFeed, NativeCarriageReturn]);
  175. end;
  176. function CharIsWhiteSpace(const C: Char): Boolean;
  177. begin
  178. Result := CharInSet(C, NativeWhiteSpace) ;
  179. end;
  180. function CharIsWhiteSpaceNoReturn(const c: Char): boolean;
  181. begin
  182. Result := False;
  183. if (c = #0) or CharIsReturn(c) then exit;
  184. // Result := CharIsWhiteSpace(c) and (c <> AnsiLineFeed) and (c <> AnsiCarriageReturn);
  185. Result := (ord(c) <= Ord(NativeSpace));
  186. end;
  187. function CharIsPuncChar(const c: Char): boolean;
  188. begin
  189. Result := False;
  190. if CharIsWhiteSpace(c) then exit;
  191. if CharIsAlphaNum(c) then exit;
  192. if CharIsReturn(c) then exit;
  193. if CharIsControl(c) then exit;
  194. Result := True;
  195. end;
  196. function StrIsAlpha(const S: string): Boolean;
  197. var
  198. I, L: integer;
  199. begin
  200. L := Length(S);
  201. Result := L > 0;
  202. for I := 1 to L do
  203. if not CharIsAlpha(S[I]) then
  204. begin
  205. Result := False;
  206. break;
  207. end;
  208. end;
  209. function StrIsAlphaNum(const S: string): Boolean;
  210. var
  211. I, L: integer;
  212. begin
  213. L := Length(S);
  214. Result := L > 0;
  215. for I := 1 to L do
  216. if not CharIsAlphaNum(S[I]) then
  217. begin
  218. Result := False;
  219. break;
  220. end;
  221. end;
  222. function CharIsHexDigitDot(const c: Char): Boolean;
  223. const
  224. HexDigits: set of AnsiChar = [
  225. '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
  226. 'A', 'B', 'C', 'D', 'E', 'F',
  227. 'a', 'b', 'c', 'd', 'e', 'f'];
  228. begin
  229. Result := (c in HexDigits) or (c = '.');
  230. end;
  231. function CharIsBinDigit(const c: Char): Boolean;
  232. const
  233. BinDigits: set of AnsiChar = ['0','1'];
  234. begin
  235. Result := (c in BinDigits);
  236. end;
  237. function StrTrimQuotes(const S: string): string;
  238. var
  239. C1, C2: Char;
  240. L: Integer;
  241. begin
  242. Result := S;
  243. L := Length(Result);
  244. if L >= 2 then
  245. begin
  246. C1 := Result[1];
  247. C2 := Result[L];
  248. if (C1 = C2) and (CharInSet(C1, [NativeSingleQuote, NativeDoubleQuote])) then
  249. begin
  250. Delete(Result, L, 1);
  251. Delete(Result, 1, 1);
  252. end;
  253. end;
  254. end;
  255. function StrAfter(const SubStr, S: string): string;
  256. var
  257. P: Integer;
  258. begin
  259. P := StrSearch(SubStr, S, 1);
  260. if P > 0 then
  261. Result := Copy(S, P + Length(SubStr), Length(S))
  262. else
  263. Result := '';
  264. end;
  265. function StrBefore(const SubStr, S: string): string;
  266. var
  267. P: Integer;
  268. begin
  269. P := StrSearch(SubStr, S, 1);
  270. if P > 0 then
  271. Result := Copy(S, 1, P - 1)
  272. else
  273. Result := S;
  274. end;
  275. function StrChopRight(const S: string; N: Integer): string;
  276. begin
  277. Result := Copy(S, 1, Length(S) - N);
  278. end;
  279. function StrLastPos(const SubStr, S: string): Integer;
  280. var
  281. NewPos: Integer;
  282. begin
  283. Result := 0;
  284. while Result < Length(S) do
  285. begin
  286. NewPos := StrSearch(SubStr, S, Result + 1);
  287. if NewPos > 0 then
  288. Result := NewPos
  289. else
  290. break;
  291. end;
  292. end;
  293. { case-insensitive "pos" }
  294. function StrIPos(const SubStr, S: string): integer;
  295. begin
  296. // simple and inneficient implmentation
  297. Result := Pos(UpperCase(SubStr), UpperCase(s));
  298. end;
  299. function StrLeft(const S: string; Count: Integer): string;
  300. begin
  301. Result := Copy(S, 1, Count);
  302. end;
  303. function StrRestOf(const S: string; N: Integer ): string;
  304. begin
  305. Result := Copy(S, N, (Length(S) - N + 1));
  306. end;
  307. function StrRight(const S: string; Count: Integer): string;
  308. begin
  309. Result := Copy(S, Length(S) - Count + 1, Count);
  310. end;
  311. function StrDoubleQuote(const S: string): string;
  312. begin
  313. Result := NativeDoubleQuote + S + NativeDoubleQuote;
  314. end;
  315. function StrSmartCase(const S: string; Delimiters: TSysCharSet): string;
  316. var
  317. i: integer;
  318. begin
  319. // if no delimiters passed then use default set
  320. if Delimiters = [] then
  321. Delimiters := NativeWhiteSpace;
  322. Result := S;
  323. for i := 1 to Length(Result) do
  324. if (i = 1) or (CharInSet(Result[i - 1], Delimiters)) then
  325. Result[i] := UpCase(Result[i]);
  326. end;
  327. function StrCharCount(const S: string; C: Char): Integer;
  328. var
  329. i: integer;
  330. begin
  331. Result := 0;
  332. for i := 1 to Length(S) do
  333. if S[i] = C then
  334. inc(Result);
  335. end;
  336. function StrStrCount(const S, SubS: string): Integer;
  337. var
  338. P: integer;
  339. begin
  340. Result := 0;
  341. P := 1;
  342. while P < Length(S) do
  343. begin
  344. P := StrSearch(Subs, S, P);
  345. if P > 0 then
  346. begin
  347. inc(Result);
  348. inc(P);
  349. end
  350. else
  351. break;
  352. end;
  353. end;
  354. function StrRepeat(const S: string; Count: Integer): string;
  355. begin
  356. Result := '';
  357. while Count > 0 do
  358. begin
  359. Result := Result + S;
  360. Dec(Count);
  361. end;
  362. end;
  363. procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags = []);
  364. begin
  365. S := StringReplace(S, Search, Replace, Flags);
  366. end;
  367. function StrSearch(const Substr, S: string; const Index: Integer = 1): Integer;
  368. begin
  369. // Paul: I expect original code was more efficient :)
  370. Result := Pos(SubStr, Copy(S, Index, Length(S)));
  371. if Result > 0 then
  372. Result := Result + Index - 1;
  373. end;
  374. function BooleanToStr(B: Boolean): string;
  375. const
  376. BoolToStrMap: array[Boolean] of String =
  377. (
  378. { false } 'False',
  379. { true } 'True'
  380. );
  381. begin
  382. Result := BoolToStrMap[B];
  383. end;
  384. function StrToBoolean(const S: string): Boolean;
  385. var
  386. LowerS: String;
  387. begin
  388. LowerS := LowerCase(S);
  389. if (LowerS = 'false') or (LowerS = 'no') or (LowerS = '0') then
  390. Result := False
  391. else
  392. if (LowerS = 'true') or (LowerS = 'yes') or (LowerS = '1') or (LowerS = '-1') then
  393. Result := True
  394. else
  395. raise EJcfConversionError.Create('Cannot convert string [' + S + '] to boolean');
  396. end;
  397. function StrFind(const Substr, S: string; const Index: Integer = 1): Integer;
  398. begin
  399. // Paul: original code used comparision by char case table
  400. Result := StrSearch(LowerCase(SubStr), LowerCase(S), Index);
  401. end;
  402. function StrIsOneOf(const S: string; const List: array of string): Boolean;
  403. var
  404. i: integer;
  405. begin
  406. for i := Low(List) to High(List) do
  407. if CompareStr(List[i], S) = 0 then
  408. begin
  409. Result := True;
  410. Exit;
  411. end;
  412. Result := False;
  413. end;
  414. procedure TrimStrings(const List: TStrings; DeleteIfEmpty: Boolean = True);
  415. var
  416. i: integer;
  417. begin
  418. if List <> nil then
  419. for i := List.Count - 1 downto 0 do
  420. begin
  421. List[i] := Trim(List[i]);
  422. if DeleteIfEmpty and (List[i] = '') then
  423. List.Delete(i);
  424. end;
  425. end;
  426. function FileToString(const FileName: string): AnsiString;
  427. var
  428. S: TStream;
  429. begin
  430. S := nil;
  431. try
  432. S := TFileStream.Create(FileName, fmOpenRead or fmShareDenyNone);
  433. SetLength(Result, S.Size);
  434. S.Read(PAnsiChar(Result)^, S.Size);
  435. finally
  436. S.Free;
  437. end;
  438. end;
  439. procedure StringToFile(const FileName: string; const Contents: AnsiString);
  440. var
  441. S: TStream;
  442. begin
  443. S := nil;
  444. try
  445. S := TFileStream.Create(FileName, fmCreate);
  446. S.Write(PAnsiChar(Contents)^, Length(Contents));
  447. finally
  448. S.Free;
  449. end;
  450. end;
  451. function StrFillChar(const C: Char; Count: Integer): string;
  452. begin
  453. SetLength(Result, Count);
  454. if Count > 0 then
  455. FillChar(Result[1], Count, C);
  456. end;
  457. function IntToStrZeroPad(Value, Count: Integer): String;
  458. begin
  459. Result := IntToStr(Value);
  460. while Length(Result) < Count do
  461. Result := '0' + Result;
  462. end;
  463. { pad the string on the left had side until it fits }
  464. function StrPadLeft(const pcOriginal: string;
  465. const piDesiredLength: integer; const pcPad: Char): string;
  466. begin
  467. Result := pcOriginal;
  468. while (Length(Result) < piDesiredLength) do
  469. begin
  470. Result := pcPad + Result;
  471. end;
  472. end;
  473. // Based on FreePascal version of StringReplace
  474. {function WideStringReplace(const S, OldPattern, NewPattern: WideString; Flags: TReplaceFlags): WideString;
  475. var
  476. Srch, OldP, RemS: WideString; // Srch and Oldp can contain uppercase versions of S,OldPattern
  477. P: Integer;
  478. begin
  479. Srch := S;
  480. OldP := OldPattern;
  481. if rfIgnoreCase in Flags then
  482. begin
  483. Srch := WideUpperCase(Srch);
  484. OldP := WideUpperCase(OldP);
  485. end;
  486. RemS := S;
  487. Result := '';
  488. while (Length(Srch) <> 0) do
  489. begin
  490. P := Pos(OldP, Srch);
  491. if P = 0 then
  492. begin
  493. Result := Result + RemS;
  494. Srch := '';
  495. end
  496. else
  497. begin
  498. Result := Result + Copy(RemS, 1, P - 1) + NewPattern;
  499. P := P + Length(OldP);
  500. RemS := Copy(RemS, P, Length(RemS) - P + 1);
  501. if not (rfReplaceAll in Flags) then
  502. begin
  503. Result := Result + RemS;
  504. Srch := '';
  505. end
  506. else
  507. Srch := Copy(Srch, P, Length(Srch) - P + 1);
  508. end;
  509. end;
  510. end;
  511. }
  512. function PadNumber(const pi: integer): string;
  513. begin
  514. Result := IntToStrZeroPad(pi, 3);
  515. end;
  516. function StrHasAlpha(const str: String): boolean;
  517. var
  518. liLoop: integer;
  519. begin
  520. Result := False;
  521. for liLoop := 1 to Length(str) do
  522. begin
  523. if CharIsAlpha(str[liLoop]) then
  524. begin
  525. Result := True;
  526. break;
  527. end;
  528. end;
  529. end;
  530. {------------------------------------------------------
  531. functions to manipulate file paths in strings }
  532. function PathRemoveExtension(const Path: string): string;
  533. var
  534. p: Integer;
  535. begin
  536. // from Lazarus FileUtil
  537. Result := Path;
  538. p := Length(Result);
  539. while (p>0) do
  540. begin
  541. case Result[p] of
  542. PathDelim: Exit;
  543. '.': Result := copy(Result, 1, p-1);
  544. end;
  545. Dec(p);
  546. end;
  547. end;
  548. function PathExtractFileNameNoExt(const Path: string): string;
  549. begin
  550. Result := PathRemoveExtension(ExtractFileName(Path));
  551. end;
  552. function PathRemoveSeparator(const Path: string): string;
  553. begin
  554. Result := Path;
  555. if (Result <> '') and (Result[Length(Result)] = PathDelim) then
  556. Delete(Result, Length(Result), 1);
  557. end;
  558. end.