Спарсить символы

[Cyrix]

function Pars(T_: string; var ForS: string; _T: string): string;
var
 a,b:Integer;
begin
if (T_<>'') and (ForS<>'') and (_T<>'') then
begin
 a:=Pos(T_,ForS);
 Result:=Copy(ForS,a+Length(T_),Length(ForS));
 b:=Pos(_T,Result);
 Result:=Copy(Result,1,b-1);
if (a>0) and (b>0) then
 Delete(ForS,a,b+length(_T)+length(T_)-1)
else
 Result:='';
end
else
 Result:='';
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 b,c:string;
 Data:TStringStream;
begin
 Memo1.Clear;
 if Memo2.Text='' then exit;
 Data:=TStringStream.Create(Memo2.Text);
 b:=Data.DataString;
 c:=Pars('(', b, ')');
 Memo1.Text:=c;
end;

В Memo2 текст >

sd(E),gr(T),rh(W)

Должно в Memo1 спарситься ETW но только появляется один символ E. Нужно вообще спарсить через запятую E,T,W. А я с этим не могу понять, почему не парсит все символы из скобок.

[Serge_Bliznykov]

ну, у Вас парсинг возвращает первое найденное значение.

если хотите получить все - крутите в цикле.
например, так:

procedure TForm1.Button2Click(Sender: TObject);
var
 b,c, allc :string;
begin
 Memo1.Clear;
 if Memo2.Text='' then exit;
 b := Memo2.Text;
 allc := '';
 repeat
   c:=Pars('(', b, ')');
   allc := allc + c;
 until (c='');
 Memo1.Text:=allc;
end;

примечания по коду.
1) не понял, зачем Вам эти заворот с TStringStream: Data:=TStringStream.Create(Memo2.Te xt)
я выкинул нафиг. если понимаете, для чего это вам нужно - вернёте как было.

2) в алгоритме есть косячок. если встретится пустое содержимое внутри скобок () - цикл прервётся. Если так не должно быть - тогда нужно изменять условие прерывания цикла в until ...

[kangreon]

Парсятся данные из всех скобок:

procedure TForm1.Button1Click(Sender: TObject);
var
  s, r: string;
  i, k: Integer;
begin
  s := 'sd(E),gr(T),rh(W)';
  i := 1;
  while PosEx('(', s, i) <> 0 do
  begin
    i := PosEx('(', s, i) + 1;
    k := PosEx(')', s, i);
    if k = 0 then
      Break;

    r := r + Copy(s, i, k - i) + ',';
  end;
  Edit1.Text := r;
end;

В секции uses нужно подключить библиотеку StrUtils.
На выходе получается строка "E,T,W,"

PS если файл для парсинга большой, то не стоит использовать функцию Delete, т.к. это сильно тормозит поиск.

[Cyrix]

kangreon, cпасибо. Твой вариант получше.
С вариантом Serge_Bliznykov почему то две запятые в конце.

[Serge_Bliznykov]

согласен, вариант kangreon отличается от функции Pars как небо от земли!
Безусловно он и быстрее и проще и намного эффективнее!


я просто (ошибочно, как выяснилось) думал, что Вам нужно использовать именно навороченные вами навороты вашей функции Pars...

[Cyrix]

Serge_Bliznykov, функцию Pars использовал. Ваши два совета помогли, дали урок парсинга. Временами использую и Ваши советы, так что, спасибо. Переписал код.

 b:=Memo2.Text;
 c:='';
 d:=',';
while pos('(',b)>0 do
 с:=с+Pars('(',b,')')+d;