|
Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.033 Beiträge
Delphi 12 Athens
|
Re: Stringvergleich mit Wildcards
7. Mai 2009, 16:51
War doch fast so einfach, wie ich's mir dachte. 
String-Version: (bis D2007 als ANSI und in D2009 als Unicode)
Delphi-Quellcode:
Function MatchText(Const Mask, S: String; CaseSensitive: Boolean = False): Boolean;
Var Mp, Me2, Me, Mm, Sp, Se, Sm: PChar;
Mt, St: String;
Label LMulti, LMask;
Begin
Result := False;
If CaseSensitive Then Begin
Mp := PChar(Mask);
Sp := PChar(S);
End Else Begin
Mt := Mask;
St := S;
UniqueString(Mt);
UniqueString(St);
Mp := PChar(Mt);
Sp := PChar(St);
CharLowerBuff(Mp, Length(Mt));
CharLowerBuff(Sp, Length(St));
End;
Me := Mp + Length(Mask);
Me2 := Me;
Se := Sp + Length(S);
LMulti:
Mm := nil;
Sm := Se;
While (Mp < Me2) or (Sp < Se) do Begin
Case Mp^ of
'*': Begin
While Mp^ = '*' do Inc(Mp);
Mm := Mp;
Sm := Sp + 1;
Continue;
LMask:
Mp := Mm;
Sp := Sm;
Inc(Sm);
If (Mp < Me2) and (Sp >= Se) Then
If Me2 < Me Then Begin
Inc(Me2);
Mp := Me2;
If CaseSensitive Then Sp := PChar(S) Else Sp := PChar(St);
While Me2 < Me do
Case Me2^ of
'\': Case (Me2 + 1)^ of
'*', '?', '|', '\': Inc(Me2, 2);
Else Inc(Me2);
End;
'|': Begin
Me2^ := #0;
Goto LMulti;
End;
Else Inc(Me2);
End;
Goto LMulti;
End Else Exit;
Continue;
End;
'?': ;
'|': Begin
If (Mt = '') and (Mask <> '') Then Begin
Mt := Mask;
UniqueString(Mt);
Mp := Mp - PChar(Mask) + PChar(Mt);
Me := PChar(Mt) + Length(Mask);
If Mm <> nil Then Mm := Mm - PChar(Mask) + PChar(Mt);
End;
Mp^ := #0;
Me2 := Mp;
Continue;
End;
'\': Begin
Case (Mp + 1)^ of '*', '?', '|', '\': Inc(Mp); End;
If Mp^ <> Sp^ Then GoTo LMask;
End;
Else If Mp^ <> Sp^ Then GoTo LMask;
End;
If (Mp >= Me2) or (Sp >= Se) Then GoTo LMask;
Inc(Mp);
Inc(Sp);
End;
Result := True;
End;
PChar-Version: (bis D2007 als PAnsiChar und in D2009 als PWideChar)
Delphi-Quellcode:
Function MatchText(Mask, S: PChar; CaseSensitive: Boolean = False): Boolean;
Var Mp, Mm, Me, Me2, Sp, Sm: PChar;
Mt, St: String;
Label LMulti, LMask;
Begin
Result := False;
If CaseSensitive Then Begin
Mt := Mask;
Mp := PChar(Mt);
Sp := S;
End Else Begin
Mt := Mask;
St := S;
Mp := PChar(Mt);
Sp := PChar(St);
CharLowerBuff(Mp, Length(Mt));
CharLowerBuff(Sp, Length(St));
End;
Me := Mp + lstrlen(Mp);
Me2 := Me;
LMulti:
Mm := nil;
Sm := Sp + lstrlen(Sp);
While (Mp^ <> #0) or (Sp^ <> #0) do Begin
Case Mp^ of
'*': Begin
While Mp^ = '*' do Inc(Mp);
Mm := Mp;
Sm := Sp + 1;
Continue;
LMask:
Mp := Mm;
Sp := Sm;
Inc(Sm);
If ((Mp = nil) or (Mp^ <> #0)) and (Sp^ = #0) Then Begin
If Me2 < Me Then Begin
Inc(Me2);
Mp := Me2;
If CaseSensitive Then Sp := S Else Sp := PChar(St);
While Me2 < Me do
Case Me2^ of
'\': Case (Me2 + 1)^ of
'*', '?', '|', '\': Inc(Me2, 2);
Else Inc(Me2);
End;
'|': Begin
Me2^ := #0;
Goto LMulti;
End;
Else Inc(Me2);
End;
Goto LMulti;
End Else Exit;
End;
Continue;
End;
'?': ;
'|': Begin
Mp^ := #0;
Me2 := Mp;
Continue;
End;
'\': Begin
Case (Mp + 1)^ of '*', '?', '|', '\': Inc(Mp); End;
If Mp^ <> Sp^ Then GoTo LMask;
End;
Else If Mp^ <> Sp^ Then GoTo LMask;
End;
If (Mp^ = #0) or (Sp^ = #0) Then GoTo LMask;
Inc(Mp);
Inc(Sp);
End;
Result := True;
End;
diese Testmuster laufen mit dem richtigen Ergebnis durch:
Delphi-Quellcode:
If MatchText(' ', ' abcdef') Then Beep;
If MatchText(' def', ' ') Then Beep;
If not MatchText(' abcdef', ' abcdef') Then Beep;
If MatchText(' df', ' abcdef') Then Beep;
If MatchText(' abc', ' abcdef') Then Beep;
If MatchText(' def', ' abcdef') Then Beep;
If MatchText(' abc?f', ' abcdef') Then Beep;
If not MatchText(' abc??f', ' abcdef') Then Beep;
If not MatchText(' abc*f', ' abcdef') Then Beep;
If MatchText(' a?def', ' abcdef') Then Beep;
If not MatchText(' a??def', ' abcdef') Then Beep;
If not MatchText(' a*def', ' abcdef') Then Beep;
If MatchText(' abcd?', ' abcdef') Then Beep;
If not MatchText(' abcd??', ' abcdef') Then Beep;
If MatchText(' abcd???', ' abcdef') Then Beep;
If not MatchText(' abcd*', ' abcdef') Then Beep;
If MatchText(' a?def', ' abcdef') Then Beep;
If not MatchText(' a??def', ' abcdef') Then Beep;
If not MatchText(' a*def', ' abcdef') Then Beep;
If MatchText(' ?cdef', ' abcdef') Then Beep;
If not MatchText(' ??cdef', ' abcdef') Then Beep;
If not MatchText(' *cdef', ' abcdef') Then Beep;
If MatchText(' b*c*f', ' abcdef') Then Beep;
If not MatchText(' a*c*f', ' abcdef') Then Beep;
If not MatchText(' a?c*f', ' abcdef') Then Beep;
If MatchText(' a?d*f', ' abcdef') Then Beep;
If not MatchText(' *a*f*', ' abcdef') Then Beep;
If MatchText(' *a?bf*', ' abcdef') Then Beep;
If not MatchText(' *c*f*', ' abcdef') Then Beep;
If not MatchText(' *c*d*', ' abcdef') Then Beep;
If MatchText(' *c?f*', ' abcdef') Then Beep;
If not MatchText(' *d?f*', ' abcdef') Then Beep;
If not MatchText(' *', ' ') Then Beep;
If not MatchText(' *', ' abcdef') Then Beep;
If not MatchText(' a*', ' abcdef') Then Beep;
If not MatchText(' *f', ' abcdef') Then Beep;
If not MatchText(' a*d|a*', ' abcdef') Then Beep;
If MatchText(' abc|ef', ' abc|ef') Then Beep;
If not MatchText(' abc\|ef', ' abc|ef') Then Beep;
Und im Anhang alle Versionen überladen unter einem Namen in 'ner Unit verpackt.
> String, AnsiString, WideString, UnicodeString (ab D2009), PChar, PAnsiChar und PWideChar
Ich hoffe die laufen nun auch alle richtig 
[edit 22.06.2009]
Anhang entfernt > aktuelle Version siehe Beitrag #26
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher. 
 my Delphi wish list : BugReports/FeatureRequests
|