Поиск по тексту

[khofa]

Здравствуйте! сделал поиск по форуму, почитал, но того, что искал не нашел....
Вот что мне надо и что получилось: через idhttp я сделал запрос кода страницы, получилось, и содержимое отправил на edit1.text, теперь я хочу сделать поиск ссылок по маске, для начала сделал поиск первых 10 любых ссылок, т.е.

procedure TForm1.Button4Click(Sender: TObject);
var a:string;
    i,q,w:integer;
begin
  a:=edit2.Text;
  ListBox1.Items.Clear;
  for i:=0 to 10 do
  begin
    q:=pos('<a ',edit1.Text);
    w:=pos('</a>',edit1.Text);
    listbox1.Items[i]:=copy(edit1.Text,q,w+4);
    q:=0;
    w:=0;
  end;
end;

но запустив, я понял, что эта прога не работает..... она берет самую первую ссылку, и копирует ее 10 раз, как мне сделать правильно? =( я уже 3-ий день голову ломаю =(
ЗЫ. вариант

  for i := 0 to Webbrowser1.OleObject.Document.links.Length - 1 do
    Listbox1.Items.Add(Webbrowser1.OleObject.Document.Links.Item(i));

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

[russian-stalker]

procedure TForm1.Button4Click(Sender: TObject);
var a,s:string;
    i,q,w:integer;
begin
  a:=edit2.Text;
  s:=edit1.text;
  ListBox1.Items.Clear;
  for i:=0 to 10 do
  begin
    q:=pos('<a ',s);
    w:=pos('</a>',s);
    listbox1.Items[i]:=copy(s,q,w-q+4);
    delete(s,q,w-q+4);
  end;
end;

[khofa]

я подредактировал код:

procedure TForm1.Button4Click(Sender: TObject);
var a,s:string;
    i,q,w:integer;
begin
  a:=edit2.Text;
  s:=edit1.Text;
  ListBox1.Items.Clear;
  for i:=0 to 10 do
  begin
    q:=pos('http://',s);
    w:=pos('">',s);
    listbox1.Items[i]:=copy(s,q,w+4);
    delete(s,q,w+4);
  end;
end;

вот что получается:

в чем же дело? пробовал ставить другие значения... но все же муть какая то получается....

[evg_m]

начиная с Delphi 7 есть posEx

q:=0;
  for i:=0 to 10 do
  begin
    q:=posEx('http://',s,q);
    w:=posEx('">',s,q+1);
//   listbox1.Items[i]:=copy(s,q,w+4);
    listbox1.Items[i]:=copy(s,q,w+1-q);
//третий параметр ДЛИНА(число копируемых) а не позиция
    q:=w; //    delete(s,q,w+4);
  end;

[khofa]

posEx ошибку выдает? надо отдельно в uses подключать? если да, то какой компонент?...

[Kotofff]

Нужен модуль StrUtils

[khofa]

function GetFiles(Path:String; Full: Boolean = False):TStrings;
   Var
   Rec:TSearchRec;
   TMP:TStrings;
   ls: String;
   i: integer;
begin
  Result:=TStringList.Create;
  if Path[Length(Path)]<>'\' Then Path:=Path+'\';
  //ChDir(Path);
  if FindFirst(Path+'\*.*',faAnyFile,Rec)=0 then
    begin
     if (Rec.Name<>'.')and(Rec.Name<>'..') then
       if (Rec.Attr and faDirectory) <> 0 then begin
       TMP:=GetFiles(Path+Rec.Name,True);
       Result.AddStrings(TMP);
       TMP.Free;
       end else Result.Add(Path+Rec.Name);

     while FindNext(Rec)=0 do
       begin
        if (Rec.Name<>'.')and(Rec.Name<>'..') then
         if (Rec.Attr and faDirectory) <> 0 then begin
         TMP:=GetFiles(Path+Rec.Name,True);
         Result.AddStrings(TMP);
         TMP.Free;
         end else Result.Add(Path+Rec.Name);
       end;
    end;

if not Full then
  for i:=0 to Result.Count-1 do
   begin
     ls := Result[i];
     Delete(ls,1,Length(Path));
     Result[i] := ls;
   end;
  FindClose(Rec);
end;

procedure TForm1.Button1Click(Sender: TObject);
var s:string;
    a,b,d,i:integer;
begin
ListBox1.Items.Assign(GetFiles(edit1.text));
d:=listbox1.Items.count;
for i:=0 to d-1 do
if pos('html',ListBox1.Items[i])<>0 then
begin
Memo1.Lines.LoadFromFile(ListBox1.Items[i]); // загрузка
s:=memo1.text;
a:=pos(edit2.text,s);
b:=pos(edit3.Text,s)+length(edit3.Text)-1;
delete (s,a,b);
memo1.text:=s;
Memo1.Lines.SaveToFile(ListBox1.Items[i]); // сохранение
end;
ShowMessage('обработка закончена');
end;

почему в этом коде начало режется все нормально, а конец, где должен заканчиваться урезание не правильно..... причем вычислял посимвольно, это расстояние всегда меняется....
ЗЫ. скачал он-лайн учебник. а там много ненужного(меню, реклама...) так вот хотел все прочистить =)