[noobofthenoobs]

Здравствуйте. Мне периодически нужно распознавать пачки картинок (что на них изображено) Использую Яндекс.картинки для распознавания. Написал небольшой парсер - кинул на форму twebbrowser и пару memo - для входных ссылок и выходных слов.

Примерно так:

Код:

procedure TForm1.Button1Click(Sender: TObject); //запуск поиска
begin
	webbrowser1.Tag:=0;
	webbrowser1.Navigate('https://yandex.ru/images/search?source=collections&rpt=imageview&url='+memo1.Lines[0]);		//ищем по первой ссылке
end;

Код:

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
  var doc:IHTMLDocument2;
begin
    application.ProcessMessages;
    if ((pdisp as iwebbrowser)= (ASender as TWebBrowser).DefaultInterface) then 	//проверяем, что фрейм полностью загрузился
    begin
        (Asender as twebbrowser).defaultInterface.Document.QueryInterface(IHtmlDocument2,doc);
        parse_yandex(doc.body.innerHTML, memo2); //передаю в функцию парсера html-текст и целевое memo
    (asender as Twebbrowser).tag:=(asender as Twebbrowser).tag+1;	//tag показывает, какую по счету ссылку обрабатывает webbrowser
    if (asender as Twebbrowser).tag<memo1.Lines.Count then		//пока не дошли до конца, продолжаем искать по следующей ссылке
      (asender as Twebbrowser).Navigate('https://yandex.ru/images/search?source=collections&rpt=imageview&url='+memo1.Lines[(asender as Twebbrowser).tag])

     end;

end;

Код:

procedure tform1.parse_yandex(curhtml:string;memo:tmemo);
var
st,m, count,mparsestart,mparseend,curline:integer;

begin
   m:=1;
   count:=0;
   memo.Lines.add('');
   curline:=memo.Lines.Count-1;
   st:=pos('Кажется, на изображении',curhtml); //начало поиска
   while m>0 do
   begin
   	count:=count+1;
          	m:=posex('Button2-Text',curhtml,st);
          	if m>0 then
          	begin
               		mparsestart:=m+14;                                         //получаем начало слова
            		mparseend:=posex('/span',curhtml,mparsestart)-1;           //получаем конец слова
            		memo.lines.BeginUpdate;
            		memo.Lines[curline]:=memo2.Lines[curline]+copy(curhtml,mparsestart,mparseend-mparsestart)+' ';
	                memo.lines.endUpdate;
            		st:=mparseend;                                             //переходим к следующей выдаче.
                 end;
     end;
end;

Вроде как все работает, но есть пару моментов:

- Можно ли как-то ускорить работу, не прибегая к многопоточности (я пробовал искать в нескольких потоках, но тогда периодически банят и нужно вводить капчи).
- Программа по ходу поиска новых картинок отжирает все больше памяти. Допустим найти 64 штуки обходится в 800-900 Мб, а если около сотни то может и вылететь с ошибкой о том, что недостаточно памяти, когда используемая память достигает 1.3-1.4 Гб (при этом на компьютере 16гб).

Что можете посоветовать?