Delphi в Интернет, блог Delphi программистов

Сразу скажу почему этот компонент Delphi я "окрестил" простейшим. Дело в том, что при парсинге выдачи Яндекса не используется никаких прокси в результате чего необходимо было выбирать временную паузу, чтобы не поисковик не блокировал запросы.

Естественно, что с таким компонентом Вы врядли соберете промышленный парсер, но на это расчёта и не было :) Цель - показать возможность разработки подобного компонента для парсинга средствами Delphi 2010 и использовать его в личных целях, например для отслеживания подъемов/падений Вашего сайта в выдаче.

В последствии Вы можете продолжить разработку и приспособить компонент под свои нужды.

Прежде, чем рассмотрим сам компонент, скажу, что за основу разработки был взят пример подобной утилиты из блога "Парсинг от А до Я" правда с некоторыми изменениями, о которых мы поговорим.

Итак, что необходимо знать, чтобы без особых проволочек начать использовать компонент:

1. Домен, который необходимо проверить
2. Максимальное количество сайтов, которые можно просмотреть после чего парсинг прерывается
3. Набор ключевых слов и фраз по которым необходимо проверить домен

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

На всякий случай приведу значения полей в компоненте:

Шаблон страницы с результатами выдачи:

'http://yandex.ru/yandsearch?p=%d&&text=%s&&numdoc=50';

Эта строка в последствии с помощью функции Format() преобразуется в необходимую форму, т.е. вместо %d подставляется номер страницы, а вместо %s - слово или фраза для поиска.

Регулярное выражение для RegExp:

< a tabindex="d{1,}".*href="(.*)" target="_blank"&gt;(.*)&lt;/a&gt;';

Временная задержка между скачиваниями страниц установлена на 2 секунды, что вполне достаточно, чтобы не получить в ответ страничку с каптчей от Яндекса.

Так как ничто не вечно под Луной, в том числе и HTML-содержания страниц Яндекса, то и регулярное выражение и шаблон страницы вынесены у компонента в общедоступные свойства. В случае чего можно будет изменить эти данные без коренной переделки всего компонента.

Теперь непосредственно сам алгоритм работы компонента.

После того, как компонент запускается в работу методом Activate или путем присвоения свойству Active значения true, из списка выбирается каждое ключевое слово или фраза, формируется запрос и отправляется в поисковик. При этом функция для скачивания одной страницы выдачи выглядит следующим образом:

function TYaParser.DownloadPage(cURL: string; var List: TStringList):boolean;
var Stream: IStream;
    stat: STATSTG;
begin
  Result:=false;
  try
    if URLOpenBlockingStream(nil,PChar(cURL), Stream,0,nil)=S_OK then
      begin
        try
          Stream.Stat(stat,STATFLAG_DEFAULT);
          List:=TStringList.Create;
          List.LoadFromFile(stat.pwcsName);
          Result:=true;
          Application.ProcessMessages;
        finally
          Stream:=nil;
        end;
  end; 
except
  if Assigned(FOnError) then
    OnError('Ошибка получения данных от Яндекс');
end;
end;

В принципе можно было обойтись банальным скачиванием страницы через URLDownloadFile, но я намеренно выбрал именно функцию URLOpenBlockingStream, которая имеет следующее описание:

Создает потока блокирующего типа для  URL и загрузки данных из Интернета. После загрузки данных, клиентское приложение или контроллер может читать данные, используя метод Read объекта IStream.

Используя эту функцию мы получаем в свое распоряжение две возможности: во-первых, мы можем как и раньше использовать для загрузки данных в TStringList обычный файл, который создается в процессе работы функции. Во-вторых, мы всегда можем, не прибегая к открытию файла, использовать в работе данные из потока IStream.

Рассмотрим более подробно вызов функции.

Для того, чтобы использовать функцию URLOpenBlockingStream вам необходимо подключить в uses два модуля: ActiveX (содержит описание интерфейса IStream) и URLMon (содержит описание функции).

Параметры, которые необходимо задать:

pCaller Указатель к управляющему интерфейсу IUnknown. Если клиентское приложение не является контроллером или COM-объектом, то параметр может быть установлен в NULL.
szURL Указатель на строку, содержащую значения URL.  Не может быть установлен в NULL.
PPStream Указатель на интерфейс IStream объекта потока. Поток создается непосредственно при работе функции.
dwReserved Защищен. Должен быть установлен в 0.
lpfnCB Указатель на интерфейс IBindStatusCallback. Может быть установлен в NULL.

Сам пример вызова можно посмотреть в листинге процедуры выше.

