* added striscan, strriscan and stripos

git-svn-id: trunk@13019 -

rtl/inc/genstr.inc

@@ -84,7 +84,6 @@
    Var
      count: SizeInt;
   Begin
-
    count := 0;
    { As in Borland Pascal , if looking for NULL return null }
    if C = #0 then
@@ -108,6 +107,35 @@
 {$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;
@@ -137,6 +165,36 @@
 {$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:                                          }

rtl/inc/strings.pp

@@ -51,9 +51,12 @@ interface
     { The same as strcomp, but at most l characters are compared  }
     function strlcomp(str1,str2 : pchar;l : SizeInt) : SizeInt;
 
-    { The same as strcomp but case insensitive       }
+    { The same as strcomp but case insensitive }
     function stricomp(str1,str2 : pchar) : SizeInt;
 
+    { The same as stricomp, but at most l characters are compared }
+    function strlicomp(str1,str2 : pchar;l : SizeInt) : SizeInt;
+
     { Copies l characters from source to dest, returns dest. }
     function strmove(dest,source : pchar;l : SizeInt) : pchar;
 
@@ -64,30 +67,36 @@ interface
     { If c doesn't occur, nil is returned }
     function strscan(p : pchar;c : char) : pchar;
 
+    { The same as strscan but case insensitive }
+    function striscan(p : pchar;c : char) : pchar;
+
     { Returns a pointer to the last occurrence of c in p }
     { If c doesn't occur, nil is returned }
     function strrscan(p : pchar;c : char) : pchar;
 
-    { converts p to all-lowercase, returns p   }
+    { The same as strrscan but case insensitive }
+    function strriscan(p : pchar;c : char) : pchar;
+
+    { converts p to all-lowercase, returns p }
     function strlower(p : pchar) : pchar;
 
-    { converts p to all-uppercase, returns p  }
+    { converts p to all-uppercase, returns p }
     function strupper(p : pchar) : pchar;
 
-    { The same al stricomp, but at most l characters are compared }
-    function strlicomp(str1,str2 : pchar;l : SizeInt) : SizeInt;
-
-    { Returns a pointer to the first occurrence of str2 in    }
-    { str1 Otherwise returns nil                          }
+    { Returns a pointer to the first occurrence of str2 in }
+    { str1 Otherwise returns nil }
     function strpos(str1,str2 : pchar) : pchar;
 
+    { The same as strpos but case insensitive       }
+    function stripos(str1,str2 : pchar) : pchar;
+
     { Makes a copy of p on the heap, and returns a pointer to this copy  }
     function strnew(p : pchar) : pchar;
 
     { Allocates L bytes on the heap, returns a pchar pointer to it }
     function stralloc(L : SizeInt) : pchar;
 
-    { Releases a null-terminated string from the heap  }
+    { Releases a null-terminated string from the heap }
     procedure strdispose(p : pchar);
 
 implementation

rtl/inc/stringsi.inc

@@ -65,3 +65,26 @@
            end;
       end;
 
+    function stripos(str1,str2 : pchar) : pchar;
+      var
+         p : pchar;
+         lstr2 : SizeInt;
+      begin
+         stripos:=nil;
+         if (str1 = nil) or (str2 = nil) then
+           exit;
+         p:=striscan(str1,str2^);
+         if p=nil then
+           exit;
+         lstr2:=strlen(str2);
+         while p<>nil do
+           begin
+              if strlicomp(p,str2,lstr2)=0 then
+                begin
+                   stripos:=p;
+                   exit;
+                end;
+              inc(p);
+              p:=striscan(p,str2^);
+           end;
+      end;