[gelöst] UTF8IsWild (war: UTF8Decode unter Linux)

[Scotty]

Ich versuche per IsWild() einen Stringvergleich zu machen. So weit ich das sehe, ist diese Funktion nicht gerade Unicode freundlich (pos, copy, length). Probleme gibt es daher mit Sonderzeichen.

Code: Alles auswählen

ShowMessage(BoolToStr(IsWild('HÄ','H?',false),true));
ShowMessage(BoolToStr(IsWild(UTF8Decode('HÄ'),UTF8Decode('H?'),false),true));

Unter Windows kommt false/true, Linux meldet false/false. Was kann ich tun?

[theo]

Naja, wie du schon sagst, ist diese Fkt. nicht für Unicode ausgelegt.
Du könntest den Code für Unicode anpassen oder sowas machen:

Code: Alles auswählen

uses LConvEncoding;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(BoolToStr(IsWild(UTF8ToISO_8859_1('HÄ'),UTF8ToISO_8859_1('H?'),false),true));
end;

Das ist nat. keine allgemeine Lösung und funktioniert für nicht Latin1 Zeichen (Russisch etc.) nicht.

[Scotty]

Hm, kyrillische Zeichen passen wohl nicht auch noch in den Bytebereich. Wäre der Ansatz sinnvoll, eine normale Like()-Funktion von PChar auf PWideChar zu erweitern? Wobei mir auch noch nicht klar ist, ob ein einfacher Typecast PWideChar(SearchPattern) geht. Hast du noch einen Tipp?

[mse]

MSEgui hat eine ähnliche Funktion mit unicodestring Parametern, checkfilename() aus lib/common/kernel/msefileutils.pas.

[theo]

Hm, kyrillische Zeichen passen wohl nicht auch noch in den Bytebereich. Wäre der Ansatz sinnvoll, eine normale Like()-Funktion von PChar auf PWideChar zu erweitern? Wobei mir auch noch nicht klar ist, ob ein einfacher Typecast PWideChar(SearchPattern) geht. Hast du noch einen Tipp?

Du kannst schon auch mit kyrillisch arbeiten, aber dann musst du anders Umwandeln z.B. UTF8ToCP1251. Mischen geht aber nicht, da die Funktion weder für WideString noch für UTF-8 ausgelegt ist.
Die Ganze Geschichte auf WideString zu erweitern wäre also schon das Beste.

[theo]

Ich hab's mal eben versucht. Eigentlich ist es recht einfach, die Fkt. umzuwandeln:

Code: Alles auswählen

function UnicodeFindPart(const HelpWilds, inputStr: UnicodeString): Integer;
var
  i, J: Integer;
  Diff: Integer;
begin
  Result:=0;
  i:=Pos('?',HelpWilds);
  if (i=0) then
    Result:=Pos(HelpWilds, inputStr)
  else
    begin
    Diff:=Length(inputStr) - Length(HelpWilds);
    for i:=0 to Diff do
      begin
      for J:=1 to Length(HelpWilds) do
        if (inputStr[i + J] = HelpWilds[J]) or (HelpWilds[J] = '?') then
          begin
          if (J=Length(HelpWilds)) then
            begin
            Result:=i+1;
            Exit;
            end;
          end
        else
          Break;
      end;
    end;
end;
 
function UnicodeIsWild(inputStr, Wilds: UnicodeString; ignoreCase: Boolean): Boolean;
 
 function SearchNext(var Wilds: UnicodeString): Integer;
 
 begin
   Result:=Pos('*', Wilds);
   if Result>0 then
     Wilds:=Copy(Wilds,1,Result - 1);
 end;
 
var
  CWild, CinputWord: Integer; { counter for positions }
  i, LenHelpWilds: Integer;
  MaxinputWord, MaxWilds: Integer; { Length of inputStr and Wilds }
  HelpWilds: UnicodeString;
begin
  if Wilds = inputStr then begin
    Result:=True;
    Exit;
  end;
  repeat { delete '**', because '**' = '*' }
    i:=Pos('**', Wilds);
    if i > 0 then
      Wilds:=Copy(Wilds, 1, i - 1) + '*' + Copy(Wilds, i + 2, Maxint);
  until i = 0;
  if Wilds = '*' then begin { for fast end, if Wilds only '*' }
    Result:=True;
    Exit;
  end;
  MaxinputWord:=Length(inputStr);
  MaxWilds:=Length(Wilds);
  if ignoreCase then begin { upcase all letters }
    inputStr:=WideUpperCase(inputStr);
    Wilds:=WideUpperCase(Wilds);
  end;
  if (MaxWilds = 0) or (MaxinputWord = 0) then begin
    Result:=False;
    Exit;
  end;
  CinputWord:=1;
  CWild:=1;
  Result:=True;
  repeat
    if inputStr[CinputWord] = Wilds[CWild] then begin { equal letters }
      { goto next letter }
      inc(CWild);
      inc(CinputWord);
      Continue;
    end;
    if Wilds[CWild] = '?' then begin { equal to '?' }
      { goto next letter }
      inc(CWild);
      inc(CinputWord);
      Continue;
    end;
    if Wilds[CWild] = '*' then begin { handling of '*' }
      HelpWilds:=Copy(Wilds, CWild + 1, MaxWilds);
      i:=SearchNext(HelpWilds);
      LenHelpWilds:=Length(HelpWilds);
      if i = 0 then begin
        { no '*' in the rest, compare the ends }
        if HelpWilds = '' then Exit; { '*' is the last letter }
        { check the rest for equal Length and no '?' }
        for i:=0 to LenHelpWilds - 1 do begin
          if (HelpWilds[LenHelpWilds - i] <> inputStr[MaxinputWord - i]) and
            (HelpWilds[LenHelpWilds - i]<> '?') then
          begin
            Result:=False;
            Exit;
          end;
        end;
        Exit;
      end;
      { handle all to the next '*' }
      inc(CWild, 1 + LenHelpWilds);
      i:=UnicodeFindPart(HelpWilds, Copy(inputStr, CinputWord, Maxint));
      if i= 0 then begin
        Result:=False;
        Exit;
      end;
      CinputWord:=i + LenHelpWilds;
      Continue;
    end;
    Result:=False;
    Exit;
  until (CinputWord > MaxinputWord) or (CWild > MaxWilds);
  { no completed evaluation }
  if CinputWord <= MaxinputWord then Result:=False;
  if (CWild <= MaxWilds) and (Wilds[MaxWilds] <> '*') then Result:=False;
