копирование текста из мемо

[grafgrial]

Вот такой код у меня в memo1

<tr>
   <td class="row1" width="100%" >
	<span style="FONT-SIZE: 8pt">
	(22:03:40) <b><a style='text-decoration: none;' href='profile.php?mode=viewprofile&amp;u=1240' target='_blank' >
<img src='images/userpic8.gif'></a> <a href='javascript:insertuname2chat("Vovchik12")' >Vovchik12</a></b>: Stiv, сказали так</span>
   </td>
   
   </tr>

<tr>
   <td class="row2" width="100%" >
	<span style="FONT-SIZE: 8pt">
	(22:03:33) <b><a style='text-decoration: none;' href='profile.php?mode=viewprofile&amp;u=1754' target='_blank' >
<img src='images/userpic8.gif'></a> <a href='javascript:insertuname2chat("razil")' >razil</a></b>: Fidrat,   <img class="smile" src="images/smiles/bp.gif" alt="bp" align="absmiddle" border="0" /></span>
   </td>
   
   </tr>
<tr>
   <td class="row1" width="100%" >

	<span style="FONT-SIZE: 8pt">
	(22:03:22) <b><a style='text-decoration: none;' href='profile.php?mode=viewprofile&amp;u=919' target='_blank' >
<img src='images/userpic8.gif'></a> <a href='javascript:insertuname2chat("Алексс")' >Алексс</a></b>: razilya,   <img class="smile" src="images/smiles/bs.gif" alt="bs" align="absmiddle" border="0" /></span>
   </td>
   
   </tr>
<tr>

Вот так делаю парсинг

 
s:=mmo1.lines.text;
for i := 0 to Length(s) -1 do
f:=copy(s,PosEx('>',s,Pos('<a href=',s))+1,PosEx('</a>',s,PosEx('>',s,Pos('<a href=',s)))-PosEx('>',s,Pos('<a href=',s))-1);
mmo2.lines.add(f);

но почему-то добавляет первую строку и все

[Stilet]

Наверное потому что Pos('<a href=',s))+1 всегда возвращает тебе самое первое
ИМХО стоит удалять от начала до первой найденной

for i := 0 to Length(s) -1 do Begin
 j:=PosEx('>',s,Pos('<a href=',s))+1;
 k:=PosEx('</a>',s,PosEx('>',s,Pos('<a href=',s)))-PosEx('>',s,Pos('<a href=',s))-1;
f:=copy(s,j,k);
delete(s,1,k);
mmo2.lines.add(f);
end;

И еще: Ты в цикле забыл Begin написать, потому у тебя по идее вообще только последнюю найденную должна была добавлять.

[Пепел Феникса]

я немного туплю, а что надо выпарсить то?
JS код с ником? или сам ник?

И еще: Ты в цикле забыл Begin написать, потому у тебя по идее вообще только последнюю найденную должна была добавлять.

изаа Pos вернет лишь первую.

[Stilet]

изаа Pos

Ну да ) А если бы его не было то вернуло бы последнюю )) Переменка то все время перезаписывается.

[grafgrial]

Сообщение от Пепел Феникса

я немного туплю, а что надо выпарсить то?
JS код с ником? или сам ник?
изаа Pos вернет лишь первую.

Только ник

Сообщение от Stilet

.....ИМХО стоит удалять от начала до первой найденной....

Твой код работает, но только выводит один и каждый ник раз десять и вконце пустые строки, прога зависает..

[Alter]

Я пользуюсь самописным парсером, мне хватает

unit PageParse;

interface

Uses Windows, SysUtils, StrUtils, Classes, IdURI;

type TParses_ = class (TObject)
  private
   FUri :TIdURI;
  protected

  public
   constructor Create;
   destructor Destroy; override;
    // поисковая процедура
      // поиск всех включений тегов
   procedure FindTagText(Txt :String; Tg1,Tg2 :string; var Lst :TStrings;
                         N :Integer; IncludeTag :Boolean=True); overload;
      // поиск первого включения тегов
   function FindTagTextParam(Txt :String; Tg1,Tg2 :string;
                             IncludeTag :Boolean=True):string; overload;
      // поиск первого включения тегов, с позиции StartPozition
  function FindTagTextParam(Txt :String; Tg1,Tg2 :string;
                             var CurPos :Integer;
                             IncludeTag :Boolean=True;
                             StartPozition :Integer=1):string; overload;
    // конвертор URL
   function URLEncoder(S :string):string;
   function URLDecoder(S :string):string;
  published


end;

implementation

{ TParses_ }

constructor TParses_.Create;
begin
  FUri := TIdURI.Create;
end;

destructor TParses_.Destroy;
begin
 FreeAndNil(FUri);
  inherited;
end;

procedure TParses_.FindTagText(Txt, Tg1, Tg2: string; var Lst: TStrings;
  N: Integer; IncludeTag: Boolean);
var a, b, L :Integer;
    S :string;
    Buf :string;
    CorA,CorB :Integer; //коррекция копирования
