delphidelphi-2010

case insensitive Pos


Is there any comparable function like Pos that is not case-sensitive in D2010 (unicode)?

I know I can use Pos(AnsiUpperCase(FindString), AnsiUpperCase(SourceString)) but that adds a lot of processing time by converting the strings to uppercase every time the function is called.

For example, on a 1000000 loop, Pos takes 78ms while converting to uppercase takes 764ms.

str1 := 'dfkfkL%&/s"#<.676505';
  for i := 0 to 1000000 do
    PosEx('#<.', str1, 1); // Takes 78ms

  for i := 0 to 1000000 do
    PosEx(AnsiUpperCase('#<.'), AnsiUpperCase(str1), 1); // Takes 764ms

I know that to improve the performance of this specific example I can convert the strings to uppercase first before the loop, but the reason why I'm looking to have a Pos-like function that is not case-sensitive is to replace one from FastStrings. All the strings I'll be using Pos for will be different so I will need to convert each and every one to uppercase.

Is there any other function that might be faster than Pos + convert the strings to uppercase?


Solution

  • This version of my previous answer works in both D2007 and D2010.

    The reason is Char size. In the older version of Delphi my original code only supported the current locale character set at initialization. My InsensPosEx is about 4 times faster than your code. Certainly it is possible to go even faster, but we would lose simplicity.

    type
      TCharUpCaseTable = array [Char] of Char;
    
    var
      CharUpCaseTable: TCharUpCaseTable;
    
    procedure InitCharUpCaseTable(var Table: TCharUpCaseTable);
    var
      n: cardinal;
    begin
      for n := 0 to Length(Table) - 1 do
        Table[Char(n)] := Char(n);
      CharUpperBuff(@Table, Length(Table));
    end;
    
    function InsensPosEx(const SubStr, S: string; Offset: Integer = 1): Integer;
    var
      n:            Integer;
      SubStrLength: Integer;
      SLength:      Integer;
    label
      Fail;
    begin
      Result := 0;
      if S = '' then Exit;
      if Offset <= 0 then Exit;
    
      SubStrLength := Length(SubStr);
      SLength := Length(s);
    
      if SubStrLength > SLength then Exit;
    
      Result := Offset;
      while SubStrLength <= (SLength-Result+1) do 
      begin
        for n := 1 to SubStrLength do
          if CharUpCaseTable[SubStr[n]] <> CharUpCaseTable[s[Result+n-1]] then
            goto Fail;
          Exit;
    Fail:
        Inc(Result);
      end;
      Result := 0;
    end;
    
    //...
    
    initialization
      InitCharUpCaseTable({var}CharUpCaseTable);