mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 09:02:22 +01:00 
			
		
		
		
	+ Added some RxStrUtils functions for Rx compatibility
This commit is contained in:
		
							parent
							
								
									e9f1e6f0d3
								
							
						
					
					
						commit
						072f6e4ec6
					
				@ -124,6 +124,52 @@ type
 | 
			
		||||
Const
 | 
			
		||||
  AnsiResemblesProc: TCompareTextProc = @SoundexProc;
 | 
			
		||||
 | 
			
		||||
{ ---------------------------------------------------------------------
 | 
			
		||||
    Other functions, based on RxStrUtils.
 | 
			
		||||
  ---------------------------------------------------------------------}
 | 
			
		||||
  
 | 
			
		||||
function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
 | 
			
		||||
function DelSpace(const S: string): string;
 | 
			
		||||
function DelChars(const S: string; Chr: Char): string;
 | 
			
		||||
function DelSpace1(const S: string): string;
 | 
			
		||||
function Tab2Space(const S: string; Numb: Byte): string;
 | 
			
		||||
function NPos(const C: string; S: string; N: Integer): Integer;
 | 
			
		||||
function AddChar(C: Char; const S: string; N: Integer): string;
 | 
			
		||||
function AddCharR(C: Char; const S: string; N: Integer): string;
 | 
			
		||||
function PadLeft(const S: string; N: Integer): string;
 | 
			
		||||
function PadRight(const S: string; N: Integer): string;
 | 
			
		||||
function PadCenter(const S: string; Len: Integer): string;
 | 
			
		||||
function Copy2Symb(const S: string; Symb: Char): string;
 | 
			
		||||
function Copy2SymbDel(var S: string; Symb: Char): string;
 | 
			
		||||
function Copy2Space(const S: string): string;
 | 
			
		||||
function Copy2SpaceDel(var S: string): string;
 | 
			
		||||
function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
 | 
			
		||||
function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
 | 
			
		||||
function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
 | 
			
		||||
function ExtractWord(N: Integer; const S: string;  const WordDelims: TSysCharSet): string;
 | 
			
		||||
function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string;
 | 
			
		||||
function ExtractDelimited(N: Integer; const S: string;  const Delims: TSysCharSet): string;
 | 
			
		||||
function ExtractSubstr(const S: string; var Pos: Integer;  const Delims: TSysCharSet): string;
 | 
			
		||||
function IsWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
 | 
			
		||||
function FindPart(const HelpWilds, InputStr: string): Integer;
 | 
			
		||||
function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
 | 
			
		||||
function XorString(const Key, Src: ShortString): ShortString;
 | 
			
		||||
function XorEncode(const Key, Source: string): string;
 | 
			
		||||
function XorDecode(const Key, Source: string): string;
 | 
			
		||||
function GetCmdLineArg(const Switch: string; SwitchChars: TSysCharSet): string;
 | 
			
		||||
function Numb2USA(const S: string): string;
 | 
			
		||||
function Hex2Dec(const S: string): Longint;
 | 
			
		||||
function Dec2Numb(N: Longint; Len, Base: Byte): string;
 | 
			
		||||
function Numb2Dec(S: string; Base: Byte): Longint;
 | 
			
		||||
function IntToBin(Value: Longint; Digits, Spaces: Integer): string;
 | 
			
		||||
function IntToRoman(Value: Longint): string;
 | 
			
		||||
function RomanToInt(const S: string): Longint;
 | 
			
		||||
 | 
			
		||||