begin // поисковая процедура
 if Trim(Txt) = '' then Exit;
 Buf := AnsiUpperCase(Txt);
 Lst.BeginUpdate;
   try
 a := PosEx(AnsiUpperCase(Tg1), Buf, N);
 a := a + Length(Tg1);
 b := PosEx(AnsiUpperCase(Tg2), Buf, a);
 L := b - a;
  // коэффициенты коррекции строки
 CorA := Length(Tg1);
 CorB := Length(Tg2) + Length(Tg1);
  // добавить ячейку
 if IncludeTag then
 begin // вместе с тегами поиска
  S := Copy(Txt, a - CorA, L + CorB);
  If Pos(Tg1, S) = 1 then
    Lst.Add(S);
 end
  else
 begin // занчение между тегами
  S := Copy(Txt, a, L);
  Lst.Add(S);
 end;
  // если есть ещё сылки, повторить поиск
 if PosEx(AnsiUpperCase(Tg1), Buf, b) > 0 then
  FindTagText(Txt, Tg1, Tg2, Lst, b, IncludeTag);
   finally
 Lst.EndUpdate;
   end;
end;

function TParses_.FindTagTextParam(Txt, Tg1, Tg2: string; var CurPos: Integer;
  IncludeTag: Boolean; StartPozition: Integer): string;
var a, b, L :Integer;
    S :string;
    Buf :string;
    CorA,CorB :Integer; //коррекция копирования
begin // поиск первого включения тегов, с позиции StartPozition
 Result := '';
  if Trim(Txt) = '' then Exit;
 CurPos := StartPozition;
 Buf := AnsiUpperCase(Txt);
 a := PosEx(AnsiUpperCase(Tg1), Buf, StartPozition);
 a := a + Length(Tg1);
 b := PosEx(AnsiUpperCase(Tg2), Buf, a);
 L := b - a;
  // коэффициенты коррекции строки
 CorA := Length(Tg1);
 CorB := Length(Tg2) + Length(Tg1);
  // добавить ячейку
 if IncludeTag then
 begin // вместе с тегами поиска
  S := Copy(Txt, a - CorA, L + CorB);
  If Pos(Tg1, S) = 1 then
   Result := S;
  CurPos := b + Length(Tg2);
 end
  else
 begin // занчение между тегами
  Result := Copy(Txt, a, L);
  CurPos := b + Length(Tg2);
 end;
end;

function TParses_.URLDecoder(S: string): string;
begin
 Result := FUri.URLDecode(S);
end;

function TParses_.URLEncoder(S: string): string;
begin
 Result := FUri.URLEncode(S);
end;

function TParses_.FindTagTextParam(Txt, Tg1, Tg2: string;
  IncludeTag: Boolean): string;
const
 StartPos :Integer = 1; //начало поиска тегов
var a, b, L :Integer;
    S :string;
    Buf :string;
    CorA,CorB :Integer; //коррекция копирования
begin // поиск первого включения тегов
  Result := '';
 if Trim(Txt) = '' then Exit;
 Buf := AnsiUpperCase(Txt);
 a := PosEx(AnsiUpperCase(Tg1), Buf, StartPos);
 a := a + Length(Tg1);
 b := PosEx(AnsiUpperCase(Tg2), Buf, a);
 L := b - a;
  // коэффициенты коррекции строки
 CorA := Length(Tg1);
 CorB := Length(Tg2) + Length(Tg1);
  // добавить ячейку
 if IncludeTag then
 begin // вместе с тегами поиска
  S := Copy(Txt, a - CorA, L + CorB);
  If Pos(Tg1, S) = 1 then
   Result := S;
 end
  else
 begin // занчение между тегами
  Result := Copy(Txt, a, L);
 end;
end;

end.

[Stilet]

но только выводит один и каждый ник раз десять и вконце пустые строки, прога зависает..

Ну я не претендую на идеальное решение, это всетки с твоим механизмом
Просто его нужно отладить один раз пошаговкой узнав что возвращают функции

[Пепел Феникса]

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
     s:string;
begin
 s:=Memo1.Text;
 Memo1.Clear;
 i:=Pos('javascript:insertuname2chat("',s);
 while i<>0 do
  begin
   i:=i+Length('javascript:insertuname2chat("');
   Memo1.Lines.Add(Copy(s,i,PosEx('"',s,i)-i));
   i:=PosEx('javascript:insertuname2chat("',s,i);
  end;
end;

из приведенного куска кода, вывело все три ника и все.

[grafgrial]

Сообщение от Пепел Феникса

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
     s:string;
begin
 s:=Memo1.Text;
 Memo1.Clear;
 i:=Pos('javascript:insertuname2chat("',s);
 while i<>0 do
  begin
   i:=i+Length('javascript:insertuname2chat("');
   Memo1.Lines.Add(Copy(s,i,PosEx('"',s,i)-i));
   i:=PosEx('javascript:insertuname2chat("',s,i);
  end;
end;

из приведенного куска кода, вывело все три ника и все.

А подскажи как написать чтобы он выводил все сообщения в полном виде
(22:03:40) Vovchik12: Stiv, сказали так, но мне еще нужно каждый проверять на наличие какого то слова в тексте после ника к примеру Vovchik12:
а то я написал у меня такой код обьемгый , у тебя же 5 строчек..

[Пепел Феникса]

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
     s:string;
begin
 s:=Memo1.Text;
 Memo1.Clear;
 Memo2.Clear;
 i:=Pos('javascript:insertuname2chat("',s);
 while i<>0 do
  begin
   i:=i+Length('javascript:insertuname2chat("');
   Memo1.Lines.Add(Copy(s,i,PosEx('"',s,i)-i));
   i:=PosEx('</b>:',s,i)+Length('</b>:');
   Memo2.Lines.Add(Copy(s,i,PosEx('</span>',s,i)-i));
   i:=PosEx('javascript:insertuname2chat("',s,i);
  end;
end;

код смайлов туда тоже войдет.(первое мемо ник отправителя, второе сообщение)