Type TCompareFlags =
Set of (cfNotCaseSensitive, cfCanMask);
Function CompareWildString (Wild,
Name:
String; Flags: TCompareFlags = []): Boolean;
Function CompareWildText(
Const Wild,
Name:
String; Flags: TCompareFlags = []): Boolean;
Function CompareWildStringEx (Wild,
Name:
String; Flags: TCompareFlags = []): TStringDynArray;
Overload;
Function CompareWildStringEx (Wild,
Name:
String; Flags: TCompareFlags; Offset: Integer;
Out EndOffset: Integer): TStringDynArray;
Overload;
Function CompareWildString(Wild,
Name:
String; Flags: TCompareFlags = []): Boolean;
Var W, N, We, Ne, WildW, WildN: PChar;
Label goWild, goElse;
Begin
If cfNotCaseSensitive
in Flags
Then Begin
Wild := LowerCase(Wild);
Name := LowerCase(
Name);
End;
Result := False;
W := PChar(Wild); We := W + Length(Wild); WildW :=
nil;
N := PChar(
Name); Ne := N + Length(
Name); WildN :=
nil;
While (W < We)
or (N < Ne)
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 N^ <> W^
Then GoTo goWild;
End;
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 + [cfNotCaseSensitive]);
End;
Function CompareWildStringEx(Wild,
Name:
String; Flags: TCompareFlags = []): TStringDynArray;
Var W, N, We, Ne, WildW, WildN: PChar;
WildLA, WildLS, i: Integer;
isWild: Boolean;
Label goWild, goElse;
Begin
If cfNotCaseSensitive
in Flags
Then Begin
Wild := LowerCase(Wild);
Name := LowerCase(
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 (W < We)
or (N < Ne)
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 N^ <> W^
Then GoTo goWild;
isWild := False;
End;
If (W >= We)
or (N >= Ne)
Then GoTo goWild;
Inc(W);
Inc(N);
End;
If Result =
nil Then SetLength(Result, 1);
End;
Function CompareWildStringEx(Wild,
Name:
String; Flags: TCompareFlags; Offset: Integer;
Out EndOffset: Integer): TStringDynArray;
Var W, N, We, Ne, WildW, WildN: PChar;
WildLA, WildLS, i: Integer;
isWild: Boolean;
Label goWild, goElse;
Begin
If cfNotCaseSensitive
in Flags
Then Begin
Wild := LowerCase(Wild);
Name := LowerCase(
Name);
End;
Result :=
nil;
EndOffset := Offset;
Dec(Offset);
If Offset >= Length(
Name)
Then Exit
Else If Offset < 0
Then Offset := 0;
WildLA := 0; WildLS := 0;
W := PChar(Wild); We := W + Length(Wild); WildW :=
nil;
N := PChar(
Name) + Offset; Ne := N + Length(
Name) - Offset; WildN :=
nil;
isWild := False;
While (W < We)
or (N < Ne)
do Begin
Case W^
of
'
*':
Begin
While W^ = '
*'
do Inc(W);
WildW := W;
WildN := N + 1;
If not isWild
Then Begin
EndOffset := N - PChar(
Name) + 1;
SetLength(Result, Length(Result) + 1);
End;
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;
EndOffset := N - PChar(
Name) + 1;
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 N^ <> W^
Then GoTo goWild;
isWild := False;
End;
If (W >= We)
or (N >= Ne)
Then GoTo goWild;
Inc(W);
Inc(N);
End;
If Result =
nil Then SetLength(Result, 1);
End;