FindNLSStringEx() and next pos

[bk31415 0]

I am trying use OS'es FindNLSStringEx() function with Delphi. I've tried to pascalize it.

 

The attraction is that FindNLSStringEx() handles various case sensitivty scenarios. 

 

The following code compiles, but I haven't tested in real code to see whether it works as desired, because I cannot figure out how I can locate the next (AFomPos) position for ASubText (the substing). 

 

And, without that it is not much use to me.

 

Could someone take a look and show how to do that please.
 

type
  TNLSFindKind = (
    nlsFindFromStart,
    nlsFindFromEnd,
    nlsFindStartsWith,
    nlsFindEndsWith
  );

  TNLSCaseKind = (
    nlsLangIgnoreCase,
    nlsLangIgnoreDiacritic,
    nlsNormIgnoreCase,
    nlsNormIgnoreKanatype,
    nlsNormIgnoreNonspace,
    nlsNormIgnoreSymbols,
    nlsNormIgnoreWidth,
    nlsNormLangCasing
  );

function TextPos(
  ASubText: UnicodeString; 
  AText: UnicodeString; 
  AFindKind: TNLSFindKind; 
  ACaseKind: TNLSCaseKind; 
  ALocale: PChar = nil; 
  AFomPos: Integer = 1
): Integer;
var
  Flags1: DWORD;
  PFoundLen1: PINT;
  Pos1: Integer;
begin
  { Returns the index of the first occurence of ASubText
  in AText, or -1 if the text was not found. }

  Flags1 := 0;
  case AFindKind of
    nlsFindFromStart: Flags1 := Flags1 or FIND_FROMSTART;
    nlsFindFromEnd: Flags1 := Flags1 or FIND_FROMEND;
    nlsFindStartsWith: Flags1 := Flags1 or FIND_STARTSWITH;
    nlsFindEndsWith: Flags1 := Flags1 or FIND_ENDSWITH;
  end;

  case ACaseKind of
    nlsLangIgnoreCase: Flags1 := Flags1 or LINGUISTIC_IGNORECASE;
    nlsLangIgnoreDiacritic: Flags1 := Flags1 or LINGUISTIC_IGNOREDIACRITIC;
    nlsNormIgnoreCase: Flags1 := Flags1 or NORM_IGNORECASE;
    nlsNormIgnoreKanatype: Flags1 := Flags1 or NORM_IGNOREKANATYPE;
    nlsNormIgnoreNonspace: Flags1 := Flags1 or NORM_IGNORENONSPACE;
    nlsNormIgnoreSymbols: Flags1 := Flags1 or NORM_IGNORESYMBOLS;
    nlsNormIgnoreWidth: Flags1 := Flags1 or NORM_IGNOREWIDTH;
    nlsNormLangCasing: Flags1 := Flags1 or NORM_LINGUISTIC_CASING;
  end;

  //SetLastError(0);
  Pos1 := FindNLSStringEx(
    ALocale,
    Flags1,
    PChar(AText),
    Length(AText),
    PChar(ASubText),
    Length(ASubText),
    PFoundLen1,
    nil,
    nil,
    0
  );

  if (Pos1 = -1) then begin
    case GetLastError of
      ERROR_INVALID_FLAGS: raise Exception.Create('Invalid flags');
      ERROR_INVALID_PARAMETER: raise Exception.Create('Invalid parameters');
    end;
    Result := -1;
  end else Result := Pos1;
end;

 

Edited Thursday at 10:55 PM by bk31415
URL for FindNLSStringEx() added.

[Kas Ob. 138]

Few things to know about this API

1) FoundLength is critical to know and adjust to, as the result of found string might be longer or shorter.

2) ACaseKind can/must be none of the above for default behavior and ignoring nothing.

 

Anyway here an example, and as usual the forum sometime corrupt the text, and in this case is more delicate to reserve it as it contain very non popular encoded strings, i suggest to use the files instead of copy from the forum

program FindNLSstring;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  SysUtils,
  Windows,
  Classes;

type
  TNLSFindKind = (nlsFindFromStart, nlsFindFromEnd, nlsFindStartsWith, nlsFindEndsWith);

  TNLSCaseKind = (nlsNotSpecified, nlsLangIgnoreCase, nlsLangIgnoreDiacritic, nlsNormIgnoreCase, nlsNormIgnoreKanatype, nlsNormIgnoreNonspace, nlsNormIgnoreSymbols, nlsNormIgnoreWidth, nlsNormLangCasing);

function TextPos(ASubText: UnicodeString; AText: UnicodeString; ACaseKind: TNLSCaseKind; var FoundLen: Integer; ALocale: PChar = nil; AFromPos: Integer = 1): Integer;
var
  Flags: DWORD;
