{ This file is part of the Free Pascal run time library. Copyright (c) 1999-2000 by Carl-Eric Codere, member of the Free Pascal development team. See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} {$ifndef FPC_UNIT_HAS_STREND} Function StrEnd(P: PChar): PChar; var counter: SizeInt; begin counter := 0; while P[counter] <> #0 do Inc(counter); StrEnd := @(P[Counter]); end; {$endif FPC_UNIT_HAS_STREND} {$ifndef FPC_UNIT_HAS_STRCOPY} { Beware, the naive implementation (copying bytes forward until zero is encountered) will end up in undefined behavior if source and dest happen to overlap. So do it in a bit more reliable way. Also this implementation should not need per-platform optimization, given that IndexByte and Move are optimized. } Function StrCopy(Dest, Source:PChar): PChar; var counter : SizeInt; Begin counter := IndexByte(Source^,-1,0); { counter+1 will move zero terminator } Move(Source^,Dest^,counter+1); StrCopy := Dest; end; {$endif FPC_UNIT_HAS_STRCOPY} {$ifndef FPC_UNIT_HAS_STRUPPER} function StrUpper(P: PChar): PChar; var counter: SizeInt; begin counter := 0; while (P[counter] <> #0) do begin if P[Counter] in [#97..#122,#128..#255] then P[counter] := Upcase(P[counter]); Inc(counter); end; StrUpper := P; end; {$endif FPC_UNIT_HAS_STRUPPER} {$ifndef FPC_UNIT_HAS_STRLOWER} function StrLower(P: PChar): PChar; var counter: SizeInt; begin counter := 0; while (P[counter] <> #0) do begin if P[counter] in [#65..#90] then P[Counter] := chr(ord(P[Counter]) + 32); Inc(counter); end; StrLower := P; end; {$endif FPC_UNIT_HAS_STRLOWER} {$ifndef FPC_UNIT_HAS_STRSCAN} function StrScan(P: PChar; C: Char): PChar; Var count: SizeInt; Begin count := 0; { As in Borland Pascal , if looking for NULL return null } if C = #0 then begin StrScan := @(P[StrLen(P)]); exit; end; { Find first matching character of Ch in Str } while P[count] <> #0 do begin if C = P[count] then begin StrScan := @(P[count]); exit; end; Inc(count); end; { nothing found. } StrScan := nil; end; {$endif FPC_UNIT_HAS_STRSCAN} {$ifndef FPC_UNIT_HAS_STRISCAN} function StrIScan(P: PChar; C: Char): PChar; Var count: SizeInt; UC: Char; Begin UC := upcase(C); count := 0; { As in Borland Pascal , if looking for NULL return null } if UC = #0 then begin StrIScan := @(P[StrLen(P)]); exit; end; { Find first matching character of Ch in Str } while P[count] <> #0 do begin if UC = upcase(P[count]) then begin StrIScan := @(P[count]); exit; end; Inc(count); end; { nothing found. } StrIScan := nil; end; {$endif FPC_UNIT_HAS_STRSCAN} {$ifndef FPC_UNIT_HAS_STRRSCAN} function StrRScan(P: PChar; C: Char): PChar; Var count: SizeInt; index: SizeInt; Begin count := Strlen(P); { As in Borland Pascal , if looking for NULL return null } if C = #0 then begin StrRScan := @(P[count]); exit; end; Dec(count); for index := count downto 0 do begin if C = P[index] then begin StrRScan := @(P[index]); exit; end; end; { nothing found. } StrRScan := nil; end; {$endif FPC_UNIT_HAS_STRRSCAN} {$ifndef FPC_UNIT_HAS_STRRISCAN} function StrRIScan(P: PChar; C: Char): PChar; Var count: SizeInt; index: SizeInt; UC: Char; Begin UC := upcase(C); count := Strlen(P); { As in Borland Pascal , if looking for NULL return null } if UC = #0 then begin StrRIScan := @(P[count]); exit; end; Dec(count); for index := count downto 0 do begin if UC = upcase(P[index]) then begin StrRIScan := @(P[index]); exit; end; end; { nothing found. } StrRIScan := nil; end; {$endif FPC_UNIT_HAS_STRRSCAN} {$ifndef FPC_UNIT_HAS_STRECOPY} Function StrECopy(Dest, Source: PChar): PChar; { Equivalent to the following: } { strcopy(Dest,Source); } { StrECopy := StrEnd(Dest); } var counter : SizeInt; Begin counter := IndexByte(Source^,-1,0); { counter+1 will move zero terminator } Move(Source^,Dest^,counter+1); StrECopy := Dest+counter; end; {$endif FPC_UNIT_HAS_STRECOPY} {$ifndef FPC_UNIT_HAS_STRLCOPY} Function StrLCopy(Dest,Source: PChar; MaxLen: SizeInt): PChar; var counter: SizeInt; Begin counter := 0; { To be compatible with BP, on a null string, put two nulls } If Source[0] = #0 then Begin Dest[0]:=Source[0]; Inc(counter); end; while (Source[counter] <> #0) and (counter < MaxLen) do Begin Dest[counter] := char(Source[counter]); Inc(counter); end; { terminate the string } Dest[counter] := #0; StrLCopy := Dest; end; {$endif FPC_UNIT_HAS_STRLCOPY} {$ifndef FPC_UNIT_HAS_STRCOMP} function StrComp(Str1, Str2 : PChar): SizeInt; var counter: SizeInt; Begin counter := 0; While str1[counter] = str2[counter] do Begin if (str2[counter] = #0) or (str1[counter] = #0) then break; Inc(counter); end; StrComp := ord(str1[counter]) - ord(str2[counter]); end; {$endif FPC_UNIT_HAS_STRCOMP} {$ifndef FPC_UNIT_HAS_STRICOMP} function StrIComp(Str1, Str2 : PChar): SizeInt; var counter: SizeInt; c1, c2: char; Begin counter := 0; c1 := upcase(str1[counter]); c2 := upcase(str2[counter]); While c1 = c2 do Begin if (c1 = #0) or (c2 = #0) then break; Inc(counter); c1 := upcase(str1[counter]); c2 := upcase(str2[counter]); end; StrIComp := ord(c1) - ord(c2); end; {$endif FPC_UNIT_HAS_STRICOMP} {$ifndef FPC_UNIT_HAS_STRLCOMP} function StrLComp(Str1, Str2 : PChar; L: SizeInt): SizeInt; var counter: SizeInt; c1, c2: char; Begin counter := 0; if L = 0 then begin StrLComp := 0; exit; end; Repeat c1 := str1[counter]; c2 := str2[counter]; if (c1 = #0) or (c2 = #0) then break; Inc(counter); Until (c1 <> c2) or (counter >= L); StrLComp := ord(c1) - ord(c2); end; {$endif FPC_UNIT_HAS_STRLCOMP} {$ifndef FPC_UNIT_HAS_STRLICOMP} function StrLIComp(Str1, Str2 : PChar; L: SizeInt): SizeInt; var counter: SizeInt; c1, c2: char; Begin counter := 0; if L = 0 then begin StrLIComp := 0; exit; end; Repeat c1 := upcase(str1[counter]); c2 := upcase(str2[counter]); if (c1 = #0) or (c2 = #0) then break; Inc(counter); Until (c1 <> c2) or (counter >= L); StrLIComp := ord(c1) - ord(c2); end; {$endif FPC_UNIT_HAS_STRLICOMP}