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:

markieren

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"

markieren

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.

markieren
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

zusammenfalten · markieren

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;

CompareWildString...

CompareWildString...

Forumregeln