Прямой поиск строки Опции

[Lo]

Рассказываю: необходим код по прямому поиску строки в тексте. Прямой, значит символьные элементы заносятся в массив и подстрока последовательно смещаясь сравнивается со строкой. Такой алгоритм есть еще у Вирта, но достаточно древний. А необходимо реализовать поиск со знаками *, ?. Только нужен элегантный код. Заранее спасибо

Сообщение отредактировано: volvo - 17.12.2004 16:35

[Lo]

Соответственно, в главной вызывается SmpStr

Код

procedure MaskForm(var M: string);
begin
 i:=1;
 if first=1 then
 begin
   inc(first);
   While True Do
   Begin
     J:=Length(M);
     While I<Length(M) Do
     Begin
       If (M[I]='?') And (M[I+1]='*') Then Delete(M,I,1);
       If (M[I]='*') And (M[I+1]='?') And (I<Length(M)) Then Delete(M,I+1,1);
       If (M[I]='*') And (M[I+1]='*') And (I<Length(M)) Then Delete(M,I,1);
       Inc(I);
     End;
     If J=Length(M) Then Break;
     I:=1;
   End;
 end;
end;

Function StrCmp(S,Mask:String):boolean;
Var
 Msk,St: string;
Begin
 { Приведение маски к формальному виду. Производится однократно }
 MaskForm(Mask);
 { Блок сравнения с маской }
 Ok:=True;
 I:=1;
 J:=0;
 repeat
   j:=j+1;
   i:=1;
   While TRUE Do
   Begin
    Case Mask[I] Of
    '*':
     Begin
      if I=Length(Mask) then Ok:= true
      else
      begin
        washere:= true; { Рекурсивная проверка совпадений для части строки, идущей после символа '*' }
        Msk:=Copy(Mask,I+1,Length(Mask)-I+1);
        St:=Copy(S,J,Length(S)-J+1);
        While (St<>'') And (NOT StrCmp(St,Msk)) Do
        Delete(St,1,1);
        If St='' Then Ok:=False
                 else
                 begin
                   J:=Pos(St,S);
                   break;
                 end;
      end;
     End;
   '?':
    Begin
     if I=Length(Mask) then OK:= true
     else
     begin
       If (I=Length(Mask)) And (J<Length(S)) Then Ok:=False;
       If J>Length(S) Then Ok:=False;
       Inc(J);
     end;
    End;
   Else If Mask[I]<>S[J]
   Then begin
          Ok:= false;
          break;
        end
   Else begin
          if FirstIn= 0 then FirstIn:= J;
          Inc(J);
          Ok:= true;
        end;
   End;
   q:= Length(S);
   If J-1>Length(S) Then Ok:=False;
   If Not Ok Then Break;
   w:= Length(Mask);
   Inc(I);
   If I>Length(Mask) Then Break;
 End;
 w:= Length(Mask);
 q:= Length(S);
 if washere then begin
                   if (j=w+1) or (j=w) then Yes:= true
                 end
 else
 begin
   if (i>w) then Yes:= true
 end
 until (j>=q) or Yes;
 StrCmp:=Ok;
end;

Сообщение отредактировано: volvo - 17.12.2004 16:36