CompareWildString...

[himitsu]

Moin allerseits,

/me hatte in der letzten Zeit ein paar Funktion zusammengebastelt.

Und so wie es aussieht scheinen die jetzt endlich zu funktionieren ... jedenfalls stürzt mein Programm, worin ich die verwende, nicht ab, oder funktioniert nicht wie gewollt

Allerding konnte ich sie noch nicht richtig durchtesten (ist ein bissl schwer, wenn man nur selten sein Delphi sieht)

's wäre also nett, wenn sich jemand dat mal ansehen könnte, oder vielleicht mal ein paar Teststrings für mich findet.

Die Funktionen selber sind eigentlich recht einfach ... sie vergleichen halt 2 Strings, wobei im Ersten (Wild) auch Platzhalter (* und ?) verwendet werden können, außerdem können diese Platzhalter auch maskiert werden ("\*", "\?" und natürlich "\\"), so daß man auch mal nach diesen suchen kann (nur wenn diese Funktionalität aktiviert ist).

z.B.
CompareWildString('a\*b', S, [cfCanMask]) ist nur TRUE, wenn S = 'a*b' Diese Funktionen stehen zur Verfügung:

Delphi-Quellcode:

Function CompareWildString(Wild, Name: String; Flags: TCompareFlags = []): Boolean;
Function CompareWildText(Const Wild, Name: String; Flags: TCompareFlags = []): Boolean;
Function CompareWildFileName(Wild, FileName: String; Flags: TCompareFlags = []): Boolean;

• CompareWildString:
  mögliche Flags = cfIgnoreCase, cfCanMask, cfCaseSensitive
  - cfCaseSensitive hat Vorrang vor cfIgnoreCase
• CompareWildText:
  mögliche Flags = cfCanMask, cfCaseSensitive
  entspricht CompareWildString, außer das cfIgnoreCase immer gesetzt ist
• CompareWildFileName:
  mögliche Flags = cfCanMask, cfCaseSensitive, cfRequireFileName, cfRequireFileExt, cfNoMaskOverDir
  - cfIgnoreCase ist immer gesetzt (Windowsstandard) und kann mit cfCaseSensitive deaktiviert werden
  cfRequireFileName =
  cfRequireFileExt =
  cfNoMaskOverDir = "*" und "?" vergleichen nicht über "\" hinweg, also "dir\*\file" gibt kein TRUE zurück wenn z.B. Name = "dir\dir2\dir3\file"

Delphi-Quellcode:

Function CompareWildStringEx(Wild, Name: String; Flags: TCompareFlags = []): TStringArray;
Function CompareWildFileNameEx(Wild, FileName: String; Flags: TCompareFlags = []): TStringArray;

• CompareWildStringEx und CompareWildFileNameEx:
  sind eigentlich äquivalent zu den obrigen Funktionen, außer, daß hier kein BOOLEAN zurückgelievert wird, sondern ein StringArray.
  Wobei CompareWildString = TRUE einem CompareWildStringEx <> nil entspricht, es wird also IMMER mindestens ein String im Array stehen, sobald der Vergleich TRUE ergeben würde.
  
  Bei einem erfogreichem Vergleich wird dann in dem Array für jede WildGruppe (aufeinanderfolgende * und ?) ein String zurückgeliefert.
  "a?*ef" liefert also nur ein Array zurück, wenn zwischen "a" und "ef" mindestens ein Zeichen ist, wobei dann im ersten String die Zeichen zwischen den beiden "a" und "ef" stehen.
  
  
  Code:

  [u][b]Wild[/b][/u]          [u][b]Name[/b][/u]           [u][b]Result[/b][/u]     [u][b]Result[/b][/u]
  "ABCDEF"      "ABCDEF"       <> nil     ('')
  "A?*EF"       "AEF"          = nil      ()
  "A?*EF"       "AbcdEF"       <> nil     ('cd')
  "A?*EF*H"     "AbcdEFgH"     <> nil     ('cd', 'g')

