VPF::Подскажите подход к проблеме - Форум программистов

AlexLogos

Дата 2.2.2011, 11:13 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1

Народ, нужна небольшая консультация сразу по нескольким темам, которые затрагивает одна задача.
Хочу в своей программе создать робота который будет посылать запросы нескольким поисковикам, потом парсить полученные страницы, собирать результаты в единый HTML файл и отображать его в браузере.
Для начала я разобрал строки GET-запросов которые формируются поисковиками при формировании запроса. Сделал небольшой эмулятор который получив строку которую надо найти, преобразовывал ее в GET-запрос для определенного поисковика. Все было нормально пока не попробывал это сделать для запросов которые содержат символи кирилицы - нужно преобразовать кирилицу в спецсимволы типа %D%A... нашел функции

Код


function EncodeUrl(url: string; code: Boolean = true): string;
var
  u: URL_COMPONENTS;
  d, c: dword;
  hst, usr, pas, pth, ext: string;
  procedure ZeroStr(var s: string; var pch: PChar; var sz: dword);
  begin
    sz := INTERNET_MAX_PATH_LENGTH;
    SetLength(s, sz); FillChar(s[1], sz * SizeOf(Char), 0); pch := PChar(s);
  end;
begin
  // Part 1 - Split URL - распилить URL на составляющие
  FillChar(u, SizeOf(u), 0); u.dwStructSize := sizeOf(u); // готовим структуру u (запчасти) для работы
  ZeroStr(hst, u.lpszHostName, u.dwHostNameLength);
  ZeroStr(usr, u.lpszUserName, u.dwUserNameLength);
  ZeroStr(pas, u.lpszPassword, u.dwPasswordLength);
  ZeroStr(pth, u.lpszUrlPath, u.dwUrlPathLength);
  ZeroStr(ext, u.lpszExtraInfo, u.dwExtraInfoLength);
  InternetCrackUrl(PChar(url), Length(url), ICU_DECODE, u); // ломает URL на части
  // Составляющие урла: hst, usr, pas, pth, ext
  // Part 2 - Combine URL - собрать URL из составляющих
  d := INTERNET_MAX_PATH_LENGTH;
  if code=true then c := ICU_ESCAPE else c := 0; // ICU_ESCAPE - кодировать URL, 0 - нет
  SetLength(result, d); FillChar(result[1], d * SizeOf(Char), 0);
  InternetCreateUrl(u, c, PChar(result), d); // Собирает URL из частей
  result := copy(result, 1, d);
end;

точнее даже не нашел - а подарили на этом сайте)))) Все хорошо, но не все запросы преобразованные ею подходят - поисковик преобразовывает кирилицу по-другому.
Далее. Результаты поиска тоже все в разных кодировках - этот вопрос я пока тоже не решил.
Вот думаю может как-то с помощью Delphi можна автоматически заполнить форму для поиска и отдать ответственность за результат поиска браузеру?
Что посоветуете?

bagos

Дата 2.2.2011, 11:20 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 275
Регистрация: 17.6.2006

Репутация: нет
Всего: 1

AlexLogos, на мой непрофи взгляд лучше заполнять форму, пусть поисковик сам обрабатывает,переводит в нужные ему кодировки и обратно. А вам будет выводить нормальный текст. Или я чето не понял?

AlexLogos

Дата 2.2.2011, 11:46 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1

Все ти верно понял. Я уже ищу материал по теме автоматизации заполнения формы. Но меня мучает то что предыдущий подход не пошел, а нерешенная задача - это минус мне...

AlexLogos

Дата 2.2.2011, 12:28 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1

Теперь вопрос на засыпку. Как заполнить форму и отправить запрос (программно нажать на кнопку поиск)? smile

bagos

Дата 2.2.2011, 12:32 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 275
Регистрация: 17.6.2006

Репутация: нет
Всего: 1

далеко не ходи, на форуме не раз обсуждалась тема заполнения формы и отправки, вот из последних
Заполнение формы

AlexLogos

Дата 2.2.2011, 13:07 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1

Одно из решений для Гугла в трех кнопках:
Зайти на сайт

Код


WebBrow.Navigate('www.google.com.ua\advanced_search');

Заполнить поля

