Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.080 Beiträge
Delphi 12 Athens
|
Re: Stringvergleich mit Wildcards
7. Mai 2009, 14:51
Blos mal 'ne kleine und nicht ganz durchgeteste Vorschau auf alle vier Versionen (also nun auch eine MultiMatchText als String-Version).
Also aktuell ist noch alles in Post #15 vorzuziehen.
Wenn ich es jetzt noch schaff die Bearbeitung des "|", von vor der Hauptschleife, in die Hauptschleife reinzubekommen, dann wird es nur noch je eine String- und PChar-Vesion geben (MultiMatchText und MatchText in einem), ansonsten laß ich es performancemäßig getrennt, aber ich bin (noch) guter Dinge
Delphi-Quellcode:
Function MatchText(Const Mask, S: WideString; CaseSensitive: Boolean = False): Boolean;
Var Mp, Me, Mm, Sp, Se, Sm: PWideChar;
Mt, St: WideString;
Label LMask;
Begin
Result := False;
If CaseSensitive Then Begin
Mp := PWideChar(Mask);
Sp := PWideChar(S);
End Else Begin
Mt := Mask;
St := S;
UniqueString(Mt);
UniqueString(St);
Mp := PWideChar(Mt);
Sp := PWideChar(St);
CharLowerBuffW(Mp, Length(Mt));
CharLowerBuffW(Sp, Length(St));
End;
Me := Mp + Length(Mask);
Se := Sp + Length(S);
Mm := nil;
Sm := Se;
While (Mp < Me) 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 < Me) and (Sp >= Se) Then Exit;
Continue;
End;
'?': ;
'\': Begin
{$IF SizeOf(Mp^) > 1}
//If ((Mp + 1)^ = '*') or ((Mp + 1)^ = '?') or ((Mp + 1)^ = '\') Then Inc(Mp);
Case (Mp + 1)^ of '*', '?', '\': Inc(Mp); End;
{$ELSE}
If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
{$IFEND}
If Mp^ <> Sp^ Then GoTo LMask;
End;
Else If Mp^ <> Sp^ Then GoTo LMask;
End;
If (Mp >= Me) or (Sp >= Se) Then GoTo LMask;
Inc(Mp);
Inc(Sp);
End;
Result := True;
End;
Function {Multi}MatchText(Const Mask, S: WideString; CaseSensitive: Boolean = False): Boolean;
Var Mp, Me2, Me, Mm, Sp, Se, Sm: PWideChar;
Mt, St: WideString;
Label LMulti, LMask;
Begin
Result := False;
If CaseSensitive Then Begin
Mp := PWideChar(Mask);
Sp := PWideChar(S);
End Else Begin
Mt := Mask;
St := S;
UniqueString(Mt);
UniqueString(St);
Mp := PWideChar(Mt);
Sp := PWideChar(St);
CharLowerBuffW(Mp, Length(Mt));
CharLowerBuffW(Sp, Length(St));
End;
Me := Mp + Length(Mask);
Me2 := Mp;
Se := Sp + Length(S);
LMulti:
While Me2 < Me do Begin
Case Me2^ of
'\': {$IF SizeOf(Mp^) > 1}
Case (Mp + 1)^ of '*', '?', '\': Inc(Mp); End;
{$ELSE}
If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
{$IFEND}
'|': Begin
If (Mt = '') and (Mask <> '') Then Begin
Mt := Mask;
UniqueString(Mt);
Mp := Mp - PWideChar(Mask) + PWideChar(Mt);
Me := PWideChar(Mt) + Length(Mask);
End;
Me2^ := #0;
Break;
End;
End;
Inc(Me2);
End;
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);
Goto LMulti;
End Else Exit;
Continue;
End;
'?': ;
'\': Begin
{$IF SizeOf(Mp^) > 1}
//If ((Mp + 1)^ = '*') or ((Mp + 1)^ = '?') or ((Mp + 1)^ = '\') Then Inc(Mp);
Case (Mp + 1)^ of '*', '?', '\': Inc(Mp); End;
{$ELSE}
If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
{$IFEND}
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;
Function MatchText(Mask, S: PWideChar; CaseSensitive: Boolean = False): Boolean;
Var Mm, Sm: PWideChar;
Mt, St: WideString;
Label LMask;
Begin
Result := False;
If not CaseSensitive Then Begin
Mt := Mask;
St := S;
Mask := PWideChar(Mt);
S := PWideChar(St);
CharLowerBuffW(Mask, Length(Mt));
CharLowerBuffW(S, Length(St));
End;
Mm := nil;
Sm := S + lstrlenW(S);
While (Mask^ <> #0) or (S^ <> #0) do Begin
Case Mask^ of
'*': Begin
While Mask^ = '*' do Inc(Mask);
Mm := Mask;
Sm := S + 1;
Continue;
LMask:
Mask := Mm;
S := Sm;
Inc(Sm);
If ((Mask = nil) or (Mask^ <> #0)) and (S^ = #0) Then Exit;
Continue;
End;
'?': ;
'\': Begin
{$IF SizeOf(Mask^) > 1}
Case (Mask + 1)^ of '*', '?', '\': Inc(Mask); End;
{$ELSE}
If (Mask + 1)^ in ['*', '?', '\'] Then Inc(Mask);
{$IFEND}
If Mask^ <> S^ Then GoTo LMask;
End;
Else If Mask^ <> S^ Then GoTo LMask;
End;
If (Mask^ = #0) or (S^ = #0) Then GoTo LMask;
Inc(Mask);
Inc(S);
End;
Result := True;
End;
Function MultiMatchText(Mask, S: PWideChar; CaseSensitive: Boolean = False): Boolean;
Var Mp, Mm, Me, Ms, Sp, Sm: PWideChar;
Mt, St: WideString;
Label LMulti, LMask;
Begin
Result := False;
If CaseSensitive Then Begin
Mt := Mask;
Mp := PWideChar(Mt);
Sp := S;
End Else Begin
Mt := Mask;
St := S;
Mp := PWideChar(Mt);
Sp := PWideChar(St);
CharLowerBuffW(Mp, Length(Mt));
CharLowerBuffW(Sp, Length(St));
End;
Me := Mp + lstrlenW(Mp);
Ms := Mp;
Mm := Mp;
While Mm^ <> #0 do Begin
Case Mm^ of
'\': {$IF SizeOf(Mp^) > 1}
Case (Mp + 1)^ of '*', '?', '\': Inc(Mp); End;
{$ELSE}
If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
{$IFEND}
'|': Mm^ := #0;
End;
Inc(Mm);
End;
LMulti:
Mm := nil;
Sm := Sp + lstrlenW(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
While Ms < Me do Begin
Inc(Ms);
If (Ms - 1)^ = #0 Then Begin
Mp := Ms;
If CaseSensitive Then Sp := S Else Sp := PWideChar(St);
Goto LMulti;
End;
End;
Exit;
End;
Continue;
End;
'?': ;
'\': Begin
{$IF SizeOf(Mp^) > 1}
Case (Mp + 1)^ of '*', '?', '\': Inc(Mp); End;
{$ELSE}
If (Mp + 1)^ in ['*', '?', '\'] Then Inc(Mp);
{$IFEND}
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;
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PoSex im Delphi viel seltener praktiziert.
|