Новая Функция Парса

[Lomanu4]

Нашел в интернете еще одну функцию парса


[HIDE=1]

Спойлер: сама функция

function MulPars(T_, ForS, _T: string): TStringArray;
var
  offset: integer;
  Count: Integer;

  function PosEx(Const SubStr, S: String; Offset: Cardinal = 1): integer;
  var
    I,X: Integer;
    Len, LenSubStr: Integer;
  begin
    if Offset = 1 then
       Result := Pos(SubStr, S)
    else
    begin
       I := Offset;
       LenSubStr := Length(SubStr);
       Len := Length(S) - LenSubStr + 1;
       while I <= Len do
       begin
         if S[I] = SubStr[1] then
         begin
           X := 1;
           while (X < LenSubStr) And (S[I + X] = SubStr[X + 1]) do
             Inc(X);
           if (X = LenSubStr) then
           begin
             Result := I;
             exit;
           end;
         end;
         Inc(I);
       end;
       Result := 0;
    end;
  end;

  function Pars(T_, ForS, _T: string; var offset: integer): string;
  var a, b:integer;
  begin
    Result := '';
    if (T_='') or (ForS='') or (_T='') then Exit;
    a:=PosEx(T_, ForS, offset);
    if a=0 then Exit else a:=a+Length(T_);
    ForS:=Copy(ForS, a, Length(ForS)-a+1);
    b:=Pos(_T, ForS);
    if b>0 then
    Result := Copy(ForS, 1, b - 1);
    offset := b + a + 2;
  end;

begin
  offset := 0;
  Count := 0;
  while PosEx(_T, ForS, offset) > 0 do
  begin
    SetLength(result, Count + 1);
    Result[Count] := Pars(T_, Fors, _T, offset);
    Inc(Count);
  end;

[/HIDE]

Спойлер: Пример

procedure TfrmMain.Button1Click(Sender: TObject);
var
  arr: TStringArray;
  i: Integer;
begin
  arr := MulPars(Edit1.Text, Memo1.Lines.Text, Edit2.Text);

  Memo2.Clear;
  for i := 0 to High(arr) do
    Memo2.Lines.Add(arr[i]);
end;

Пожалуйста Авторизируйтесь или Зарегистрируйтесь для просмотра скрытого текста.

 

[Максим]

Я еще со старой не разобрался. И по этой урока нет, а по той есть.

 

[Lomanu4]

В type добавить: "TStringArray = array of string;";