После выполнения функции в переменной типа IStream будет находится страничка выдачи, а сама функция может вернуть одно из следующих значений:

S_OK, если операция успешно

E_OUTOFMEMORY если недостаточно памяти для завершения операции

Проанализировать результат проще простого.

После того как поток данных получен Вы можете посмотреть его статистику. При работе с обычными потоками, например TMemoryStream мы могли, например, вызвав SizeOf(Stream) IStream посмотреть его размер. При работе с интерфейсом у нас возможностей по-больше.

Вся статистика по потоку может быть получена методом Stat:

Возвращает структуру типа  STATSTG для потока.

В качестве параметров метода выступает переменная типа statstg и указывается один из следующих флагов:

STATFLAG_DEFAULT запрос на получение всей статистики по потоку, в т.ч. pwcsName.
STATFLAG_NONAME в этом случае значение  pwcsName не возвращается, как и некоторые другие данные по потоку, что значительно экономит время и ресурсы.
STATFLAG_NOOPEN Не реализовано.

Сама структура STATSTG выглядит следующим образом:

typedef struct tagSTATSTG {
  LPOLESTR pwcsName;
  DWORD type;
  ULARGE_INTEGER cbSize;
  FILETIME mtime;
  FILETIME ctime;
  FILETIME atime;
  DWORD grfMode;
  DWORD grfLocksSupported;
  CLSID clsid;
  DWORD grfStateBits;
  DWORD reserved;
} STATSTG;

pwcsName - указатель на Unicode-строку, содержащую имя файла в кэше. Т.е., именно это нам и надо, чтобы загружать данные в TStringList из файла, а не из потока.
type - тип объекта
cbSize - размер объекта.
mtime - содержит время последнего изменения объекта
ctime - время создания объекта
atime - время последнего доступа к объекту.
grfMode - содержит метод доступа к объекту, когда тот был открыт
grfLocksSupported - вид блокировки, который поддерживает объект
clsid - идентификатор класса для объекта
grfStateBits - текущее положение битов в потоке. То же самое значение, что у обычных потоков возвращается через TStream.Position
reserved - зарезервировано на будущее.

Таким образом, как видите, используя метод Stat у нашего потока мы можем получить любые данные вплоть до времени последнего доступа, размере данных и прочих радостях.

Я же использовал только значение pwcsName, чтобы загрузить все данные в переменную и отправить в дальнейший путь, т.е. на разделочный стол под названием RegExp :)

Сама процедура парсинга практически не претерпела изменения по сравнению с той, которая использовалась в утилите, за одним небольшим исключением. На всякий случай приведу весь листинг:

function  TYaParser.FindPos(Key: string):integer; //поиск позиции домена
var Page,i,LinkNum:integer;
    TextList:TStringList;
    isFind: boolean;
    RE : IRegExp2;
    mc : MatchCollection;
    mm : Match;
    sm : SubMatches;
    FindedLink :string;
begin
  Page:=0;
  LinkNum:=0;
  while (isFind=false)and(LinkNum<FCountPos) do
    begin
      if FActive then
        begin
          if DownloadPage(Format(FNextPage,[Page,Key]), TextList) then
            begin
              TextList.Text:=Utf8ToAnsi(TextList.Text);//перекодируем в ANSI
                                                       //начинаем парсить страницу
              try
                try
                  RE:=coRegExp.Create as IRegExp2;
                  RE.Pattern:=FRegular;
                  RE.Global:=true;
                  RE.IgnoreCase:=true;
                  RE.Multiline:=true;
                  mc:=RE.Execute(TextList.Text) as MatchCollection;
                  for i:=0 to mc.Count-1 do //проходим по порядку все совпадения
                    begin
                      mm:=mc[i] as Match;
                      sm:=mm.SubMatches as SubMatches;
                      FindedLink:=sm.Item[0];
                      inc(LinkNum);
                      if Pos(FDomain,FindedLink)>0 then
                         begin
                           isFind:=true;
                           Result:=LinkNum;
                           break;
                         end;
                    end;
                except
                  if Assigned(FOnError) then
                    OnError('Ошибка парсинга полученных данных');
                end;
               if mc.Count = 0 then LinkNum:=FCountPos;//если совпадения не были найдены
            finally
               Re:=nil;
               FreeAndNil(TextList);
            end;
          inc(Page);
          Sleep(FTimeShift);//ждем заданное время перед повторным скачиванием
        end
      else
        begin
          Result:=-1;//если была ошибка при скачивании страницы, то результат не достигнут
          Exit;
        end;
    end
  end;
end;

Изменения коснулись переменной

RE    : IRegExp2;