Ach ja, im Gegensatz zu der CompareWildString in der CodeLib, sind/sollten diese Funktionen auch voll kompatiebel zu LongStrings sein,
denn die in der CodeLib stehende basiert auf 'nen PChar und bricht beim Auffinden einer #0 ab, aber in LongStrings dürfen #0-en vorkommen, außerdem würde dort z.B. bei ('abc', 'abc'#0'def') TRUE zurückgeliefert, obwohl die Strings ja definitiv nicht gleich sind

Delphi-Quellcode:

  Type TCompareFlags = Set of (cfIgnoreCase, cfCanMask, cfCaseSensitive,
      cfRequireFileName, cfRequireFileExt, cfNoMaskOverDir); 

  Function CompareWildString(Wild, Name: String; Flags: TCompareFlags = []): Boolean;
    Var W, N, We, Ne, WildW, WildN: PChar;

    Label goWild, goElse;

    Begin
      If (cfIgnoreCase in Flags) and not (cfCaseSensitive in Flags) Then Begin
        Wild := AnsiLowerCase(Wild);
        Name := AnsiLowerCase(Name);
      End;
      Result := False;
      W := PChar(Wild);  We := W + Length(Wild);  WildW := nil;
      N := PChar(Name);  Ne := N + Length(Name);  WildN := nil;
      While True do Begin
        Case W^ of
          '*': Begin
            While W^ = '*' do Inc(W);
            WildW := W;
            WildN := N + 1;
            Continue;

            goWild:
            W := WildW;
            N := WildN;
            Inc(WildN);
            If (W = nil) or (N > Ne) Then Exit;
            Continue;
          End;
          '?': If N >= Ne Then GoTo goWild;
          '\': Begin
            If (cfCanMask in Flags) and ((W + 1)^ in ['*', '?', '\']) Then Inc(W);
            GoTo goElse;
          End;
          Else
            goElse:
            If Char(N^) <> Char(W^) Then GoTo goWild;
        End;
        If (W = We) and (N = Ne) Then Break;
        If (W >= We) or (N >= Ne) Then GoTo goWild;
        Inc(W);
        Inc(N);
      End;
      Result := True;
    End;

  Function CompareWildText(Const Wild, Name: String; Flags: TCompareFlags = []): Boolean;
    Begin  Result := CompareWildString(Wild, Name, Flags + [cfIgnoreCase]);  End;

  Function CompareWildFileName(Wild, FileName: String; Flags: TCompareFlags = []): Boolean;
    Var W, N: Integer;

    Begin
      Wild := StringReplace(Wild, '/', '\', [rfReplaceAll]);
      FileName := StringReplace(FileName, '/', '\', [rfReplaceAll]);
      Result := False;
      If (cfRequireFileName in Flags) and (ExtractFileName(FileName) = '') Then Exit;
      If (cfRequireFileExt in Flags) and (Length(ExtractFileExt(FileName)) <= 1) Then Exit;
      If cfNoMaskOverDir in Flags Then Begin
        W := Pos('\', Wild);
        N := Pos('\', FileName);
        While (W > 0) and (N > 0) do Begin
          If not CompareWildString(Copy(Wild, 1, W - 1), Copy(FileName, 1, N - 1), Flags + [cfIgnoreCase]) Then Exit;
          Delete(Wild, 1, W);
          Delete(FileName, 1, N);
          W := Pos('\', Wild);
          N := Pos('\', FileName);
        End;
        If (W > 0) or (N > 0) Then Exit;
      End;
      Result := CompareWildString(ChangeFileExt(Wild, ''), ChangeFileExt(FileName, ''), Flags + [cfIgnoreCase])
        and CompareWildString(Copy(ExtractFileExt(Wild), 2, MaxPos), Copy(ExtractFileExt(FileName), 2, MaxPos), Flags + [cfIgnoreCase]);
    End;

  Function CompareWildStringEx(Wild, Name: String; Flags: TCompareFlags = []): TStringArray;
    Var W, N, We, Ne, WildW, WildN: PChar;
      WildLA, WildLS, i: Integer;
      isWild: Boolean;

    Label goWild, goElse;

    Begin
      If (cfIgnoreCase in Flags) and not (cfCaseSensitive in Flags) Then Begin
        Wild := AnsiLowerCase(Wild);
        Name := AnsiLowerCase(Name);
      End;
      Result := nil;
      WildLA := 0;  WildLS := 0;
      isWild := False;
      W := PChar(Wild);  We := W + Length(Wild);  WildW := nil;
      N := PChar(Name);  Ne := N + Length(Name);  WildN := nil;
      While True do Begin
        Case W^ of
          '*': Begin
            While W^ = '*' do Inc(W);
            WildW := W;
            WildN := N + 1;
            If not isWild Then SetLength(Result, Length(Result) + 1);
            i := Length(Result);
            WildLA := i;
            WildLS := Length(Result[i - 1]);
            isWild := True;
            Continue;

            goWild:
            W := WildW;
            N := WildN;
            Inc(WildN);
            If (W = nil) or (N > Ne) Then Begin
              Result := nil;
              Exit;
            End;
            SetLength(Result, WildLA);
            Result[WildLA - 1] := Copy(Result[WildLA - 1], 1, WildLS) + (N - 1)^;
            Inc(WildLS);
            isWild := True;
            Continue;
          End;
          '?': Begin
            If N >= Ne Then GoTo goWild;
            If not isWild Then SetLength(Result, Length(Result) + 1);
            i := High(Result);
            Result[i] := Result[i] + N^;
            isWild := True;
          End;
          '\': Begin
            If (cfCanMask in Flags) and ((W + 1)^ in ['*', '?', '\']) Then Inc(W);
            GoTo goElse;
          End;
          Else
            goElse:
            If Char(N^) <> Char(W^) Then GoTo goWild;
            isWild := False;
        End;
        If (W = We) and (N = Ne) Then Break;
        If (W >= We) or (N >= Ne) Then GoTo goWild;
        Inc(W);
        Inc(N);
      End;
      If Result = nil Then SetLength(Result, 1);
    End;

  Function CompareWildFileNameEx(Wild, FileName: String; Flags: TCompareFlags = []): TStringArray;
    Var W, N: Integer;
      A: TStringArray;
      S: String;

    Procedure AddArray;
      Var i, i2: Integer;

      Begin
        If (Pos('*', S) <> 0) or (Pos('?', S) <> 0) Then Begin
          i := Length(Result);
          SetLength(Result, i + Length(A));
          For i2 := 0 to High(A) do Result[i2 + i] := A[i];
        End;
      End;

    Label goExit;

    Begin
      Wild := StringReplace(Wild, '/', '\', [rfReplaceAll]);
      FileName := StringReplace(FileName, '/', '\', [rfReplaceAll]);
      Result := nil;
      If (cfRequireFileName in Flags) and (ExtractFileName(FileName) = '') Then Exit;
      If (cfRequireFileExt in Flags) and (Length(ExtractFileExt(FileName)) <= 1) Then Exit;
      If cfNoMaskOverDir in Flags Then Begin
        W := Pos('\', Wild);
        N := Pos('\', FileName);
        While (W > 0) and (N > 0) do Begin
          S := Copy(Wild, 1, W - 1);
          A := CompareWildStringEx(S, Copy(FileName, 1, N - 1), Flags + [cfIgnoreCase]);
          If A <> nil Then AddArray Else GoTo goExit;
          Delete(Wild, 1, W);
          Delete(FileName, 1, N);
          W := Pos('\', Wild);
          N := Pos('\', FileName);
        End;
        If (W > 0) or (N > 0) Then Goto goExit;
      End;
      S := ChangeFileExt(Wild, '');
      A := CompareWildStringEx(S, ChangeFileExt(FileName, ''), Flags + [cfIgnoreCase]);
      If A <> nil Then AddArray Else GoTo goExit;
      S := Copy(ExtractFileExt(Wild), 2, MaxPos);
      A := CompareWildStringEx(S, Copy(ExtractFileExt(FileName), 2, MaxPos), Flags + [cfIgnoreCase]);
      If A <> nil Then AddArray Else GoTo goExit;
      If Result = nil Then SetLength(Result, 1);
      Exit;

      goExit:
      Result := nil;
    End;