Delphi
Wildcard matching function
Tmask.matches
Some problems: If the wildcard strings are too long, such as entry
Hotmail
The address of the mailbox has probably
250
Character. This will result in
Tmask.matches
The function is wrong and causes the entire program to crash. I have found some different implementations online and do performance comparisons. Now I have an optimized version to share it.
Type
TmaskmatchResult =
Record
Ofsets: Integer; Patternlength: Integer;
end
;
FUNCTION
Haswildcardsa
Const
S:
String
: Boolean;
VAR
I: integer;
Begin
Result: = FALSE;
for
I: =
1
TO
Length (s)
DO
IF
S [i]
in
[
'*'
,
'?'
]
THEN
Begin
Result: = true;
end
;
end
;
// Idicates WHETHER A STRING MATCHES A WILDCARD PATTERN.
FUNCTION
Matchmaska (
Const
Apattern, Asource:
String
: Boolean;
VAR
I: integer;
Begin
IF
Apattern =
'' '
THEN
Result: = asource =
'' '
Else
IF
Asource =
'' '
THEN
Begin
for
I: =
1
TO
Length (apattern)
DO
IF
Apattern [i] <>
'*'
THEN
Begin
Result: = FALSE; EXIT;
end
Result: = true;
end
Else
Result: = MatchmasKexa (Apattern, Asource) .patternlength = length (asource);
end
;
// Idicates WHETHER A STRING MATCHES A WILDCARD PATTERN.
//
When not matched, result.patternlength = 0.
FUNCTION
Matchmaskexa (
Const
Apattern, Asource:
String
; Offset: integer =
1
ScanPattern: Boolean = True): TmaskmatchResult;
VAR
Stringptr, stringres, patternptr, patternres: pchar; countingflexibleLength: boolean; i: integer;
Begin
Fillchar (Result, SIZEOF (Result),
#
0
);
IF
Offset <
1
THEN
OFFSET: =
1
;
IF
Scanpattern
and
NOT
Haswildcardsa (Apattern)
THEN
Begin
IF
OFFSET = POSEX
{ANSI ONLY}
(Apattern, Asource, Offset)
THEN
Begin
Result.patternlength: = Length (apattern) {!> 0}
Result.offset: = offset
end
EXIT;
end
Stringptr: = pchar (asource);
IF
Offset>
1
THEN
INC (Stringptr, Offset)
1
Patternptr: = pchar (apattern); stringRES: =
NIL
Patternres: =
NIL
CountingflexibleLength: = (Length (apattern)>
0
)
and
(Apattern [
1
] =
'*'
);
Repeat
Repeat
// ohne vorancegangenes "*"
Case
Patternptr ^
Of
#
0
:
Begin
Result.patternlength: = Length (Asource) (
1
- offset - Length (Stringptr);
IF
Result.patternlength>
0
THEN
RESULT.OFFSET: = OFFSET;
end
;
'*'
:
Begin
INC; PATTERNRES: = Patternptr; Break;
end
;
'?'
:
Begin
IF
Stringptr ^ =
#
0
THEN
EXIT; INC (Stringptr); Inc (Patternptr);
end
;
Else
Begin
IF
Stringptr ^ =
#
0
THEN
EXIT;
IF
Stringptr ^ <> patternptr ^
THEN
Begin
IF
(StringRes =
NIL
)
oral
(PatternRes =
NIL
)
THEN
Stringptr: = stringRES; Patternptr: = Patternres; Break;
end
Else
Begin
Inc (StringPtr); Inc (Patternptr);
end
;
end
;
end
;
Until
False;
Repeat
// mit vorancegangenem "*"
Case
Patternptr ^
Of
#
0
:
Begin
Result.patternlength: = Length (Asource) (
1
- offset;
IF
ANSILASTCHAR (APATTERN) <>
'*'
THEN
Dec (Result.Patternlength);
IF
Result.patternlength>
0
THEN
Result.offset: = offset
IF
CountingflexibleLength
THEN
Result.LeadingflexibleLength: = Result.patternlength; exit;
;
'*'
:
Begin
INC; Patternres: = Patternptr;
end
;
'?'
:
Begin
IF
Stringptr ^ =
#
0
THEN
EXIT; INC (Stringptr); Inc (Patternptr);
end
;
Else
Begin
Repeat
IF
Stringptr ^ =
#
0
THEN
EXIT;
IF
Stringptr ^ = patternptr ^
THEN
Break; inc (StringPtr);
Until
False; Inc (Stringptr); stringRES: = StringPtr; Inc (Patternptr); Break;
end
;
end
;
Until
False;
IF
CountingflexibleLength
THEN
Begin
Result.LeadingflexibleLength: = Length (asource) - offset - length (stringptr); countingflexibleLength: = false;
end
;
Until
False;
end
;
