[fpc-devel] Addition for StrUtils unit: PosSetEx

[Marco van de Voort]

> I needed a function to find the first position where one of a set of
> characters matches in a string. Alike C function 'strpbrk' if you know it.
> 
> Example:
> 
> PosSetEx('abcde', 'hello', 1);
> 
> Returns 2, because the 'e' is in second position. If no occurance, 0 is
> returned (like Pos). The last parameter is the position from where to start
> searching (assumes >= 1). PosSet(A,B) can be made by calling PosSetEx
> (A,B,1);

> function PosSetEx(const ASubStrSet, AString: string;
>   const Offset: integer): integer;
> begin
>   for Result := Offset to Length(AString) do
>     if Pos(AString[Result], ASubStrSet) > 0 then
>       exit;
>   Result := 0;
> end;

Bad for large asubstrsets. And why use a string for a set?

I had this lying in my old libs (casing still betrays modula-2 origins :-)

FUNCTION PosSetEx (CONST C:CHARSET;CONST S : AnsiString;Count:LONGINT ):LONGINT;

VAR I,J:LONGINT;

BEGIN
 IF PCHAR(S)=NIL THEN
  J:=0
 ELSE
  BEGIN
   I:=Length(S);
   J:=Count;
   IF J>I THEN
    BEGIN
     Result:=0;
     EXIT;
    END;
   WHILE (j<=i) AND (NOT (S[J] IN C)) DO INC(J);
   IF (J>I) THEN
    J:=0;                                         // NOT found.
  END;
 Result:=J;
END;

FUNCTION PosSet (CONST C:CHARSET;CONST S : AnsiString ):LONGINT;

BEGIN
  result:=PosSetEx(c,s,1);
END;

FUNCTION PosSetEx (CONST C:string;CONST S : AnsiString;Count:LONGINT ):LONGINT;

var cset : CHARSET;
    i    : integer;
BEGIN
  CSET:=[];
  if Length(C)>0 Then
  for i:=1 to Length(c) do
    include(cset,c[i]);
  result:=PosSetEx(CSet,S,Count);
END;

FUNCTION PosSet (CONST C:String;CONST S : AnsiString ):LONGINT;

var cset : CHARSET;
    i    : integer;
BEGIN
  CSET:=[];
  if Length(C)>0 Then
  for i:=1 to Length(c) do
    include(cset,c[i]);
  result:=PosSetEx(CSet,S,1);
END;