Thema: Delphi CompareWildString...

Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.225 Beiträge
 
Delphi 12 Athens
 
#5

Re: CompareWildString...

  Alt 29. Okt 2007, 21:45
ist auch vollkommen korrekt so

OK, hier noch zwei Definitionen, welche oben fehlen (hatten sich in 'ner anderen Unit versteckt )
Delphi-Quellcode:
Const MaxPos = $7FFFFFFF;
Type TStringArray = Array of String;

aber nun zu deinem "Problem".

Diese Funktion vergleicht den kompletten String, also sie sucht nicht nach einem Teilstring welcher auf die Maske paßt.


es wird praktisch so verglichen:
Code:
[color=#ff0000]>>[/color]Hello BEG_NAME_END this is your email: ___EMAIL___[color=#ff0000]<<[/color]
[color=#ff0000]>>[/color]BEG_******************************************_END[color=#ff0000]<< = falsch[/color]

für dich wäre aber diese Maske '*BEG_*_END*' wohl passend.
Code:
[color=#ff0000]>>[/color]Hello BEG_NAME_END this is your email: ___EMAIL___[color=#ff0000]<<[/color]
[color=#ff0000]>>[/color]******BEG_****_END********************************[color=#ff0000]<<[/color] [color=#00ff00]= paßt[/color]
als Ergebnis käme dann dieses raus:
myStringArray[0] = 'Hello '
myStringArray[1] = 'NAME'
myStringArray[2] = ' this is your email: ___EMAIL___'



hab dadurch noch 'nen "Fehler" entdeckt.
und zwar wurde das Ergebnis der Ex-Funktionen bei nicht casesensitivem Vergleich in Kleinschrift ausgegeben.
die Funktion CompareWildStringEx wurde um die Variable NameC erweitert und es gab dementsprechend, da wo diese verwendet wurde, ein bissl was geändert.

hier jetzt nochmal alles zusammen, mit den kleinen Änderungen:
Delphi-Quellcode:
  Type TStringArray = Array of String;

  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, MaxInt), Copy(ExtractFileExt(FileName), 2, MaxInt), Flags + [cfIgnoreCase]);
    End;

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

    Label goWild, goElse;

    Begin
      NameC := Name;
      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) + NameC[N - PChar(Name)];
            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, MaxInt);
      A := CompareWildStringEx(S, Copy(ExtractFileExt(FileName), 2, MaxInt), Flags + [cfIgnoreCase]);
      If A <> nil Then AddArray Else GoTo goExit;
      If Result = nil Then SetLength(Result, 1);
      Exit;

      goExit:
      Result := nil;
    End;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat