unit SearchStrUnit;

interface

uses
  Windows, Messages, SysUtils;

type
TIntArray = array[1..2000] of integer;

function HowManyWords(const str,substr:string):Integer;
function SearchPos(const str,substr:string;var PosArray:TIntArray):integer;
function SearchNextPos(const str,substr:string;InitPos:integer):Integer;
function SearchRevNextPos(const str,substr:string;InitPos:integer):Integer;
function SearchNormalCharsPos(const str:string;
                              var Start,Lngth:TIntArray):integer;

implementation

function HowManyWords(const str,substr:string):Integer;
var
  PStr,PSubStr:PChar;
  s:string;
  L:integer;
begin
  result := 0;
  L := Length(substr);
  s  := str+StringOfChar(#0,L);
  PStr := PChar(s);
  PSubStr := PChar(substr);
  while byte(PStr^) <> 0 do begin
    if AnsiStrLComp(PStr,PSubStr,L)=0 then begin
      Inc(result);
      Inc(PStr,L);
    end else if Char(PStr^) in LeadBytes then
      Inc(PStr,2)
    else
      Inc(PStr);
  end;
end;

function SearchPos(const str,substr:string;var PosArray:TIntArray):integer;
var
  PStr,PSubStr:PChar;
  s:string;
  L,Indx:integer;
begin
  result := 0;
  Indx := 0;
  L := Length(substr);
  s := str+StringOfChar(#0,L);
  PStr := PChar(s);
  PSubStr := PChar(substr);
  while byte(PStr^) <> 0 do begin
    if AnsiStrLComp(PStr,PSubStr,L)=0 then begin
      Inc(result);
      PosArray[result] := Indx;
      Inc(PStr,L);Inc(Indx,L);
    end else if (Char(PStr^) in LeadBytes) then begin
      Inc(PStr,2);Inc(Indx,2);
    end else begin
      Inc(PStr); Inc(Indx);
    end;
  end;
end;

function SearchNextPos(const str,substr:string;InitPos:integer):Integer;
var
  PStr,PSubStr:PChar;
  s:string;
  L,Indx:integer;
begin
  L := Length(substr);
  s := str+StringOfChar(#0,L);
  PStr := PChar(s);
  PSubStr := PChar(substr);

  Inc(PStr,InitPos);Indx := InitPos;
  result := -1;
  repeat
    if AnsiStrLComp(PStr,PSubStr,L)=0 then begin
      result := Indx;
      Break;
    end else if (Char(PStr^) in LeadBytes) then begin
      Inc(PStr,2);Inc(Indx,2);
    end else begin
      Inc(PStr); Inc(Indx);
    end;
  until byte(PStr^) = 0;
end;

function SearchRevNextPos(const str,substr:string;InitPos:integer):Integer;
var
  PStr,PSubStr:PChar;
  s:string;
  L,Indx:integer;
begin
  result := -1;
  Indx := 0;
  L := Length(substr);
  s := str+StringOfChar(#0,L);
  PStr := PChar(s);
  PSubStr := PChar(substr);
  while (byte(PStr^) <> 0) and (Indx < InitPos+1) do begin
    if AnsiStrLComp(PStr,PSubStr,L)=0 then begin
      result := Indx;
      Inc(PStr,L);Inc(Indx,L);
    end else if (Char(PStr^) in LeadBytes) then begin
      Inc(PStr,2);Inc(Indx,2);
    end else begin
      Inc(PStr); Inc(Indx);
    end;
  end;
end;

function IsNormalChar(const c:Char):Boolean;
begin
  result := Ord(c) in [Ord('!')..Ord('~')];
end;

function SearchNormalCharsPos(const str:string;
                              var Start,Lngth:TIntArray):integer;
var
  PStr:PChar;
  Indx,St:integer;
begin
  result := 0;
  Indx := 0;
  St := -1;
  PStr := PChar(str);
  while byte(PStr^) <> 0 do begin
    if (Char(PStr^) in LeadBytes)  then begin
      if St <> -1 then begin
        Inc(result);
        Start[result] := St;
        Lngth[result] := Indx-St;
        St := -1;
      end;
      Inc(PStr,2);Inc(Indx,2);
    end else begin
      if IsNormalChar(Char(PStr^)) then begin
        if (St = -1) then St := Indx;
        Inc(PStr); Inc(Indx);
      end else
        if St <> -1 then begin
          Inc(result);
          Start[result] := St;
          Lngth[result] := Indx-St;
          St := -1;
        end else begin
          Inc(PStr); Inc(Indx);
        end;
    end;
  end;
  if St <> -1 then begin
    Inc(result);
    Start[result] := St;
    Lngth[result] := Indx-St;
  end
end;

end.