const
 | 
			
		||||
  DigitChars = ['0'..'9'];
 | 
			
		||||
  Brackets = ['(',')','[',']','{','}'];
 | 
			
		||||
  StdWordDelims = [#0..' ',',','.',';','/','\',':','''','"','`'] + Brackets;
 | 
			
		||||
 | 
			
		||||
implementation
 | 
			
		||||
 | 
			
		||||
{ ---------------------------------------------------------------------
 | 
			
		||||
@ -684,11 +730,685 @@ begin
 | 
			
		||||
  NotYetImplemented(' SoundexProc');
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
{ ---------------------------------------------------------------------
 | 
			
		||||
    RxStrUtils-like functions.
 | 
			
		||||
  ---------------------------------------------------------------------}
 | 
			
		||||
  
 | 
			
		||||
 | 
			
		||||
function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  i,l: Integer;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  l:=Length(S);
 | 
			
		||||
  i:=1;
 | 
			
		||||
  Result:=True;
 | 
			
		||||
  while Result and (i<=l) do 
 | 
			
		||||
    begin
 | 
			
		||||
    Result:=Not (S[i] in EmptyChars);
 | 
			
		||||
    Inc(i);
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function DelSpace(const S: String): string;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  Result:=DelChars(S,' ');
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function DelChars(const S: string; Chr: Char): string;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  I,J: Integer;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  Result:=S;
 | 
			
		||||
  I:=Length(Result);
 | 
			
		||||
  While I>0 do
 | 
			
		||||
    begin
 | 
			
		||||
    if Result[I]=Chr then 
 | 
			
		||||
      begin
 | 
			
		||||
      J:=I-1;
 | 
			
		||||
      While (J>0) and (Result[J]=Chr) do
 | 
			
		||||
        Dec(j);
 | 
			
		||||
      Delete(Result,J+1,I-J);
 | 
			
		||||
      I:=J+1;
 | 
			
		||||
      end;
 | 
			
		||||
    dec(I);
 | 
			
		||||
    end;  
 | 
			
		||||
end;      
 | 
			
		||||
 | 
			
		||||
function DelSpace1(const S: string): string;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  i: Integer;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  Result:=S;
 | 
			
		||||
  for i:=Length(Result) downto 2 do 
 | 
			
		||||
    if (Result[i]=' ') and (Result[I-1]=' ') then
 | 
			
		||||
      Delete(Result,I,1);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function Tab2Space(const S: string; Numb: Byte): string;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  I: Integer;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  I:=1;
 | 
			
		||||
  Result:=S;
 | 
			
		||||
  while I <= Length(Result) do 
 | 
			
		||||
    if Result[I]<>Chr(9) then 
 | 
			
		||||
      inc(I)
 | 
			
		||||
    else  
 | 
			
		||||
      begin
 | 
			
		||||
      Result[I]:=' ';
 | 
			
		||||
      If (Numb>1) then
 | 
			
		||||
        Insert(StringOfChar('0',Numb-1),Result,I);
 | 
			
		||||
      Inc(I,Numb);
 | 
			
		||||
      end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function NPos(const C: string; S: string; N: Integer): Integer;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  i,p,k: Integer;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  Result:=0;
 | 
			
		||||
  if N<1 then
 | 
			
		||||
    Exit;
 | 
			
		||||
  k:=0;
 | 
			
		||||
  i:=1;
 | 
			
		||||
  Repeat 
 | 
			
		||||
    p:=pos(C,S);
 | 
			
		||||
    Inc(k,p);
 | 
			
		||||
    if p>0 then 
 | 
			
		||||
      delete(S,1,p);
 | 
			
		||||
    Inc(i);
 | 
			
		||||
  Until (i>n) or (p=0);  
 | 
			
		||||
  If (P>0) then
 | 
			
		||||
    Result:=K; 
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function AddChar(C: Char; const S: string; N: Integer): string;
 | 
			
		||||
 | 
			
		||||
Var
 | 
			
		||||
  l : Integer;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  Result:=S;
 | 
			
		||||
  l:=Length(Result);
 | 
			
		||||
  if l<N then
 | 
			
		||||
    Result:=StringOfChar(C,N-l)+Result;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function AddCharR(C: Char; const S: string; N: Integer): string;
 | 
			
		||||
 | 
			
		||||
Var
 | 
			
		||||
  l : Integer;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  Result:=S;
 | 
			
		||||
  l:=Length(Result);
 | 
			
		||||
  if l<N then
 | 
			
		||||
    Result:=Result+StringOfChar(C,N-l);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function PadRight(const S: string; N: Integer): string;
 | 
			
		||||
begin
 | 
			
		||||
  Result:=AddCharR(' ',S,N);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function PadLeft(const S: string; N: Integer): string;
 | 
			
		||||
begin
 | 
			
		||||
  Result:=AddChar(' ',S,N);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function Copy2Symb(const S: string; Symb: Char): string;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  p: Integer;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  p:=Pos(Symb,S);
 | 
			
		||||
  if p=0 then 
 | 
			
		||||
    p:=Length(S)+1;
 | 
			
		||||
  Result:=Copy(S,1,p-1);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function Copy2SymbDel(var S: string; Symb: Char): string;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  Result:=Copy2Symb(S,Symb);
 | 
			
		||||
  S:=TrimRight(Copy(S,Length(Result)+1,Length(S)));
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function Copy2Space(const S: string): string;
 | 
			
		||||
begin
 | 
			
		||||
  Result:=Copy2Symb(S,' ');
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function Copy2SpaceDel(var S: string): string;
 | 
			
		||||
begin
 | 
			
		||||
  Result:=Copy2SymbDel(S,' ');
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  l :  Integer;
 | 
			
		||||
  P,PE : PChar;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  Result:=AnsiLowerCase(S);
 | 
			
		||||
  P:=PChar(Result);
 | 
			
		||||
  PE:=P+Length(Result);
 | 
			
		||||
  while (P<PE) do
 | 
			
		||||
    begin
 | 
			
		||||
    while (P<PE) and (P^ in WordDelims) do
 | 
			
		||||
      inc(P);
 | 
			
		||||
    if (P<PE) then
 | 
			
		||||
      P^:=UpCase(P^);
 | 
			
		||||
    while (P<PE) and not (P^ in WordDelims) do
 | 
			
		||||
      inc(P);
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
                                                    
 | 
			
		||||
function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  P,PE : PChar;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  Result:=0;
 | 
			
		||||
  P:=Pchar(S);
 | 
			
		||||
  PE:=P+Length(S);
 | 
			
		||||
  while (P<PE) do
 | 
			
		||||
    begin
 | 
			
		||||
    while (P<PE) and (P^ in WordDelims) do
 | 
			
		||||
      Inc(P);
 | 
			
		||||
    if (P<PE) then
 | 
			
		||||
      inc(Result);
 | 
			
		||||
    while (P<PE) and not (P^ in WordDelims) do
 | 
			
		||||
      inc(P);
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
                                                  
 | 
			
		||||
function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  PS,P,PE : PChar;
 | 
			
		||||
  Count: Integer;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  Result:=0;
 | 
			
		||||
  Count:=0;
 | 
			
		||||
  PS:=PChar(S);
 | 
			
		||||
  PE:=PS+Length(S);
 | 
			
		||||
  P:=PS;
 | 
			
		||||
  while (P<PE) and (Count<>N) do
 | 
			
		||||
    begin
 | 
			
		||||
    while (P<PE) and (P^ in WordDelims) do
 | 
			
		||||
      inc(P);
 | 
			
		||||
    if (P<PE) then
 | 
			
		||||
      inc(Count);
 | 
			
		||||
    if (Count<>N) then
 | 
			
		||||
      while (P<PE) and not (P^ in WordDelims) do
 | 
			
		||||
        inc(P)
 | 
			
		||||
    else
 | 
			
		||||
      Result:=(P-PS)+1;
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  i: Integer;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  Result:=ExtractWordPos(N,S,WordDelims,i);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string;
 | 
			
		||||
var
 | 
			
		||||
  i,j,l: Integer;
 | 
			
		||||
begin
 | 
			
		||||
  j:=0;
 | 
			
		||||
  i:=WordPosition(N, S, WordDelims);
 | 
			
		||||
  Pos:=i;
 | 
			
		||||
  if (i<>0) then
 | 
			
		||||
    begin
 | 
			
		||||
    j:=i;
 | 
			
		||||
    l:=Length(S);
 | 
			
		||||
    while (j<=L) and not (S[j] in WordDelims) do 
 | 
			
		||||
      inc(j);
 | 
			
		||||
    end;  
 | 
			
		||||
  SetLength(Result,j-i);
 | 
			
		||||
  If ((j-i)>0) then
 | 
			
		||||
    Move(S[i],Result[1],j-i);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function ExtractDelimited(N: Integer; const S: string; const Delims: TSysCharSet): string;
 | 
			
		||||
var
 | 
			
		||||
  w,i,l,len: Integer;
 | 
			
		||||
begin
 | 
			
		||||
  w:=0;
 | 
			
		||||
  i:=1;
 | 
			
		||||
  l:=0;
 | 
			
		||||
  len:=Length(S);
 | 
			
		||||
  SetLength(Result, 0);
 | 
			
		||||
  while (i<=len) and (w<>N) do 
 | 
			
		||||
    begin
 | 
			
		||||
    if s[i] in Delims then 
 | 
			
		||||
      inc(w)
 | 
			
		||||
    else 
 | 
			
		||||
      begin
 | 
			
		||||
      if (N-1)=w then 
 | 
			
		||||
        begin
 | 
			
		||||
        inc(l);
 | 
			
		||||
        SetLength(Result,l);
 | 
			
		||||
        Result[Len]:=S[i];
 | 
			
		||||
        end;
 | 
			
		||||
      end;
 | 
			
		||||
    inc(i);
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function ExtractSubstr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  i,l: Integer;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  i:=Pos;
 | 
			
		||||
  l:=Length(S);
 | 
			
		||||
  while (i<=l) and not (S[i] in Delims) do 
 | 
			
		||||
    inc(i);
 | 
			
		||||
  Result:=Copy(S,Pos,i-Pos);
 | 
			
		||||
  if (i<=l) and (S[i] in Delims) then 
 | 
			
		||||
    inc(i);
 | 
			
		||||
  Pos:=i;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function isWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  i,Count : Integer;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  Result:=False;
 | 
			
		||||
  Count:=WordCount(S, WordDelims);
 | 
			
		||||
  I:=1;
 | 
			
		||||
  While (Not Result) and (I<=Count) do
 | 
			
		||||
    Result:=ExtractWord(i,S,WordDelims)=W;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
function Numb2USA(const S: string): string;
 | 
			
		||||
var
 | 
			
		||||
  i, NA: Integer;
 | 
			
		||||
begin
 | 
			
		||||
  i:=Length(S);
 | 
			
		||||
  Result:=S;
 | 
			
		||||
  NA:=0;
 | 
			
		||||
  while (i > 0) do begin
 | 
			
		||||
    if ((Length(Result) - i + 1 - NA) mod 3 = 0) and (i <> 1) then
 | 
			
		||||
    begin
 | 
			
		||||
      insert(',', Result, i);
 | 
			
		||||
      inc(NA);
 | 
			
		||||
    end;
 | 
			
		||||
    Dec(i);
 | 
			
		||||
  end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function PadCenter(const S: string; Len: Integer): string;
 | 
			
		||||
begin
 | 
			
		||||
  if Length(S)<Len then 
 | 
			
		||||
    begin
 | 
			
		||||
    Result:=StringOfChar(' ',(Len div 2) -(Length(S) div 2))+S;
 | 
			
		||||
    Result:=Result+StringOfChar(' ',Len-Length(Result));
 | 
			
		||||
    end
 | 
			
		||||
  else 
 | 
			
		||||
    Result:=S;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function Hex2Dec(const S: string): Longint;
 | 
			
		||||
var
 | 
			
		||||
  HexStr: string;
 | 
			
		||||
begin
 | 
			
		||||
  if Pos('$',S)=0 then 
 | 
			
		||||
    HexStr:='$'+ S
 | 
			
		||||
  else 
 | 
			
		||||
    HexStr:=S;
 | 
			
		||||
  Result:=StrTointDef(HexStr,0);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function Dec2Numb(N: Longint; Len, Base: Byte): string;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  C: Integer;
 | 
			
		||||
  Number: Longint;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  if N=0 then 
 | 
			
		||||
    Result:='0'
 | 
			
		||||
  else 
 | 
			
		||||
    begin
 | 
			
		||||
    Number:=N;
 | 
			
		||||
    Result:='';
 | 
			
		||||
    while Number>0 do 
 | 
			
		||||
      begin
 | 
			
		||||
      C:=Number mod Base;
 | 
			
		||||
      if C>9 then 
 | 
			
		||||
        C:=C+55
 | 
			
		||||
      else 
 | 
			
		||||
        C:=C+48;
 | 
			
		||||
      Result:=Chr(C)+Result;
 | 
			
		||||
      Number:=Number div Base;
 | 
			
		||||
      end;
 | 
			
		||||
    end;
 | 
			
		||||
  if (Result<>'') then 
 | 
			
		||||
    Result:=AddChar('0',Result,Len);
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function Numb2Dec(S: string; Base: Byte): Longint;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  i, P: Longint;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  i:=Length(S);
 | 
			
		||||
  Result:=0;
 | 
			
		||||
  S:=UpperCase(S);
 | 
			
		||||
  P:=1;
 | 
			
		||||
  while (i>=1) do 
 | 
			
		||||
    begin
 | 
			
		||||
    if (S[i]>'@') then 
 | 
			
		||||
      Result:=Result+(Ord(S[i])-55)*P
 | 
			
		||||
    else 
 | 
			
		||||
      Result:=Result+(Ord(S[i])-48)*P;
 | 
			
		||||
    Dec(i);
 | 
			
		||||
    P:=P*Base;
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function RomanToint(const S: string): Longint;
 | 
			
		||||
 | 
			
		||||
const
 | 
			
		||||
  RomanChars  = ['C','D','i','L','M','V','X'];
 | 
			
		||||
  RomanValues : array['C'..'X'] of Word 
 | 
			
		||||
              = (100,500,0,0,0,0,1,0,0,50,1000,0,0,0,0,0,0,0,0,5,0,10);
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  index, Next: Char;
 | 
			
		||||
  i,l: Integer;
 | 
			
		||||
  Negative: Boolean;
 | 
			
		||||
 | 
			
		||||
begin
 | 
			
		||||
  Result:=0;
 | 
			
		||||
  i:=0;
 | 
			
		||||
  Negative:=(Length(S)>0) and (S[1]='-');
 | 
			
		||||
  if Negative then 
 | 
			
		||||
    inc(i);
 | 
			
		||||
  l:=Length(S);  
 | 
			
		||||
  while (i<l) do 
 | 
			
		||||
    begin
 | 
			
		||||
    inc(i);
 | 
			
		||||
    index:=UpCase(S[i]);
 | 
			
		||||
    if index in RomanChars then 
 | 
			
		||||
      begin
 | 
			
		||||
      if Succ(i)<=l then 
 | 
			
		||||
        Next:=UpCase(S[i+1])
 | 
			
		||||
      else 
 | 
			
		||||
        Next:=#0;
 | 
			
		||||
      if (Next in RomanChars) and (RomanValues[index]<RomanValues[Next]) then
 | 
			
		||||
        begin
 | 
			
		||||
        inc(Result, RomanValues[Next]);
 | 
			
		||||
        Dec(Result, RomanValues[index]);
 | 
			
		||||
        inc(i);
 | 
			
		||||
        end
 | 
			
		||||
      else 
 | 
			
		||||
        inc(Result, RomanValues[index]);
 | 
			
		||||
      end
 | 
			
		||||
    else 
 | 
			
		||||
      begin
 | 
			
		||||
      Result:=0;
 | 
			
		||||
      Exit;
 | 
			
		||||
      end;
 | 
			
		||||
    end;
 | 
			
		||||
  if Negative then 
 | 
			
		||||
    Result:=-Result;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function intToRoman(Value: Longint): string;
 | 
			
		||||
 | 
			
		||||
const
 | 
			
		||||
  Arabics : Array[1..13] of Integer 
 | 
			
		||||
          = (1,4,5,9,10,40,50,90,100,400,500,900,1000);
 | 
			
		||||
  Romans  :  Array[1..13] of String 
 | 
			
		||||
          = ('i','iV','V','iX','X','XL','L','XC','C','CD','D','CM','M');
 | 
			
		||||
          
 | 
			
		||||
var
 | 
			
		||||
  i: Integer;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  for i:=13 downto 1 do
 | 
			
		||||
    while (Value >= Arabics[i]) do 
 | 
			
		||||
      begin
 | 
			
		||||
      Value:=Value-Arabics[i];
 | 
			
		||||
      Result:=Result+Romans[i];
 | 
			
		||||
      end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function intToBin(Value: Longint; Digits, Spaces: Integer): string;
 | 
			
		||||
begin
 | 
			
		||||
  Result:='';
 | 
			
		||||
  if (Digits>32) then 
 | 
			
		||||
    Digits:=32;
 | 
			
		||||
  while (Digits>0) do 
 | 
			
		||||
    begin
 | 
			
		||||
    if (Digits mod Spaces)=0 then 
 | 
			
		||||
      Result:=Result+' ';
 | 
			
		||||
    Dec(Digits);
 | 
			
		||||
    Result:=Result+intToStr((Value shr Digits) and 1);
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function FindPart(const HelpWilds, inputStr: string): Integer;
 | 
			
		||||
var
 | 
			
		||||
  i, J: Integer;
 | 
			
		||||
  Diff: Integer;
 | 
			
		||||
begin
 | 
			
		||||
  Result:=0;
 | 
			
		||||
  i:=Pos('?',HelpWilds);
 | 
			
		||||
  if (i=0) then 
 | 
			
		||||
    Result:=Pos(HelpWilds, inputStr)
 | 
			
		||||
  else
 | 
			
		||||
    begin  
 | 
			
		||||
    Diff:=Length(inputStr) - Length(HelpWilds);
 | 
			
		||||
    for i:=0 to Diff do 
 | 
			
		||||
      begin
 | 
			
		||||
      for J:=1 to Length(HelpWilds) do 
 | 
			
		||||
        if (inputStr[i + J] = HelpWilds[J]) or (HelpWilds[J] = '?') then
 | 
			
		||||
          begin
 | 
			
		||||
          if (J=Length(HelpWilds)) then 
 | 
			
		||||
            begin
 | 
			
		||||
            Result:=i+1;
 | 
			
		||||
            Exit;
 | 
			
		||||
            end;
 | 
			
		||||
          end
 | 
			
		||||
        else 
 | 
			
		||||
          Break;
 | 
			
		||||
      end;    
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function isWild(inputStr, Wilds: string; ignoreCase: Boolean): Boolean;
 | 
			
		||||
 | 
			
		||||
 function SearchNext(var Wilds: string): Integer;
 | 
			
		||||
 | 
			
		||||
 begin
 | 
			
		||||
   Result:=Pos('*', Wilds);
 | 
			
		||||
   if Result>0 then 
 | 
			
		||||
     Wilds:=Copy(Wilds,1,Result - 1);
 | 
			
		||||
 end;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  CWild, CinputWord: Integer; { counter for positions }
 | 
			
		||||
  i, LenHelpWilds: Integer;
 | 
			
		||||
  MaxinputWord, MaxWilds: Integer; { Length of inputStr and Wilds }
 | 
			
		||||
  HelpWilds: string;
 | 
			
		||||
begin
 | 
			
		||||
  if Wilds = inputStr then begin
 | 
			
		||||
    Result:=True;
 | 
			
		||||
    Exit;
 | 
			
		||||
  end;
 | 
			
		||||
  repeat { delete '**', because '**' = '*' }
 | 
			
		||||
    i:=Pos('**', Wilds);
 | 
			
		||||
    if i > 0 then
 | 
			
		||||
      Wilds:=Copy(Wilds, 1, i - 1) + '*' + Copy(Wilds, i + 2, Maxint);
 | 
			
		||||
  until i = 0;
 | 
			
		||||
  if Wilds = '*' then begin { for fast end, if Wilds only '*' }
 | 
			
		||||
    Result:=True;
 | 
			
		||||
    Exit;
 | 
			
		||||
  end;
 | 
			
		||||
  MaxinputWord:=Length(inputStr);
 | 
			
		||||
  MaxWilds:=Length(Wilds);
 | 
			
		||||
  if ignoreCase then begin { upcase all letters }
 | 
			
		||||
    inputStr:=AnsiUpperCase(inputStr);
 | 
			
		||||
    Wilds:=AnsiUpperCase(Wilds);
 | 
			
		||||
  end;
 | 
			
		||||
  if (MaxWilds = 0) or (MaxinputWord = 0) then begin
 | 
			
		||||
    Result:=False;
 | 
			
		||||
    Exit;
 | 
			
		||||
  end;
 | 
			
		||||
  CinputWord:=1;
 | 
			
		||||
  CWild:=1;
 | 
			
		||||
  Result:=True;
 | 
			
		||||
  repeat
 | 
			
		||||
    if inputStr[CinputWord] = Wilds[CWild] then begin { equal letters }
 | 
			
		||||
      { goto next letter }
 | 
			
		||||
      inc(CWild);
 | 
			
		||||
      inc(CinputWord);
 | 
			
		||||
      Continue;
 | 
			
		||||
    end;
 | 
			
		||||
    if Wilds[CWild] = '?' then begin { equal to '?' }
 | 
			
		||||
      { goto next letter }
 | 
			
		||||
      inc(CWild);
 | 
			
		||||
      inc(CinputWord);
 | 
			
		||||
      Continue;
 | 
			
		||||
    end;
 | 
			
		||||
    if Wilds[CWild] = '*' then begin { handling of '*' }
 | 
			
		||||
      HelpWilds:=Copy(Wilds, CWild + 1, MaxWilds);
 | 
			
		||||
      i:=SearchNext(HelpWilds);
 | 
			
		||||
      LenHelpWilds:=Length(HelpWilds);
 | 
			
		||||
      if i = 0 then begin
 | 
			
		||||
        { no '*' in the rest, compare the ends }
 | 
			
		||||
        if HelpWilds = '' then Exit; { '*' is the last letter }
 | 
			
		||||
        { check the rest for equal Length and no '?' }
 | 
			
		||||
        for i:=0 to LenHelpWilds - 1 do begin
 | 
			
		||||
          if (HelpWilds[LenHelpWilds - i] <> inputStr[MaxinputWord - i]) and
 | 
			
		||||
            (HelpWilds[LenHelpWilds - i]<> '?') then
 | 
			
		||||
          begin
 | 
			
		||||
            Result:=False;
 | 
			
		||||
            Exit;
 | 
			
		||||
          end;
 | 
			
		||||
        end;
 | 
			
		||||
        Exit;
 | 
			
		||||
      end;
 | 
			
		||||
      { handle all to the next '*' }
 | 
			
		||||
      inc(CWild, 1 + LenHelpWilds);
 | 
			
		||||
      i:=FindPart(HelpWilds, Copy(inputStr, CinputWord, Maxint));
 | 
			
		||||
      if i= 0 then begin
 | 
			
		||||
        Result:=False;
 | 
			
		||||
        Exit;
 | 
			
		||||
      end;
 | 
			
		||||
      CinputWord:=i + LenHelpWilds;
 | 
			
		||||
      Continue;
 | 
			
		||||
    end;
 | 
			
		||||
    Result:=False;
 | 
			
		||||
    Exit;
 | 
			
		||||
  until (CinputWord > MaxinputWord) or (CWild > MaxWilds);
 | 
			
		||||
  { no completed evaluation }
 | 
			
		||||
  if CinputWord <= MaxinputWord then Result:=False;
 | 
			
		||||
  if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then Result:=False;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function XorString(const Key, Src: ShortString): ShortString;
 | 
			
		||||
var
 | 
			
		||||
  i: Integer;
 | 
			
		||||
begin
 | 
			
		||||
  Result:=Src;
 | 
			
		||||
  if Length(Key) > 0 then
 | 
			
		||||
    for i:=1 to Length(Src) do
 | 
			
		||||
      Result[i]:=Chr(Byte(Key[1 + ((i - 1) mod Length(Key))]) xor Ord(Src[i]));
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function XorEncode(const Key, Source: string): string;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
  i: Integer;
 | 
			
		||||
  C: Byte;
 | 
			
		||||
  
 | 
			
		||||
begin
 | 
			
		||||
  Result:='';
 | 
			
		||||
  for i:=1 to Length(Source) do 
 | 
			
		||||
    begin
 | 
			
		||||
    if Length(Key) > 0 then
 | 
			
		||||
      C:=Byte(Key[1 + ((i - 1) mod Length(Key))]) xor Byte(Source[i])
 | 
			
		||||
    else
 | 
			
		||||
      C:=Byte(Source[i]);
 | 
			
		||||
    Result:=Result+AnsiLowerCase(intToHex(C, 2));
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function XorDecode(const Key, Source: string): string;
 | 
			
		||||
var
 | 
			
		||||
  i: Integer;
 | 
			
		||||
  C: Char;
 | 
			
		||||
begin
 | 
			
		||||
  Result:='';
 | 
			
		||||
  for i:=0 to Length(Source) div 2 - 1 do 
 | 
			
		||||
    begin
 | 
			
		||||
    C:=Chr(StrTointDef('$' + Copy(Source, (i * 2) + 1, 2), Ord(' ')));
 | 
			
		||||
    if Length(Key) > 0 then
 | 
			
		||||
      C:=Chr(Byte(Key[1 + (i mod Length(Key))]) xor Byte(C));
 | 
			
		||||
    Result:=Result + C;
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
function GetCmdLineArg(const Switch: string; SwitchChars: TSysCharSet): string;
 | 
			
		||||
var
 | 
			
		||||
  i: Integer;
 | 
			
		||||
  S: string;
 | 
			
		||||
begin
 | 
			
		||||
  i:=1;
 | 
			
		||||
  Result:='';
 | 
			
		||||
  while (Result='') and (i<=ParamCount) do 
 | 
			
		||||
    begin
 | 
			
		||||
    S:=ParamStr(i);
 | 
			
		||||
    if (SwitchChars=[]) or ((S[1] in SwitchChars) and (Length(S) > 1)) and
 | 
			
		||||
       (AnsiCompareText(Copy(S,2,Length(S)-1),Switch)=0) then 
 | 
			
		||||
      begin
 | 
			
		||||
      inc(i);
 | 
			
		||||
      if i<=ParamCount then 
 | 
			
		||||
        Result:=ParamStr(i);
 | 
			
		||||
      end;
 | 
			
		||||
    inc(i);
 | 
			
		||||
    end;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
end.
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
  $Log$
 | 
			
		||||
  Revision 1.7  2004-07-01 15:42:18  peter
 | 
			
		||||
  Revision 1.8  2004-07-13 18:42:39  michael
 | 
			
		||||
  + Added some RxStrUtils functions for Rx compatibility
 | 
			
		||||
 | 
			
		||||
  Revision 1.7  2004/07/01 15:42:18  peter
 | 
			
		||||
    * fix 1.0.x compile
 | 
			
		||||
 | 
			
		||||
  Revision 1.6  2004/06/29 19:37:17  marco
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user