end;
 
function UTF8IsWild(inputStr, Wilds: UTF8String; ignoreCase: Boolean): Boolean;
begin
  Result:=UnicodeIsWild(UTF8Decode(inputStr),UTF8Decode(Wilds),ignoreCase);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(BoolToStr(UTF8IsWild('HÄ','H?',false),true));
end;

[Scotty]

Funktioniert einwandfrei, auch mit kyrillischen Zeichen! Vielen Dank

[theo]

Funktioniert einwandfrei, auch mit kyrillischen Zeichen! Vielen Dank

Wenn du ein solches Problem hast, kannst du versuchen, alle String Typen auf UnicodeString zu wechseln.
Dann habe ich nur noch AnsiUpperCase in WideUpperCase geändert und die Fkt. UTF8IsWild ergänzt, welche gleich ein UTF8Decode macht.
Sonst nix.
Es kann schon weitere Probleme geben, aber hier afaics nicht.

[mse]

Es kann schon weitere Probleme geben, aber hier afaics nicht.

Bitte unter Lazarus nicht vergessen die string Konstanten im code explizit von utf-8 auf unicodestring zu wandeln, UnicodeIsWild(thestring,'HÄ*') funktioniert in nicht-utf-8 Systemen (Windows) nicht.

[theo]

Es kann schon weitere Probleme geben, aber hier afaics nicht.

Bitte unter Lazarus nicht vergessen die string Konstanten im code explizit von utf-8 auf unicodestring zu wandeln, UnicodeIsWild(thestring,'HÄ*') funktioniert in nicht-utf-8 Systemen (Windows) nicht.

Dafür habe ich doch die Fkt. UTF8IsWild spendiert.

[mse]

Dafür habe ich doch die Fkt. UTF8IsWild spendiert.

Exakt, und genau die sollte unter Lazarus ausschliesslich verwendet werden.

[Scotty]

In der Funktion kommt es manchmal zu einem Fehler bei führendem *. Ich simuliere Wildcards bei mir jetzt per Regulären Ausdrücken; es besteht also kein unmittelbarer Handlungsbedarf.

[mse]

In der Funktion kommt es manchmal zu einem Fehler bei führendem *.

Funktioniert die MSEgui Funktion auch nicht? filenamety = msestring = UnicodeString, msechar = UnicodeChar.

Code: Alles auswählen

procedure checkmask(s: pmsechar; mask: pmsechar; var result: checkmaskresultty);
var
 po1: pmsechar;
begin
 while true do begin
  if s^ = #0 then begin
   if mask^ = #0 then begin
    result:= cmr_correctfinished;
    break;
   end;
  end;
  case mask^ of
   '*': begin
    po1:= mask + 1;
    if po1^ = #0 then begin
     result:= cmr_correctfinished;
     break;
    end;
    while true do begin
     checkmask(s,po1,result);
     if (result = cmr_correctfinished) or (s^ = #0) then begin
      break;
     end;
     inc(s);
     result:= cmr_correct;
    end;
    break;
   end;
   '?': begin
    if s^ = #0 then begin
     result:= cmr_wrongfinished;
     break;
    end;
    inc(s);
    inc(mask);
   end;
   #0: begin
    result:= cmr_wrongfinished;
    break;
   end;
   else begin
    if s^ = mask^ then begin
     inc(s);
     inc(mask);
     continue;
    end
    else begin
     result:= cmr_wrong;
     break;
    end;
   end;
  end;
 end;
end;
 
function internalcheckfilename(const filename,mask: filenamety): boolean;
var
 checkresult: checkmaskresultty;
begin
 checkresult:= cmr_correct;
 checkmask(pmsechar(filename),pmsechar(mask),checkresult);
 result:= checkresult = cmr_correctfinished;
end;
 
function checkfilename(const filename,mask: filenamety;
                 casesensitive: boolean = false): boolean;
          //'*' and '?' are possible maskchars
var
 str1,str2: msestring;
begin
 if casesensitive then begin
  result:= internalcheckfilename(filename,mask);
 end
 else begin
  str1:= mseuppercase(filename);
  str2:= mseuppercase(mask);
  result:= internalcheckfilename(str1,str2);
 end;
end;

Der Highlighter hat ein wenig Mühe....