begin
  Flags := FIND_FROMSTART;
  case ACaseKind of
    nlsLangIgnoreCase: Flags := Flags or LINGUISTIC_IGNORECASE;
    nlsLangIgnoreDiacritic: Flags := Flags or LINGUISTIC_IGNOREDIACRITIC;
    nlsNormIgnoreCase: Flags := Flags or NORM_IGNORECASE;
    nlsNormIgnoreKanatype: Flags := Flags or NORM_IGNOREKANATYPE;
    nlsNormIgnoreNonspace: Flags := Flags or NORM_IGNORENONSPACE;
    nlsNormIgnoreSymbols: Flags := Flags or NORM_IGNORESYMBOLS;
    nlsNormIgnoreWidth: Flags := Flags or NORM_IGNOREWIDTH;
    nlsNormLangCasing: Flags := Flags or NORM_LINGUISTIC_CASING;
    nlsNotSpecified:    // we need this
  end;

  Result := FindNLSStringEx(ALocale, Flags, @AText[AFromPos], Length(AText) - AFromPos, PChar(ASubText), Length(ASubText), @FoundLen, nil, nil, 0);
  if Result >= 0 then
    Inc(Result, AFromPos);  // adjusting the position
end;

const
  SUB_STR_1 = 'Götterdämmerung';
  SUB_STR_2 = 'Götterdämmerung';
  // we can use LOCALE_NAME as empty , the system will use the default for user LOCALE_NAME_USER_DEFAULT
  // LOCALE_NAME_USER_DEFAULT does override LOCALE_NAME_SYSTEM_DEFAULT
  LOCALE_NAME = '';

procedure LoadFileAndSearch(SubString: string);
var
  StringList: TStringList;
  OurLongText: string;
  FoundPos, FoundLen: Integer;
  FoundString:string;
begin
  StringList := TStringList.Create;
  try
    StringList.LoadFromFile('MacOS_ItunesContent_Small.txt');
    OurLongText := StringList.Text;

    FoundPos := 0;
    Writeln('Searching for ', SubString, ' Found :');
    while True do
    begin
      FoundLen := 0;
      FoundPos := TextPos(SubString, OurLongText, nlsNotSpecified, FoundLen, LOCALE_NAME, FoundPos);
      if FoundPos < 0 then
        Break;

      FoundString := Copy(OurLongText,FoundPos,FoundLen);
      Writeln(#9,FoundPos, ' Length : ', FoundLen,'  ',FoundString);

      Inc(FoundPos, FoundLen);
    end;
  finally
    StringList.Free;
  end;
end;

begin
  try
    SetConsoleOutputCP(CP_UTF8);
    // don't know which code page can display the strings in question like it does in a VCL Memo
    // OS supported code pages are listed at registry path HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\CodePage
    //SetConsoleOutputCP(1252);
    LoadFileAndSearch(SUB_STR_1);
    LoadFileAndSearch(SUB_STR_2);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Writeln('Done.');
  Readln;
end.

the needed sample file content, copied form the German forum without permission 

dummy line

Götterdämmerung
Götterdämmerung
Track 4344
Track ID: 11572
Titel: Morgendämmerung und Siegfried's Rheinfahrt aus "Götterdämmerung"
Artist: Richard Wagner
Album: Rheingold
Track-Art: Abgeglichene AAC-Audiodatei
GUID: 
Hinzugefügt: 14.12.2017 17:57:46
Persistent ID: 91453A3B4084EC74
Tracktype: File
Speicherort: Macintosh HD/Users/AlfonsYondraschek/Music/iTunes 1/iTunes Media/Music/Richard Wagner/Rheingold/05 Morgendämmerung und Siegfried's Rheinfahrt aus _Götterdämmerung_.m4a

Track 4345
Track ID: 11574
Titel: Siegfried's Trauermarsch und Finale aus "Götterdämmerung"
Artist: Richard Wagner
Album: Rheingold
Track-Art: Abgeglichene AAC-Audiodatei
GUID: 
Hinzugefügt: 14.12.2017 17:57:46
Persistent ID: 6C45FF4271B8A57B
Tracktype: File
Speicherort: Macintosh HD/Users/AlfonsYondraschek/Music/iTunes 1/iTunes Media/Music/Richard Wagner/Rheingold/06 Siegfried's Trauermarsch und Finale aus _Götterdämmerung_.m4a

the result should be like this

Searching for Götterdämmerung Found :
        15 Length : 15  Götterdämmerung
        32 Length : 17  Götterdämmerung
        135 Length : 15  Götterdämmerung
        488 Length : 17  Götterdämmerung
        591 Length : 15  Götterdämmerung
        936 Length : 17  Götterdämmerung
Searching for Götterdämmerung Found :
        15 Length : 15  Götterdämmerung
        32 Length : 17  Götterdämmerung
        135 Length : 15  Götterdämmerung
        488 Length : 17  Götterdämmerung
        591 Length : 15  Götterdämmerung
        936 Length : 17  Götterdämmerung
Done.

the files

FindNLSstring.dpr

MacOS_ItunesContent_Small.txt

 

Notice the output on my console is like this using CP_UTF8, but pasting in the bowser fixed it,

 

outputting to lets say TMemo will show correct text like notepad or the text in the forum.

 

[bk31415 0]

Aha..

The magic eluding me was this:

 

FindNLSStringEx(ALocale, Flags, @AText[AFromPos], Length(AText) - AFromPos, ...);

 

Thank you.