ранее она была типа TRegExp, сейчас это интерфейс. Соответственно и изменилось создание объекта:

RE:=coRegExp.Create as IRegExp2;

Изменения произошли потому, что объект типа TRegExp ни в какую не хотел создаваться простым способом:

RE:=TRegExp.Create(self)

Почему-то объект сразу после создания сам себя и убивал. Если кто-то объяснит причину такого самоубийственного поведения объекта, то буду чрезвычайно Вам благодарен.
В остальном процедура парсинга та же: качаем данные до тех пор пока не найдем наш домен либо пока не дойдем до максимального значения просматриваемых ссылок.

Вот пожалуй и все ключевые моменты для разработки компонента. Как говорится: дёшего и сердито. Теперь непосредственно сам компонент, его свойства и методы.

Active: boolean - указывает состояние компонента, а также запускает или останавливает его работу.

CountPos : integer - максимальное количество позиций в выдаче, которые допускает просмотреть. После достижения этого значения парсинг по запросу прерывается

Domain : string - домен для проверки.

KeyWords: TStringList - список слов или ключевых фраз по которым проводится провека выдачи Яндекс.

NextPage: string - шаблон страницы с результатами выдачи

Regular: string - регулярное выражение для парсинга выдачи Яндекс.

TimeShift : integer - временная задержка (мс) между запросами. По непроверенным данным оптимальной является задержка в 1500-2000 мс. при меньших значениях можно схватить бан по IP на некоторое время.

Также имеется свойство Results: array of TResult, содержащее данные о позиции домена в выдаче.

Тип TResult определен следующим образом:

type
  TResult = record
    ResString  : string; //вспомогательная строка
    Keyword : string;  //ключевое слово или фраза
    Position: integer; //позиция домена
  end;

Методов у компонента всего два:

Activate - запускает компонент в работу

Deactivate - прерывает работу компонента

Также, для получения данных можно использовать следующие события компонента:

TOnGetSingleResult = procedure (const Keyword, ResString: string; Position: integer) of object;

Вызывается при получении данных об одном ключевом слове или фразе

TOnGetAllResults = procedure (const Results: TResults) of object;

Вызывается после получения всех данных

TOnError = procedure (const Error: string) of object;

Вызывается при возникновении исключительной ситуации

TOnDeactivate = procedure of object;

Вызывается при деактивации компонента

TOnActivate = procedure of object;

вызывается при активации объекта.

Как видите, компонент достаточно простой и для его использования не требуется никаких особых знаний про парсинг, особенности работы с поисковиками и т.д. Просто укладываете компонент на форму, указываете домен, список ключевых слов и ждете окончания работы. Все просто :)

Сам компонент Вы можете скачать здесь.

Мой блог находят по следующим фразам

• программирование Лазарус начало
• основы работы Delphi Excel
• rad 2010 обновить
• мотиватор для программиста
• tprocess lazarus
• Delphi хук на клавиатуру

Делись!	Загружай!	Плюсуй!
	Отправить PDF на

Комментарии (5)

• SynCap пишет:
  30 Янв 2010 в 12:49 дп

  RE:=TRegExp.Create(self)
  Почему-то объект сразу после создания сам себя и убивал. Если кто-то объяснит причину такого самоубийственного поведения объекта, то буду чрезвычайно Вам благодарен.
  в спецификациях JScript и VBScript — объект RegExp — глобальный, единственный и является частью DOM. Соответственно, если для ускорения работы с регекспами в среде объекта документа нужно создать несколько регэкспов, необходимо создавать объекты функциями RegExp(), либо через интерфейс, как собсно и сделано.

• Vlad пишет:
  30 Янв 2010 в 1:31 пп

  Первый раз слышу о таком поведении объекта в Delphi…Мог бы понять, если б самоубийство было в таком куске кода:
  with TRegExp.Create(self) do
begin
[....]
end;
  и то после того, как выполнен код в begin…end; Можно проверить работу и через IRegExp (вроде в том же модуле описан), но поможет ли это вам — незнаю.

• Seo Ghost пишет:
  17 Авг 2010 в 8:50 пп

  Компонент перестал работать. В любом случае выдает «Успешно 0″.

• monstrik пишет:
  31 Авг 2010 в 7:22 пп

  и правда, постоянно «Успешно 0″

• Vlad пишет:
  31 Авг 2010 в 7:50 пп

  «Успешно» означает, что компонент успешно скачал страницу и выполнил ваш запрос. НОЛЬ говорит о том, что либо в результате действительно получено 0 страниц, либо то, что исходный код на страницу Яндекса изменился и прежнее регулярное выражение уже не работает и его необходимо сменить.

Ваш ответ