mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 10:48:30 +02:00
326 lines
7.3 KiB
PHP
326 lines
7.3 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: PChar): PChar;
|
|
var
|
|
counter: SizeInt;
|
|
begin
|
|
counter := 0;
|
|
if not Assigned(P) then
|
|
StrEnd:=Nil
|
|
else
|
|
begin
|
|
while P[counter] <> #0 do
|
|
Inc(counter);
|
|
StrEnd := @(P[Counter]);
|
|
end;
|
|
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}
|
|
|