mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 06:28:04 +02:00
278 lines
6.9 KiB
PHP
278 lines
6.9 KiB
PHP
{
|
|
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: PAnsiChar): PAnsiChar;
|
|
begin
|
|
StrEnd := P;
|
|
if Assigned(StrEnd) then
|
|
Inc(StrEnd, IndexByte(StrEnd^, -1, 0));
|
|
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:PAnsiChar): PAnsiChar;
|
|
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: PAnsiChar): PAnsiChar;
|
|
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: PAnsiChar): PAnsiChar;
|
|
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: PAnsiChar; C: AnsiChar): PAnsiChar;
|
|
Begin
|
|
dec(P);
|
|
repeat
|
|
inc(P);
|
|
until (P^ = #0) or (P^ = C);
|
|
if (P^ = #0) and (C <> #0) then
|
|
P := nil;
|
|
StrScan := P;
|
|
end;
|
|
{$endif FPC_UNIT_HAS_STRSCAN}
|
|
|
|
|
|
{$ifndef FPC_UNIT_HAS_STRISCAN}
|
|
function StrIScan(P: PAnsiChar; C: AnsiChar): PAnsiChar;
|
|
Var
|
|
count: SizeInt;
|
|
UC: AnsiChar;
|
|
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: PAnsiChar; C: AnsiChar): PAnsiChar;
|
|
Begin
|
|
StrRScan := P + IndexByte(P^, -1, 0);
|
|
{ As in Borland Pascal , if looking for NULL return null }
|
|
if C = #0 then
|
|
exit;
|
|
while (StrRScan <> P) and (StrRScan[-1] <> C) do
|
|
dec(StrRScan);
|
|
if StrRScan = P then
|
|
StrRScan := nil
|
|
else
|
|
dec(StrRScan);
|
|
end;
|
|
{$endif FPC_UNIT_HAS_STRRSCAN}
|
|
|
|
|
|
{$ifndef FPC_UNIT_HAS_STRRISCAN}
|
|
function StrRIScan(P: PAnsiChar; C: AnsiChar): PAnsiChar;
|
|
Var
|
|
count: SizeInt;
|
|
index: SizeInt;
|
|
UC: AnsiChar;
|
|
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: PAnsiChar): PAnsiChar;
|
|
{ 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: PAnsiChar; MaxLen: SizeInt): PAnsiChar;
|
|
var
|
|
nmove: SizeInt;
|
|
Begin
|
|
{ To be compatible with BP, on a null string, put two nulls }
|
|
If Source[0] = #0 then
|
|
unaligned(PUint16(Dest)^):=0
|
|
else
|
|
begin
|
|
if MaxLen < 0 then MaxLen := 0; { Paranoia. }
|
|
nmove := IndexByte(Source^,MaxLen,0) + 1;
|
|
if nmove = 0 then
|
|
begin
|
|
nmove := MaxLen;
|
|
Dest[MaxLen] := #0;
|
|
end;
|
|
Move(Source^,Dest^,nmove);
|
|
end;
|
|
StrLCopy := Dest;
|
|
end;
|
|
{$endif FPC_UNIT_HAS_STRLCOPY}
|
|
|
|
|
|
{$ifndef FPC_UNIT_HAS_STRCOMP}
|
|
function StrComp(Str1, Str2 : PAnsiChar): SizeInt;
|
|
var
|
|
counter: SizeInt;
|
|
sample: char;
|
|
Begin
|
|
counter := -1;
|
|
repeat
|
|
inc(counter);
|
|
sample := str1[counter];
|
|
until (sample = #0) or (sample <> str2[counter]);
|
|
StrComp := ord(sample) - ord(str2[counter]);
|
|
end;
|
|
{$endif FPC_UNIT_HAS_STRCOMP}
|
|
|
|
|
|
{$ifndef FPC_UNIT_HAS_STRICOMP}
|
|
function StrIComp(Str1, Str2 : PAnsiChar): SizeInt;
|
|
Begin
|
|
dec(Str1);
|
|
dec(Str2);
|
|
repeat
|
|
inc(Str1);
|
|
inc(Str2);
|
|
StrIComp := ord(Str1^) - ord(Str2^);
|
|
if Str1^ = #0 then break;
|
|
if StrIComp = 0 then continue;
|
|
StrIComp := ord(UpCase(Str1^)) - ord(UpCase(Str2^));
|
|
if StrIComp <> 0 then break; { Making it the loop condition might be suboptimal because of “continue”. }
|
|
until false;
|
|
end;
|
|
{$endif FPC_UNIT_HAS_STRICOMP}
|
|
|
|
|
|
{$ifndef FPC_UNIT_HAS_STRLCOMP}
|
|
function StrLComp(Str1, Str2 : PAnsiChar; L: SizeInt): SizeInt;
|
|
Begin
|
|
while (L > 0) and (Str1^ <> #0) and (Str1^ = Str2^) do
|
|
begin
|
|
inc(Str1);
|
|
inc(Str2);
|
|
dec(L);
|
|
end;
|
|
if L <= 0 then StrLComp := 0 else StrLComp := ord(Str1^) - ord(Str2^);
|
|
end;
|
|
{$endif FPC_UNIT_HAS_STRLCOMP}
|
|
|
|
|
|
{$ifndef FPC_UNIT_HAS_STRLICOMP}
|
|
function StrLIComp(Str1, Str2 : PAnsiChar; L: SizeInt): SizeInt;
|
|
Begin
|
|
dec(Str1);
|
|
dec(Str2);
|
|
inc(L);
|
|
StrLIComp := 0;
|
|
Repeat
|
|
dec(L);
|
|
if L <= 0 then break;
|
|
inc(Str1);
|
|
inc(Str2);
|
|
StrLIComp := ord(Str1^) - ord(Str2^);
|
|
if Str1^ = #0 then break;
|
|
if StrLIComp = 0 then continue;
|
|
StrLIComp := ord(UpCase(Str1^)) - ord(UpCase(Str2^));
|
|
if StrLIComp <> 0 then break; { Making it the loop condition might be suboptimal because of “continue”. }
|
|
until false;
|
|
end;
|
|
{$endif FPC_UNIT_HAS_STRLICOMP}
|