-
Notifications
You must be signed in to change notification settings - Fork 22
Expand file tree
/
Copy pathLightCore.pas
More file actions
2637 lines (2000 loc) · 93.4 KB
/
LightCore.pas
File metadata and controls
2637 lines (2000 loc) · 93.4 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
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
91
92
93
94
95
96
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
UNIT LightCore;
{=============================================================================================================
2026.01.30
www.GabrielMoraru.com
--------------------------------------------------------------------------------------------------------------
- String manipulation (string conversions, sub-string detection, word manipulation, cut, copy, split, wrap, etc)
- Programmer's helper
See also LightCore.WrapString.pas
=============================================================================================================}
INTERFACE
USES
System.AnsiStrings, System.Character, System.SysUtils, System.Math, System.IOUtils, System.StrUtils,
System.Classes, System.Types, LightCore.Types;
{ Enters }
CONST
CR = #13; { $0D. Used on Mac OS, Apple II family, ZX Spectrum }
LF = #10; { $0A Used on Unix (Linux, OS X, FreeBSD, AIX, Xenix, etc.), BeOS, Amiga, RISC OS }
CRLFw = #13#10; { Used on Windows, OS/2, Symbian OS, Palm OS }
CRLF = sLineBreak; { Cross platform }
LBRK = CRLF+CRLF;
{ Special characters }
CONST
TAB = #9;
ESC = #27;
Space = #32; { $20 }
Quote = #39;
CopyrightSymbol = '©';
GradCelsius = '°';
Euro = #8364; { Euro Sign: Alt+0128. Unicode Number: 8364 }
{=============================================================================================================
ENTER
Also see cmPlatformFile.pas
============================================================================================================}
function CRLFToEnter (CONST s: string): string; // old name: FixCRLF
function EnterToCRLF (CONST s: string): string; // Replaces #13#10 with CRLF
function ReplaceLonellyCR (CONST s, ReplaceWith: string): string;
function ReplaceLonellyLF (CONST s, ReplaceWith: string): string;
function LinuxEnter2Win (CONST s: string): string; deprecated 'Use System.SysUtils.AdjustLineBreaks instead.';
function TrimEnters (CONST s: string): string; { Remove enter characters (#10 and #13) from the beginning and the end of the string }
function RemoveEnters (CONST s: string): string; overload; { Works both with Linux, Windows and half-enter characters }
function RemoveEnters (CONST s: Ansistring): Ansistring; overload;
function ReplaceEnters (CONST s, ReplaceWith: string): string;
function RemoveLastEnter (CONST s: string): string; overload; { Cuts the last Enter from a string }
function RemoveLastEnter (CONST s: AnsiString): AnsiString; overload;
{=============================================================================================================
REPLACE
============================================================================================================}
function ReplaceUnicodeChars (CONST s: string; ReplaceWith: char): String; { Replace all Unicode characters withsomething else }
function ReplaceCharF (CONST s: string; CONST SearchFor, ReplaceWith: char): string;
procedure ReplaceChar (var s: string; CONST SearchFor, ReplaceWith: Char); overload;
procedure ReplaceChar (var s: AnsiString; CONST SearchFor, ReplaceWith: AnsiChar); overload;
function ReplaceStringAnsi (CONST s, SearchFor, ReplaceWith: AnsiString): AnsiString;
function ReplaceString (CONST s, SearchFor, ReplaceWith: string): string;
function ReplaceBetween (CONST s, TagStart, TagEnd, ReplaceWith: string; Start: Integer; EliminateTags: Boolean; OUT LastPos: Integer): string;
function SearchBetween (CONST s, TagStart, TagEnd: string; Start: Integer = 1): Integer;
{=============================================================================================================
CLEAN STRINGS
============================================================================================================}
function RemoveNonAlphanum (CONST s: string): string; { Keep only letters and numbers }
function RemoveFormatings (CONST s: string): string;
function RemoveLowChars (CONST s: string): string; overload;
function RemoveLowChars (CONST s: AnsiString): AnsiString; overload;
function RemoveSpaces (CONST s: string): string; overload;
function RemoveSpaces (CONST s: Ansistring): Ansistring; overload;
function RemoveTabs (CONST s: string): string;
function RemoveLastSpace (CONST s: string): string; { Cuts the last SPACE from a string. If there are more spaces only the last one is cut }
function RemoveLastChar (CONST s: string): string; overload;
function RemoveLastChar (CONST s, StrToRemove: string): string; overload;
function RemoveLastChar (CONST s: AnsiString): AnsiString; overload;
function RemoveFirstChar (CONST s: string; Char: Char): string; { Remove first character from the string but ONLY if it is Char }
function RemoveNumbers (CONST s: string): string; overload; { Eliminates numbers from the specified string }
function RemoveNumbers (CONST s: AnsiString): AnsiString; overload;
function TrimUntil (CONST s: string; Limiter: Char): string; { Remove any characters from the beginning and the end of a string until Limiter is found. Limiter is kept. Example: if Limiter is $ and the string is 'xxxxx$ThisIsMyString$@@@@@@'. then the result will be '$ThisIsMyString$' }
function TrimUntilDiff (CONST s: string; Limiter: Char): string; { Remove characters from both ends of a string until something different than Limiter is found. Example: TrimUntilDiff('--ACGT--', '-') returns 'ACGT' }
function Retabulate (CONST s, Delimiter: string; SpaceCount: Integer): string; { Converts multiple spaces to Tab or other similar separator. For example Retabulate('xx xx yy, 3, Tab') will convert the first 3 spaces to tab but not also the next 2 spaces }
function ReplaceNbsp (CONST s, ReplaceWith: string): string;
{=============================================================================================================
WORDS
============================================================================================================}
function IsWordSeparator (CONST aChar: Char): Boolean; { Returns true if the specified char is a word separator .;?,! }
function CopyWords (CONST s: string; MaxChars: Integer): string; { Copy from s all complete words. The result will not have more than MaxChars characters. }
procedure ReplaceShortWords (var s: string; MinLength: Integer; FilterIfNoWovels: Boolean); { This procedure will replace short words (length < MinLength) with spaces. It also filters words that only contain consonants }
function ReplaceWholeWords (const InputStr, OldWord, NewWord: string; const Delimiters: array of Char): string; overload;
function ReplaceWholeWords (const InputStr, OldWord, NewWord: string): string; overload;
function WordCountStrict (CONST s: string): Integer;
function WordCount (CONST s: string): Integer;
{=============================================================================================================
CUT
============================================================================================================}
function CutInclude2Left (CONST s, SearchFor: string): string; { Delete all chars from end of MATCH to Left - including the match }
function CutInclude2Right (CONST s, SearchFor: string): string; { Delete all chars from beg of MATCH to Right - including the match }
function CutExcludeLeft (CONST s, SearchFor: string): string; { Delete all chars from beg of MATCH to Left - excluding the match }
function CutExcludeRight (CONST s, SearchFor: string): string; { Delete all chars from end of MATCH to Right - excluding the match }
{=============================================================================================================
COPY
============================================================================================================}
function CopyTo (CONST s: String; iFrom: Integer; CONST sTo: string; IncludeMarker: Boolean= TRUE; CopyAllMarkerNotFound: Boolean= FALSE; MarkerOffset: Integer= 1): string; overload;
function CopyFromTo (CONST s, sFrom, sTo: string; IncludeMarkers: Boolean= FALSE): string;
function CopyFrom (CONST s, sFrom: string; Count: Integer; IncludeMarker: Boolean= TRUE; SearchOffset: Integer= 1): string; overload; { Find sFrom in s. Returns the string from the postion where the text was found, to the end. }
function CopyFrom (CONST s, sFrom: AnsiString; Count: Integer; IncludeMarker: Boolean= TRUE; SearchOffset: Integer= 1): AnsiString; overload;
// COPY
function CopyTo (CONST s: string; iFrom, iTo: integer): string; overload; { Copy the text between iFrom and ending at iTo (including) }
function CopyTo (CONST s: AnsiString; iFrom, iTo: integer): AnsiString; overload; { Copy the text between iFrom and ending at iTo (including) }
{=============================================================================================================
SPLIT
============================================================================================================}
function SplitText (CONST Text, Delimiter: string): TStringList; { Splits a text in lines and puts the lines in a TStringList } {Note: Exista System.StrUtils.SplitString } { Old name: SplitStrings }
procedure SplitLine (CONST Text, Delimiter: string; OUT sField, sValue: string); overload; { Split a string in its components. For example 'ClientName=Bubu' will return in 'ClientName' and 'Bubu' }
procedure SplitStrings (CONST Text: string; TSL: TStringList); overload; { Split a string in multiple rows every time the #13#10 char is found (I took this code from Embarcadero's TStringList.Text:= s ) }
procedure SplitStringAtPos (CONST Text: string; CONST Pos: Integer; OUT s1, s2: string); overload; { Split a string in two substrings at the specified position. The char at Pos will be included in the first string. }
procedure SplitStringAtPos (CONST Text: AnsiString; CONST Pos: Integer; OUT s1, s2: AnsiString); overload;
procedure SplitStringList (StringList: TStrings; OUT OutList1, OutList2: TStringArray); { Split each row of the provided StringList into two parts. The two resulted strings are placed in an ArrayOfStrings }
procedure SplitStringListI (StringList: TStrings; OUT OutList1: TStringArray; OUT OutList2: System.Types.TIntegerDynArray); { Split each row of the provided StringList into two parts. The two resulted strings are placed in an ArrayOfStrings }
{============================================================================================================
STRING POS
============================================================================================================}
function Find (CONST Needle, Haystack: string; PartialSearch: Boolean= False; CaseSens: Boolean= False): boolean;
function CountAppearance (CONST Needle, Haystack: string; CaseSensit: Boolean): integer; overload;
function CountAppearance (CONST Niddle: Char; CONST Haystack: string) : Integer; overload;
function CountAppearance (CONST Niddle: AnsiChar; CONST Haystack: AnsiString): Integer; overload;
function LastPos (CONST Niddle, S: string): Integer; overload; { Return the position of the last occurence of a substring in String. Not tested. Also see 'EndsStr' }
function LastPos (CONST Niddle: Char; CONST S: String): Integer; overload;
function PosAtLeast (CONST Niddle, S: string; AtLeast: Integer): Boolean; { Returns true if the specified string appears at least x times }
function PosInsensitive (CONST Niddle, Haystack: string): Integer; overload;
function PosInsensitive (CONST Niddle, Haystack: AnsiString): Integer; overload;
function LastChar (CONST s: string): string; { Returns the last char in the string but checks first if the string is empty (so it won't crash). Returns '' if the string is empty }
function FirstChar (CONST s: string): string; { Returns the first char in the string but checks first if the string is empty (so it won't crash). Returns '' if the string is empty }
function FirstCharIs (CONST s: string; c: Char): Boolean;
function LastCharIs (CONST s: string; c: Char): Boolean;
function FirstNonSpace (CONST s: string): Integer; { Returns the position of the first character that is no a space. For example: ' Earth' returns 3. }
{============================================================================================================
CONVERSION TO NUMBERS
============================================================================================================}
function i2s (Value: Integer): string; overload; inline;
function i2s (Value, MaxVal: integer): string; overload; { Add the specified number of zeros before the string. See LeadingZerosAuto help for details }
function i2s (Value: Int64) : string; overload; { int64 can hold up to 9223372036854775807 }
function i2sHuman (Value: Int64) : string; { Retunrs something like: 1= 1st, 2= 2nd, 3= 3rd, 4= 4th }
function ExtractIntFromStr (const s: string): Integer; { Extracts a number from a string. Works only if the number is at the beginning of the string. Example '123xxx' }
function Real2Str (CONST ExtValue: Extended; Decimals: Byte = 1; HideNulMantisa: Boolean= True): string;
function Rectangle2Str (CONST Rect: TRect): string;
function FormatBytes (CONST Size: Int64; CONST Decimals: Integer= 1): string; { Format bytes to KB, MB, GB, TB }
function FormatBytesMB (CONST Size: Int64; CONST Decimals: Integer= 1): string; { Same as above but the function will never return values formated in GB range. More exactly instead of 10GB it will return 10240MB }
function FormatNumber (CONST Size: Int64; CONST Decimals: Integer= 1): string; { It will return 1K for 1000, 1M for 1000000 and so on }
function BoolToStrYesNo (CONST B: Boolean): string;
{============================================================================================================
NUMBERS
============================================================================================================}
function FixNumber (CONST s: string): Integer; { Converts a text that contains an invalid number to a valid number. For example '!2345' will return '2345' }
function StringIsInteger (CONST s: string): Boolean;
function CharIsNumber (CONST c: char) : Boolean;
procedure SplitNumber_Start (CONST s: string; OUT Text, Number: string); { Splits a string that STARTS with a number into its parts. Example: 01_Render -> 01 + _Render }
procedure SplitNumber_End (CONST s: string; OUT Text, Number: string); { Splits a string that ENDS in a number into its parts. Example: Document12 -> Document + 12 }
function IncrementStringNo (CONST s: string): string; { Receive a number as string. return the same number but incremented with 1. automatically adjust the leading zeros }
function IncrementStringNoEx (CONST s: string): string; { Similar with IncrementStringNo but this version also accepts invalid numbers. If the input string doesn't end with a valid number, append 0 at its end. Then extracts the end number and increase it. Example: 0zzz will return 0zzz0, while xxx33 will retun xxx34 }
function LastLetterInString (CONST s: string): Integer; { Returns the postion of the last non-number character in a string. For example 9d9ad8f7ax0000 returns 10 (the position of x) }
function StringSumm (CONST s: AnsiString): Cardinal; overload;
function StringSumm (CONST s: String): Cardinal; overload; { Compute the summ of all characters in the string }
{=============================================================================================================
OTHERS
============================================================================================================}
function InsertCharEvery (CONST c: char; CONST Target: string; Every: Integer): string; { Insert a char into TargetStr every x characters }
function DoubleQuoteStr (CONST s: string): string;
function Reverse (CONST s: String): string; deprecated 'LightCore.Reverse is deprecated. Use System.StrUtils.ReverseString';
function CharInArray (CONST c: Char; const Chars: TCharArray): Boolean;
function CharIsLetter (CONST c: char): Boolean;
function IsUpcaseLetter (CONST c: Char): Boolean;
function IsUpcase (CONST c: Char): Boolean; { Works only with letters. }
// COPY from/to marker
function ExtractTextBetween (CONST s, TagStart, TagEnd: string): string; { Extract the text between the tags. For example '<H>Title</H>' will return 'Title' is iFrom= '<H>' and iTo= '</H>' }
{=============================================================================================================
COMPARE/SIMILARITY/SORT
============================================================================================================}
function FileNameNaturalSort (s1, s2: String): Integer; { Natural compare two filenames }
{$IFDEF MSWINDOWS}
function StrCmpLogicalW (psz1, psz2: PWideChar): Integer; stdcall; external 'shlwapi.dll'; {$ENDIF} { Natural compare two strings. Digits in the strings are considered as numerical content rather than text. This test is not case-sensitive. Use it like this: StrCmpLogicalW(PChar(s1), PChar(s2)); see: http://stackoverflow.com/questions/1024515/delphi-is-it-necessary-to-convert-string-to-widestring. }
function FuzzyStringCompare (CONST s1, s2: string): Integer; { Text similarity. The function checks if any identical characters is in the near of the actual compare position. }
function LevenshteinDistance (CONST s1, s2: string): Integer; { Returns the minimum number of single-character edits (insert, delete, substitute) to transform s1 into s2. }
function LevenshteinSimilarity (CONST s1, s2: string): Integer; { Returns similarity as percentage (0-100). Based on Levenshtein distance. }
function LevenshteinSimilarityCase(CONST s1, s2: string): Integer;
{=============================================================================================================
GENERATE - MAKE STRING
============================================================================================================}
function MakeStringLongRight (CONST s, c: AnsiChar; ForcedLength: integer): AnsiString; overload;
function MakeStringLongRight (CONST s, c: Char; ForcedLength: integer): string; overload;
function MakeStringLongRight (CONST s, Pad: string; ForcedLength: integer): string; overload; { Make sure the string has ForcedLength. If not, add some extra characters at its end to make it that long }
function MakeStringLongLeft (CONST s, Pad: string; ForcedLength: integer): string; { Make sure the string has ForcedLength. If not, add some extra characters at its front to make it that long }
function LeadingZeros (CONST s: string; ForcedLength: integer): string; { insert (ForcedLength-1) zeros in front of the specified string. ForcedLength shows which is the desired lenght of the new string. Example: LeadingZeros('a', 4) will result in '000a' }
function LeadingZeros2 (CONST s: string; ForcedLength: integer): string; { Not tested }
function LeadingZerosAuto (CONST s: string; MaxValue: integer): string; { Same as above except_ that the user doesn't have to specify how many zeros to add. Instead the function will determine this automaticxally based on the number received as parameter. For example LeadingZeros('1', 50) will generate '01' but LeadingZeros('1', 500) will generate '001' }
{=============================================================================================================
GENERATE - RANDOM STRINGS
============================================================================================================}
function GenerateString (RepeatTimes: Integer; C: char): string; deprecated 'Use System.StringOfChar instead'; { Exista System.StrUtils.DupeString and StuffString Returns the concatenation of a string with itself a specified number of repeats. }
function GenerateUniqueString (Len: Integer=32): string;
function GenerateRandomWord (Len: Integer=16; StartWithVowel: Boolean= FALSE): string;
function GenerateRandString (minLen, maxLen: Integer): string; { This will return all printable craracters (from 65 to 125) }
function GenerateRandStringLet (Len: Integer): string; { This will return ONLY letters and numbers } { YOU MUST call randomize before calling this function! }
{=============================================================================================================
GENERATE - LISTS OF NAMES
============================================================================================================}
function GetRandomPersonName: string; { Returns a random name in a 100 unique name list }
function GetRandomStreetName: string;
function GetRockBands: TStringList;
{=============================================================================================================
UNICODE
============================================================================================================}
function UnicodeToAnsi (CONST str: UnicodeString; codePage: Integer): RawByteString;
function AddNullToStr (CONST Path: string): string;
{=============================================================================================================
STRING RAM SIZE
============================================================================================================}
function GetStringSize (CONST s: string): Integer; { Returns the length of a given string in bytes }
function GetStringRAMSize (CONST s: string): Integer; overload;
function GetStringRAMSize (CONST s: AnsiString): Integer; overload;
IMPLEMENTATION
{ Don't add any dependecies to LightSaber here if possible in order to keep LightCore as single-file library }
{=============================================================================================================
CONVERSIONS
=============================================================================================================}
{ It works with signs like: '+1' and '-1' }
{$Hints Off} {Needed to silence "Value assigned to 'iTemp' never used" }
function StringIsInteger(CONST s: string): Boolean;
VAR iTemp, E: integer;
begin
Val(s, iTemp, E);
Result:= E= 0;
end;
{$Hints On}
function CharIsNumber(CONST c: char): Boolean;
begin
Result:= CharInSet(c, Numbers);
end;
function CharIsLetter(CONST c: char): Boolean;
begin
Result:= CharInSet(c, Alphabet);
end;
function CharInArray(const C: Char; const Chars: TCharArray): Boolean;
VAR Ch: Char;
begin
for Ch in Chars do
if Ch = C then
Exit(True);
Result := False;
end;
{ Split a string (could be a filename) that ENDS in a number into its parts. Example:
Document_12 -> Document_ + 12
NewMelody08 -> NewMelody + 08 }
procedure SplitNumber_End(CONST s: string; OUT Text, Number: string);
VAR i: Integer;
begin
Number:= s;
for i:= Length(s) DownTO 1 DO { Search from end to front. Need to find where string ends and digits start. Example: 'Monkey 02' }
if NOT CharIsNumber(s[i]) then
begin { Found a letter. Split text in two }
Text := CopyTo(s, 1, i);
Number:= system.COPY(s, i+1, MaxInt);
EXIT;
end;
end;
{ Split a string that STARTS in a number into its parts. Example: 01_Render -> 01 + _Render }
procedure SplitNumber_Start(CONST s: string; OUT Text, Number: string);
VAR i: Integer;
begin
for i:= 1 TO Length(s) DO { Search from end to front. I need to see where the strings ends and where the digits start. Ex: 'Monkey 13' }
if NOT CharIsNumber(s[i]) then
begin { Letter found. Split text in two. }
Number:= system.COPY(s, 1, i-1);
Text := system.COPY(s, i, MaxInt);
EXIT;
end;
end;
{ Returns the position of the last non-digit character in a string.
Scans from end towards beginning, skipping trailing digits.
Example: '9d9ad8f7ax0000' returns 10 (the position of 'x').
Raises exception if string is empty.
Raises ERangeError if string contains only digits. }
function LastLetterInString(CONST s: string): Integer;
begin
if s = ''
then raise Exception.Create('LastLetterInString: Empty string');
Result:= Length(s);
while (Result > 0) AND s[Result].IsDigit DO
Dec(Result);
if Result = 0
then raise ERangeError.Create('LastLetterInString: String contains only digits');
end;
function IncrementStringNo(CONST s: string): string; { Receives a valid number represented as string. Returns the same number but incremented with 1. automatically adjust the leading zeros. The function raises an error if the input text does not represent a number }
VAR i, Zeros, iNumar, OldLength: Integer;
begin
if s= '' then raise exception.Create(s+ ' is not a valid number!');
{ Keep 0s }
Zeros:= 0;
for i:= 1 TO Length(s) DO
if s[i]= '0' { Check if user put zeros in front of the number }
then inc(Zeros) { If so, count them }
else Break;
iNumar:= StrToInt(s); { Let it RAISE an error if the string is not a valid number }
OldLength:= Length(IntToStr(iNumar));
inc(iNumar);
if Length(IntToStr(iNumar)) > OldLength
then Dec(Zeros); { we switched from 9 to 10 or 99 to 100, etc }
Result:= StringOfChar('0', Zeros)+ IntToStr(iNumar);
end;
{ Similar with IncrementStringNo but this version also accepts invalid numbers. If the input string doesn't end with a valid number, append 0 at its end. Then extracts the end number and increase it. Example: 0zzz will return 0zzz0, while xxx33 will retun xxx34 }
function IncrementStringNoEx(CONST s: string): string;
VAR
Text, Number: string;
begin
if s= '' then EXIT('0');
SplitNumber_End(s, Text, Number);
if Number= '' then EXIT(s+ '0'); { If string does not contain a number }
Result:= Text+ IncrementStringNo(Number);
end;
function StringSumm(CONST s: AnsiString): Cardinal;
VAR i: Integer;
begin
Result:= 0;
for i:= 1 to Length(s) DO
Result:= Result+ Ord(s[i]);
end;
{ Compute the summ of all characters in the string }
function StringSumm(CONST s: String): Cardinal;
VAR i: Integer;
begin
Result:= 0;
for i:= 1 to Length(s) DO
Result:= Result+ Ord(s[i]);
end;
{ Extracts a number from a mixed string. Works only if the number is at the beginning of the string. Example '123xxx' }
function ExtractIntFromStr(const s: string): Integer;
var
RetCode: Integer;
begin
Val(s, Result, RetCode); // RetCode is the extracted no OR position where a failure (non-numeric character) occured
if RetCode > 0
then Val(Copy(s, 1, RetCode - 1), Result, RetCode);
end;
{=============================================================================================================
STRING CONVERSIONS
=============================================================================================================}
function i2s(Value: integer): string;
begin
Result:= IntToStr(Value);
end;
{ As above, but additionally it adds a number of zeros as prefix.
The number of zeros is determine this automaticxally based on the MaxVal.
Example:
i2s('1', 5) -> '1'
i2s('1', 500) -> '001'
}
function i2s(Value, MaxVal: integer): string;
begin
Result:= IntToStr(Value);
Result:= LeadingZerosAuto(Result, MaxVal);
end;
function i2s(Value: Int64): string;
begin
Result:= IntToStr(Value);
end;
{ Converts a number to its ordinal string representation.
Examples: 1='1st', 2='2nd', 3='3rd', 4='4th', 11='11th', 21='21st', 22='22nd'.
Handles special cases for 11th, 12th, 13th which use 'th' suffix. }
function i2sHuman(Value: Int64): string;
VAR
LastTwoDigits, LastDigit: Integer;
begin
LastTwoDigits:= Abs(Value) mod 100;
LastDigit:= Abs(Value) mod 10;
// Special case: 11, 12, 13 always use 'th'
if (LastTwoDigits >= 11) AND (LastTwoDigits <= 13)
then EXIT(IntToStr(Value) + 'th');
case LastDigit of
1 : Result:= IntToStr(Value) + 'st';
2 : Result:= IntToStr(Value) + 'nd';
3 : Result:= IntToStr(Value) + 'rd';
else Result:= IntToStr(Value) + 'th';
end;
end;
function Rectangle2Str(CONST Rect: TRect): string;
begin
Result:= 'Top: '+ IntToStr(Rect.Top)+ ', Left: '+ IntToStr(Rect.Left)+ ', Bottom: '+ IntToStr(Rect.Bottom)+ ', Right: '+ IntToStr(Rect.Right);
end;
{ Converts a real number to string.
HideNulMantisa = True -> This will hide the fractional part (numbers after coma) if it is 0. Example: 3.0 returns '3'
HideNulMantisa = False -> This shows the decimals. Example: 3.0 returns '3.0'
Already exists:
System.SysUtils.FloatToStrF. Example: System.SysUtils.FloatToStrF(x, ffFixed, 7, Decimals);
http://www.delphibasics.co.uk/rtl.asp?name=floattostrf }
function Real2Str(CONST ExtValue: Extended; Decimals: Byte = 1; HideNulMantisa: Boolean= True): string;
VAR ComaPos, i: Integer;
begin
Assert(Decimals > 0, 'You need to specify at least one digit after the comma; otherwise use RoundEx()');
Assert(NOT System.Math.IsNaN(ExtValue), 'Float is NAN!');
Result:= FloatToStrF(ExtValue, ffFixed, 16, Decimals);
ComaPos:= Pos(FormatSettings.DecimalSeparator, Result);
Assert(ComaPos > 1, 'Decimal separator not found!');
Result:= system.COPY(Result, 1, ComaPos+ Decimals);
if HideNulMantisa then
begin
{ Cut 0s from the end }
ComaPos:= Length(Result);
for i:= ComaPos downto 1 DO
if Result[i] <> '0' then
begin
ComaPos:= i;
Break;
end;
if Result[ComaPos]= FormatSettings.DecimalSeparator
then Dec(ComaPos);
Result:= System.COPY(Result, 1, ComaPos);
end;
end;
{ Formats the size of a file from bytes to KB, MB, GB, TB } { Old name was: FormatFileSize }
function FormatBytes(CONST Size: Int64; CONST Decimals: Integer= 1): string;
begin
if Size = 0
then Result:= '0 Bytes' else
if Size< 1024
then Result:= IntToStr(Size)+ ' bytes' else
if (Size>= KB) AND (Size< MB)
then Result:= Real2Str(Size / KB, Decimals)+ ' KB' else
if (Size>= MB) AND (Size< GB)
then Result:= Real2Str(Size / MB, Decimals)+ ' MB' else
if (Size>= GB) AND (Size< TB)
then Result:= Real2Str(Size / GB, Decimals)+ ' GB' else
if (Size>= TB)
then Result:= Real2Str(Size / TB, Decimals)+ ' TB'
else raise Exception.Create('Negative file size!');
end;
{ Same as above but the function will never return values formated in GB range. More exactly instead of 10GB it will return 10240MB }
function FormatBytesMB(CONST Size: Int64; CONST Decimals: Integer= 1): string;
begin
if Size = 0
then Result:= '0 Bytes' else
if Size< 1024
then Result:= IntToStr(Size)+ ' bytes' else
if (Size>= KB) AND (Size< MB)
then Result:= Real2Str(Size / KB, Decimals)+ ' KB' else
Result:= Real2Str(Size / MB, Decimals)+ ' MB';
end;
function FormatNumber(CONST Size: Int64; CONST Decimals: Integer= 1): string; // Ex: 3.7 kilo, 3.7 mega, 3.7 giga
begin
if Size = 0
then Result:= '0' else
if Size< 1000
then Result:= IntToStr(Size) else
if (Size>= 1000) AND (Size< 1000000)
then Result:= Real2Str(Size / 1000, Decimals)+ ' K' else
if (Size>= 1000000) AND (Size< 1000000000)
then Result:= Real2Str(Size / 1000000, Decimals)+ ' M' else
if (Size>= 1000000000) AND (Size< 1000000000000)
then Result:= Real2Str(Size / 1000000000, Decimals)+ ' G' else
if (Size>= 1000000000000)
then Result:= Real2Str(Size / 1000000000000, Decimals)+ ' T'
else RAISE Exception.Create('FormatNumber-Negative file size!');
end;
function BoolToStrYesNo(CONST B: Boolean): string;
begin
if B
then Result := 'Yes'
else Result := 'No';
end;
{============================================================================================================
STRING
============================================================================================================}
{$IFNDEF UNICODE}
function ASCII2ANSI(CONST AText: string): string;
CONST MaxLength = 255;
VAR PText : PChar;
begin
PText:= StrAlloc(MaxLength);
StrPCopy(PText,AText);
OEMToChar(PText, PText); {32Bit}
Result:=StrPas(PText);
StrDispose(PText);
end;
function ANSI2ASCII(CONST AText: string):string;
CONST MaxLength = 255;
VAR PText : PChar;
begin
PText:=StrAlloc(MaxLength);
StrPCopy(PText,AText);
CharToOEM(PText,PText); {32Bit}
Result:=StrPas(PText);
StrDispose(PText);
end;
{$ELSE}
//This is cross platform.
// NEEDS TESTING!
function UnicodeToAnsi(CONST str: UnicodeString; CodePage: Integer): RawByteString;
var
Encoding: TEncoding;
Bytes: TBytes;
begin
Result := '';
if str <> '' then
begin
if CodePage = 0
then CodePage := DefaultSystemCodePage;
// Create the appropriate TEncoding instance for the specified code page
Encoding := TEncoding.GetEncoding(CodePage);
try
// Convert the UnicodeString to bytes using the specified encoding
Bytes := Encoding.GetBytes(str);
// Set the result with the raw bytes and the correct code page
SetString(Result, PAnsiChar(@Bytes[0]), Length(Bytes));
SetCodePage(Result, CodePage, False);
finally
Encoding.Free;
end;
end;
end;
{$ENDIF}
// see: https://stackoverflow.com/questions/39960356/how-to-create-a-procedure-like-setlength-that-also-zeros-the-memory
{
procedure SetLengthZero(VAR X; NewSize: Integer);
begin
SetLength(x, 0); // First we clear up all existing data in X
SetLength(x, NewSize); // Following a call to SetLength, S is guaranteed to reference a unique string or array. All NEW elements are zeroed@
For a short string variable, SetLength simply sets the length-indicator character (the character at S[0]) to the given value. In this case, NewLength must be a value from 0 through 255.
For a long string variable, SetLength reallocates the string referenced by S to the given length. Existing characters in the string are preserved, but the content of newly allocated space is undefined.
For a dynamic array variable, SetLength reallocates the array referenced by S to the given length. Existing elements in the array are preserved and newly allocated space is set to 0 or nil. For multidimensional dynamic arrays, SetLength may take more than one-length parameter (up to the number of array dimensions). Each parameter specifies the number of elements along a particular dimension.
Following a call to SetLength, S is guaranteed to reference a unique string or array -- that is, a string or array with a reference count of one. If there is not enough memory available to reallocate the variable, SetLength raises an EOutOfMemory exception.
end; }
{ Adds the C NULL character at the end of this Pascal string }
function AddNullToStr(CONST Path: string): string;
begin
Result:= '';
if Path = '' then EXIT;
if Path[Length(Path)] <> #0
then Result := Path + #0
else Result := Path;
end;
TYPE { This is declared in System but is not available so I had to redeclare it here }
StrRec = packed record
codePage: Word;
elemSize: Word;
refCnt: Longint;
length: Longint;
end;
{ Returns the length of a given string in bytes, including the size for the string header.
http://stackoverflow.com/questions/10910631/how-to-calculate-actual-memory-used-by-string-variable }
function GetStringRAMSize(CONST s: string): Integer;
begin
Result:= ByteLength(s);
if Result > 0
then Inc(Result, SizeOf(StrRec) + SizeOf(Char));
end;
function GetStringRAMSize(CONST s: AnsiString): Integer;
begin
Result := Length(S) * StringElementSize(S);
if Result > 0
then Inc(Result, SizeOf(StrRec) + StringElementSize(s));
end;
{ Returns the length of a given string in bytes }
function GetStringSize(CONST s: string): Integer;
begin
Result:= SizeOf(Char) * Length(s);
end;
{ Efficiently insert a char into Target every x characters. It processes a 10MB string in under 1 sec (inserting every 5 chars) }
function InsertCharEvery(CONST c: char; CONST Target: string; Every: Integer): string;
VAR
NewLength, Counter, i, iTarget: Integer;
begin
Counter:= 1;
iTarget:= 1;
Assert(Every > 0);
{ Allocate RAM }
NewLength:= Length(Target)+ (Length(Target) DIV Every);
if Length(Target) mod Every = 0 { Make sure the resulted string never ends with CharToInsert }
then Dec(NewLength);
SetLength(Result, NewLength); { Prealocate ram for the resulted string. This will be faster than allocating a new string every time and prevents memory fragmentation }
//Result:= StringOfChar('?', NewLength); // For debugging only!
for i:= 1 to Length(Result) DO
if Counter <= Every
then
begin
Result[i]:= target[iTarget];
Inc(iTarget);
Inc(Counter);
end
else
begin
Counter:= 1;
Result[i]:= c;
end;
end;
{ --- REPLACE --- }
procedure ReplaceChar(VAR s: string; CONST SearchFor, ReplaceWith: Char); { procedure }
VAR i: Integer;
begin
for i:= 1 TO Length(s) DO
if s[I] = SearchFor
then s[i]:= ReplaceWith;
end;
procedure ReplaceChar(VAR s: AnsiString; CONST SearchFor, ReplaceWith: AnsiChar); { procedure }
VAR i: Integer;
begin
for i:= 1 TO Length(s) DO
if s[I] = SearchFor
then s[i]:= ReplaceWith;
end;
function ReplaceCharF(CONST s: string; CONST SearchFor, ReplaceWith: Char): string; { function }
VAR i: Integer;
begin
Result:= s;
for i:= 1 TO Length(Result) DO
if Result[I] = SearchFor
then Result[i]:= ReplaceWith;
end;
{ Replaces text between TagStart and TagEnd with ReplaceWith.
- Start: position to begin searching from
- EliminateTags: if True, removes the tags; if False, keeps them
- LastPos: outputs the position after the replacement (for looping)
- Returns original string if tags not found.
Call repeatedly using LastPos as next Start to replace all occurrences. }
function ReplaceBetween(CONST s, TagStart, TagEnd, ReplaceWith: string; Start: Integer; EliminateTags: Boolean; OUT LastPos: Integer): string;
VAR
iTagStart1, iTagStart2, iTagEndPos: Integer;
sRemaining: string;
begin
LastPos:= -1;
iTagStart1:= Pos(TagStart, s, Start); // Where the TagStart begins
if iTagStart1 < 1 then EXIT(s);
iTagStart2:= iTagStart1 + Length(TagStart) - 1; // Where the TagStart ends
// Search for TagEnd in the remaining text (after TagStart)
sRemaining:= Copy(s, iTagStart2 + 1, High(Integer));
iTagEndPos:= PosInsensitive(TagEnd, sRemaining);
// TagEnd not found - return original string
if iTagEndPos < 1
then EXIT(s);
// Convert relative position to absolute position in original string
iTagEndPos:= iTagEndPos + iTagStart2; // Where the TagEnd begins (absolute)
if EliminateTags
then Result:= Copy(s, 1, iTagStart1 - 1) + ReplaceWith // Exclude TagStart
else Result:= Copy(s, 1, iTagStart2) + ReplaceWith; // Include TagStart
LastPos:= Length(Result);
if EliminateTags
then Result:= Result + Copy(s, iTagEndPos + Length(TagEnd), High(Integer)) // Exclude TagEnd
else Result:= Result + Copy(s, iTagEndPos, High(Integer)); // Include TagEnd
end;
{ Similar to the above function. But does not replace the text.
The function returns where TagStart was found. It stops after the "first found". }
function SearchBetween(CONST s, TagStart, TagEnd: string; Start: Integer = 1): Integer;
var
iTagStart1, iTagStart2: Integer;
begin
Result:= -1;
// Start tag
iTagStart1 := Pos(TagStart, s, Start);
if iTagStart1 > 0 then
begin
iTagStart2 := iTagStart1 + Length(TagStart) - 1;
// End tag
if Pos(TagEnd, s, iTagStart2 + 1) > 0
then Result := iTagStart1;
end;
end;
function ReplaceString(CONST s, SearchFor, ReplaceWith: string): string;
begin
Result:= StringReplace(s, SearchFor, ReplaceWith, [rfReplaceAll, rfIgnoreCase]);
end;
function ReplaceStringAnsi(CONST s, SearchFor, ReplaceWith: AnsiString): AnsiString;
begin
Result:= StringReplace(s, SearchFor, ReplaceWith, [rfReplaceAll, rfIgnoreCase]);
end;
{ --- CLEAN STRING --- }
{ Removes all SPACE characters. The resulted string will get shorter. }
function RemoveSpaces (CONST s: string): string;
begin
result:= ReplaceText(s, ' ', '');
end;
function RemoveSpaces (CONST s: Ansistring): Ansistring;
begin
result:= System.AnsiStrings.StringReplace(s, ' ', '', [rfReplaceAll]);
end;
function RemoveTabs (CONST s: string): string;
begin
Result:= StringReplace(s, Tab, '',[rfReplaceAll]);
end;
function RemoveEnters(CONST s: string): string; { Works both with Linux, Windows and half-enter characters }
begin
Result:= StringReplace(s, #10, '', [rfReplaceAll]);
Result:= StringReplace(Result, #13, '', [rfReplaceAll]);
end;
function RemoveEnters(CONST s: Ansistring): Ansistring; { Works both with Linux, Windows and half-enter characters }
begin
Result:= System.AnsiStrings.StringReplace(s, #10, '', [rfReplaceAll]);
Result:= System.AnsiStrings.StringReplace(Result, #13, '', [rfReplaceAll]);
end;
{ Replaces all line breaks (CRLF, CR, LF) with the specified string.
Handles Windows CRLF, Unix LF, and old Mac CR line endings.
CRLF is replaced as a single unit, not as two separate replacements. }
function ReplaceEnters(CONST s, ReplaceWith: string): string;
begin
// First replace CRLF as a unit, then individual CR and LF
Result:= StringReplace(s, CRLFw, ReplaceWith, [rfReplaceAll]);
Result:= StringReplace(Result, #13, ReplaceWith, [rfReplaceAll]);
Result:= StringReplace(Result, #10, ReplaceWith, [rfReplaceAll]);
end;
{ Cuts the last Enter from a string }
function RemoveLastEnter(CONST s: string): string;
VAR Len, TotalEnters: Integer;
begin
TotalEnters:= 0;
Len:= Length(s);
if Len> 0
then
begin
if CharInSet(s[Len], [CR, LF])
then Inc(TotalEnters);
if (Len-1> 0) AND CharInSet(s[Len-1], [CR, LF])
then Inc(TotalEnters);
if TotalEnters > 0
then Result:= system.COPY(s, 1, Len-TotalEnters)
else Result:= s
end
else
Result:= s;
end;
function RemoveLastEnter(CONST s: AnsiString): AnsiString;
VAR Len, TotalEnters: Integer;
begin
TotalEnters:= 0;
Len:= Length(s);
if Len> 0
then
begin
if CharInSet(s[Len], [CR, LF])
then Inc(TotalEnters);
if (Len-1> 0) AND CharInSet(s[Len-1], [CR, LF])
then Inc(TotalEnters);
if TotalEnters > 0
then Result:= system.COPY(s, 1, Len-TotalEnters)
else Result:= s
end
else
Result:= s;
end;
{ Cuts the last SPACE from a string.
If there are more spaces only the last one is cut. }
function RemoveLastSpace(CONST s: string): string;
VAR Len: Integer;
begin
Len:= Length(s);
if Len > 0
then
if (s[Len]= ' ')
then Result:= system.COPY(s, 1, Len-1)
else Result:= s
else Result:= s;
end;
{ Example: for 'PinkFloydX' it returns 'PinkFloyd' }
function RemoveLastChar(CONST s: string): string;
begin
Result:= system.COPY(s, 1, Length(s)-1);
end;
function RemoveLastChar(CONST s: AnsiString): AnsiString; { ANSI version }
begin
Result:= system.COPY(s, 1, Length(s)-1);