Einzelnen Beitrag anzeigen

Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.119 Beiträge
 
Delphi 12 Athens
 
#20

Re: Stringvergleich mit Wildcards

  Alt 7. Mai 2009, 13: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;
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat