Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.184 Beiträge
Delphi 12 Athens
|
Re: CompareWildString...
29. Okt 2007, 22: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;
$2B or not $2B
|