[noobofthenoobs]

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

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

Код:

1 2 3 4 5

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;

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

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;

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

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гб).

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