[Alien666]

Здравствуйте, уважаемые форумчане!

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

Вопрос состоит в следующем:
в книге Марко Кэнту "Delphi 7 для профессионалов" в главе 19 "Интернет-программирование: сокеты и Indy" в подзаголовке "Захват HTTP-содержания" приводится листинг небольшой поисковой программки WebFind:

Программа соединяется с сайтом Google, производит поиск по ключевому слову и запоминает первые 100 найденных ссылок. Она не показывает HTML-код страницы, а выбирает адреса сайтов, занося их в список. В отдельный список заносятся описания этих сайтов (описание конкретного сайта становится доступным при щелчке по его адресу). Таким образом, программа демонстрирует две технологии: извлечение веб-страницы и синтаксический разбор HTML-кода.

Листинг 1. WebFindF.pas:

Код:

unit WebFindF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    BtnFind: TButton;
    EditSearch: TEdit;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Memo2: TMemo;
    Panel1: TPanel;
    Splitter1: TSplitter;
    ListBox1: TListBox;
    procedure BtnFindClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    DetailsList: TStrings;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  FindTh;

const
  strSearch = 'http://www.google.com/search?as_q=';

procedure TForm1.BtnFindClick(Sender: TObject);
var
  FindThread: TFindWebThread;
begin
  // create suspended, set initial values, and start
  FindThread := TFindWebThread.Create (True);
  FindThread.FreeOnTerminate := True;
  FindThread.strUrl := strSearch + EditSearch.Text +
    '&num=100'; // grab the first 100 entries
  FindThread.Resume;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  Memo2.Text := DetailsList[ListBox1.ItemIndex];
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DetailsList := TStringList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DetailsList.Free;
end;

end.

Листинг 2. FindTh.pas:

Код:

unit FindTh;

interface

uses
  Classes, IdComponent, SysUtils, IdHTTP;

type
  TFindWebThread = class(TThread)
  protected
    Addr, Text, Status: string;
    procedure Execute; override;
    procedure AddToList;
    procedure ShowStatus;
    procedure GrabHtml;
    procedure HtmlToList;
    procedure HttpWork (Sender: TObject;
      AWorkMode: TWorkMode; const AWorkCount: Integer);
  public
    strUrl: string;
    strRead: string;
  end;

implementation

{ TFindWebThread }

uses
  WebFindF, wininet;

procedure TFindWebThread.AddToList;
begin
  if Form1.ListBox1.Items.IndexOf (Addr) < 0 then
  begin
    Form1.ListBox1.Items.Add (Addr);
    Form1.DetailsList.Add (Text);
  end;
end;

procedure TFindWebThread.Execute;
begin
  GrabHtml;
  HtmlToList;
  Status := 'Done with ' + StrUrl;
  Synchronize (ShowStatus);
end;

procedure TFindWebThread.GrabHtml;
var
  Http1: TIdHTTP;
begin
  Status := 'Sending query: ' + StrUrl;
  Synchronize (ShowStatus);
  Http1 := TIdHTTP.Create (nil);
  try
    Http1.Request.UserAgent := 'User-Agent: NULL';
    Http1.OnWork := HttpWork;
    strRead := Http1.Get (StrUrl);
  finally
    Http1.Free;
  end;
end;

procedure TFindWebThread.HtmlToList;
var
  strAddr, strText: string;
  nText: integer;
  nBegin, nEnd: Integer;
begin
  Status := 'Extracting data for: ' + StrUrl;
  Synchronize (ShowStatus);

  strRead := LowerCase (strRead);
  repeat
    // find the initial part HTTP reference
    nBegin := Pos ('href=http', strRead);
    if nBegin <> 0 then
    begin
      // get the remaining part of the string, starting with 'http'
      strRead := Copy (strRead, nBegin + 5, 1000000);
      // find the end of the HTTP reference
      nEnd := Pos ('>', strRead);
      strAddr := Copy (strRead, 1, nEnd - 1);
      // move on
      strRead := Copy (strRead, nEnd + 1, 1000000);
      // add the URL if 'google' is not in it
      if Pos ('google', strAddr) = 0 then
      begin
        nText := Pos ('</a>', strRead);
        strText := copy (strRead, 1, nText - 1);
        // remove cached references and duplicates
        if (Pos ('cached', strText) = 0) then
        begin
          Addr := strAddr;
          Text := strText;
          AddToList;
        end;
      end;
    end;
  until nBegin = 0;
end;

procedure TFindWebThread.HttpWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  Status := 'Received ' + IntToStr (AWorkCount) + ' for ' + strUrl;
  Synchronize (ShowStatus);
end;

procedure TFindWebThread.ShowStatus;
begin
  Form1.StatusBar1.SimpleText := Status;
end;

end.

Там же в книге есть оговорка:

Программа WebFind работала без ошибок с сайтом Google во время написания и тестирования книги. Однако программное обеспечение сайта может со временем измениться, и WebFind может начать работать с ошибками. Так было с программой, описанной в книге Delphi 6 (серия «Для профессионалов»). В ней не был указан параметр user agent, и после замены программного обеспечения Google этот сервер стал блокировать запросы. Проблема решалась указанием любого значения user agent.

Так вот, я менял User-Agent, но все равно ListBox1 остается пустым, хотя в статусной строке значится "Done with http://www.google.com/search?as_q=Borland&num=100".
Подскажите, что не так? Может есть другие пути реализации?

p.s. версия - Delphi 7

[Alien666]

Неужели никто не знает?