/components/jcf2/Utils/JcfStringUtils.pas

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