Project Structure

• WebFind.dpr
• WebFindF.pas
• FindTh.pas
• WebFindF.dfm

program WebFind;

uses
  Forms,
  WebFindF in 'WebFindF.pas' {Form1},
  FindTh in 'FindTh.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

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.

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;

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.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 := 'Elaborating 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.

object Form1: TForm1
  Left = 166
  Top = 161
  Width = 445
  Height = 405
  Caption = 'Web Find'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 0
    Top = 265
    Width = 437
    Height = 7
    Cursor = crVSplit
    Align = alTop
  end
  object StatusBar1: TStatusBar
    Left = 0
    Top = 359
    Width = 437
    Height = 19
    Panels = <>
    SimplePanel = True
  end
  object Memo2: TMemo
    Left = 0
    Top = 272
    Width = 437
    Height = 87
    Align = alClient
    TabOrder = 1
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 437
    Height = 49
    Align = alTop
    TabOrder = 2
    DesignSize = (
      437
      49)
    object Label1: TLabel
      Left = 18
      Top = 5
      Width = 159
      Height = 11
      Caption = 'Search (use + to separate values)'
    end
    object BtnFind: TButton
      Left = 353
      Top = 16
      Width = 75
      Height = 23
      Anchors = [akTop, akRight]
      Caption = '&Find'
      TabOrder = 0
      OnClick = BtnFindClick
    end
    object EditSearch: TEdit
      Left = 16
      Top = 20
      Width = 316
      Height = 21
      Anchors = [akLeft, akTop, akRight]
      TabOrder = 1
      Text = 'Borland'
    end
  end
  object ListBox1: TListBox
    Left = 0
    Top = 49
    Width = 437
    Height = 216
    Align = alTop
    ItemHeight = 13
    TabOrder = 3
    OnClick = ListBox1Click
  end
end