Код


    MMLog.Lines.Add('');
    if EdAllWords.Text<>'' then
      if FillForm(WebBrow,'as_q',EdAllWords.Text) = False then
        MMLog.Lines.Add('Error Fill field as_g - AllWords');
        //ShowMessage('Error. Field not available or no Form found.');
    if EdExactPhrase.Text<>'' then
      if FillForm(WebBrow,'as_epq',EdExactPhrase.Text) = False then
        MMLog.Lines.Add('Error Fill field as_epq - ExactPhrase');
        //ShowMessage('Error. Field not available or no Form found.');
    if EdAnyWord.Text<>'' then
      if FillForm(WebBrow,'as_oq',EdAnyWord.Text) = False then
        MMLog.Lines.Add('Error Fill field as_oq - AnyWord');
        //ShowMessage('Error. Field not available or no Form found.');
    if EdNoWords.Text<>'' then
      if FillForm(WebBrow,'as_eq',EdNoWords.Text) = False then
        MMLog.Lines.Add('Error Fill field as_eq - NoWords');
        //ShowMessage('Error. Field not available or no Form found.');

нажать на кнопку "Поиск в Google"

Код


var
ovElements: OleVariant;
Document: Variant;
i,j:cardinal;
begin
  Document:=WebBrow.Document;
  for  i := 0 to Document.forms.Length - 1 do
    begin
      ovElements := Document.forms.Item(i).elements;
      // iterate through elements
      for j := 0 to ovElements.Length - 1 do
      begin
        // when Submit button is found, try to click
        try
          if (CompareText(ovElements.item(j).tagName, 'INPUT') = 0) and (CompareText(ovElements.item(j).type, 'SUBMIT') = 0) and
            (ovElements.item(j).Value = 'Поиск в Google') then
              // Suchen fьr German
          begin
            ovElements.item(j).Click;
          end;
        except
        end;
      end;
    end;

Функция заполнения поля (похожа на предыдущий кусок)

Код


function FillForm(WebBrowser: TWebBrowser; FieldName: string; Value: string): Boolean;
var
ovElements: OleVariant;
Document: Variant;
i,j:cardinal;
begin
  Result:=False;
  Document:=WebBrowser.Document;
  for  i := 0 to Document.forms.Length - 1 do
    begin
      ovElements := Document.forms.Item(i).elements;
      // iterate through elements
      for j := 0 to ovElements.Length - 1 do
      begin
        // when Submit button is found, try to click
        try
          if (CompareText(ovElements.item(j).tagName, 'INPUT') = 0) and (CompareText(ovElements.item(j).type, 'TEXT') = 0) and
            (ovElements.item(j).Name = FieldName) then
              // Suchen fьr German
          begin
            ovElements.item(j).Value:=Value;
            Result:=True;
            Exit;
          end;
        except
        end;
      end;
    end;
end;

Теперь разсмотрю другие варианты smile

Добавлено через 14 минут и 54 секунды
Также можна получить текст страницы (у Гугла кодировка UTF8 (по крайней мере у меня была smile

))

Код


uses ..., ActiveX;

 function GetHTMLCode(WebBrowser: TWebBrowser; ACode: TStrings): Boolean;
 var
   ps: IPersistStreamInit;
   ss: TStringStream;
   sa: IStream;
   s: string;
 begin
   ps := WebBrowser.Document as IPersistStreamInit;
   s := '';
   ss := TStringStream.Create(s);
   try
     sa := TStreamAdapter.Create(ss, soReference) as IStream;
     Result := Succeeded(ps.Save(sa, True));
     if Result then ACode.Add(UTF8ToUnicodeString(ss.Datastring));
   finally
     ss.Free;
   end;
 end;

MetalFan

Дата 2.2.2011, 13:22 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 14
Всего: 128

Цитата(AlexLogos @ 2.2.2011, 11:13

)

поисковик преобразовывает кирилицу по-другому

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

--------------------

There are always someone smarter than you...

AlexLogos

Дата 2.2.2011, 13:34 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1

Да, верно, но тот метод что я написал выше избавляет меня от многих проблем. Как оказалось)))

AlexLogos

Дата 2.2.2011, 15:38 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1

На всякий случай допишу код который установит значение для выпадающего списка. если такое значение есть среди опцый

Код


       try
          if (CompareText(ovElements.item(j).tagName, 'select') = 0) and
            (ovElements.item(j).Name = FieldName) then
              // Suchen fьr German
          begin
            ovElements.item(j).Value:=Value;
            Result:=True;
            Exit;
          end;
        except
        end;

Вставить в функцию FillForm

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »