////////////////////////////////////////////////////////////////////////////////
//                                 DATASTEAD                                  //
//                     THttpScan Delphi Component Demo                        //
//                                                                            //
//                         http://www.datastead.com                           //
//                           contact@datastead.com                            //
////////////////////////////////////////////////////////////////////////////////

unit Demo_;

interface

Uses Dialogs, ComCtrls, ExtCtrls, Controls, StdCtrls,
  Classes, SysUtils, Forms, HttpScan, Mask;

type
  TForm1 = class(TForm)
    Edit3: TEdit;
    Edit6: TEdit;
    UpDown1: TUpDown;
    UpDown2: TUpDown;
    Button1: TButton;
    Button2: TButton;
    Memo7: TMemo;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Log: TTabSheet;
    StatusBar1: TStatusBar;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Edit2: TEdit;
    Label5: TLabel;
    TabSheet2: TTabSheet;
    Memo6: TMemo;
    Memo5: TMemo;
    Label2: TLabel;
    Label6: TLabel;
    TabSheet3: TTabSheet;
    GroupBox1: TGroupBox;
    RichEdit1: TRichEdit;
    GroupBox2: TGroupBox;
    Memo8: TMemo;
    RichEdit2: TRichEdit;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    TabSheet4: TTabSheet;
    GroupBox4: TGroupBox;
    Label10: TLabel;
    Label12: TLabel;
    Label11: TLabel;
    Label13: TLabel;
    Edit8: TEdit;
    Edit9: TEdit;
    RadioGroup1: TRadioGroup;
    MaskEdit1: TMaskEdit;
    Edit4: TEdit;
    Memo9: TMemo;
    TabSheet5: TTabSheet;
    Memo10: TMemo;
    Edit5: TEdit;
    Edit7: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    Memo11: TMemo;
    RichEdit3: TRichEdit;
    CheckBox5: TCheckBox;
    HttpScan1: THttpScan;
    RadioGroup2: TRadioGroup;
    RadioGroup3: TRadioGroup;
    OpenDialog1: TOpenDialog;
    Button3: TButton;
    Label14: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    CheckBox1: TCheckBox;
    Memo12: TMemo;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Edit6KeyPress(Sender: TObject; var Key: Char);
    procedure HttpScan1Error(Sender: TObject; Url: String;
      ErrorCode: Cardinal; ErrorMsg: String);
    procedure HttpScan1Working(Sender: TObject; Working_: Boolean);
    procedure HttpScan1UpdatedStats(Sender: TObject; InQueue, Downloading,
      ToAnalyze, Done, Retries, Errors: Integer);
    procedure HttpScan1PageReceived(Sender: TObject; HostName, Url, Head, Body: String);
    procedure Exit1Click(Sender: TObject);
    procedure UpDown2Click(Sender: TObject; Button: TUDBtnType);
    procedure UpDown1Click(Sender: TObject; Button: TUDBtnType);
    procedure FormCreate(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure RadioGroup1Click(Sender: TObject);
    procedure Edit8Change(Sender: TObject);
    procedure Edit4Change(Sender: TObject);
    procedure Edit9Change(Sender: TObject);
    procedure MaskEdit1Change(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure CheckBox4Click(Sender: TObject);
    procedure Memo8Change(Sender: TObject);
    procedure Memo9Change(Sender: TObject);
    procedure HttpScan1MetaTag(Sender: TObject; Url, ReferringUrl, TagType,
      Tag1stAttrib, Tag1stValue, Tag2ndAttrib, Tag2ndValue, Tag3rdAttrib,
      Tag3rdValue: String);
    procedure Edit5Change(Sender: TObject);
    procedure Edit7Change(Sender: TObject);
    procedure CheckBox5Click(Sender: TObject);
    procedure Memo11Change(Sender: TObject);
    procedure RadioGroup2Click(Sender: TObject);
    procedure RadioGroup3Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure HttpScan1LinkFound(Sender: TObject; UrlFound, TypeLink,
      FromUrl, HostName, UrlPath, UrlPathWithFile, FileName,
      ExtraInfos: String; Port: Integer; var WriteToFile: String;
      HrefOrSrc: Char; CountArea: Integer; var FollowIfHtmlLink: Boolean);
  private
    CountLinks: integer;
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//------------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
//------------------------------------------------------------------------------
begin
   with HttpScan1 do begin
      CheckBox1.Checked := AllowRedirect;
      CheckBox3.Checked := KeywordsFilterEnabled;
      CheckBox4.Checked := KeywordsLimiterEnabled;
      CheckBox5.Checked := TypeFilterEnabled;

      UpDown1.Position :=  DepthSearchLevel;
      UpDown2.Position :=  ConcurrentDownloads;

      RadioGroup1.ItemIndex := integer (ProxyType);
      RadioGroup2.ItemIndex := integer (LinkScan);
      RadioGroup3.ItemIndex := integer (LinkReport);

      Edit2.Text := FileOfResults;
      Edit4.Text := ProxyUser;
      Edit5.Text := inttostr (Retries);
      Edit7.Text := inttostr (TimeOut);
      Edit8.Text := ProxyAddress;
      Edit9.Text := IntToStr (ProxyPort);

      MaskEdit1.Text := ProxyPassword;
      Memo8.Text := KeywordsLimiter;
      Memo9.Text := KeywordsFilter;
      Memo11.Text := TypeFilter;
   end;
   Memo1.Text := '';
end;

//------------------------------------------------------------------------------
procedure TForm1.HttpScan1Working(Sender: TObject; Working_: Boolean);
//------------------------------------------------------------------------------
begin
   if Working_ then begin
      Statusbar1.SimpleText := '   Working...';
   end
   else begin
      Statusbar1.SimpleText := StatusBar1.SimpleText + '     Done.';
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.HttpScan1PageReceived(Sender: TObject; HostName, Url, Head, Body: String);
//------------------------------------------------------------------------------
var
   i: integer;
   Done: boolean;
   Found: boolean;
begin
   Memo2.Text := Head;
   Memo3.Text := lowercase (Body);
   Done := false;
   Found := false;
   i := 0;
   while not Done do begin
      if i = Memo5.Lines.Count then begin
         Done := true;
      end
      else begin
         if pos (Memo5.Lines[i], Memo3.Text) > 0 then begin
            Found := true;
            Done := true;
         end;
         inc (i);
      end;
   end;
   if Found then begin
      Memo6.Lines.Add (Url);
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.HttpScan1LinkFound(Sender: TObject; UrlFound, TypeLink,
  FromUrl, HostName, UrlPath, UrlPathWithFile, FileName,
  ExtraInfos: String; Port: Integer; var WriteToFile: String;
  HrefOrSrc: Char; CountArea: Integer; var FollowIfHtmlLink: Boolean);
//------------------------------------------------------------------------------
begin
   // if nothing is assigned to WriteToFile, all the links are written to the result file in a default format.

   // if you want a link not to be written to the result file, add a WriteToFile := ''; E.g:
   // if TypeLink <> 'mail' then begin
   //    WriteToFile := '';
   // end;

   // if you want to write you own fields according to a condition of your choice, set the line to write in the WriteToFile string. E.g:
   // WriteToFile := UrlFound + ';' + TypeLink + ';' + Hostname;

   inc (CountLinks);

   if Memo1.Lines.Count > 500 then begin
      Memo1.Text := '';
   end;
   Memo1.Lines.Add (Format ('%-4s ', [typelink]) + ' ' + UrlFound);

   StatusBar1.SimpleText := '   ' + IntToStr (CountLinks) + ' links found...';
end;

//------------------------------------------------------------------------------
procedure TForm1.HttpScan1UpdatedStats(Sender: TObject; InQueue,
  Downloading, ToAnalyze, Done, Retries, Errors: Integer);
//------------------------------------------------------------------------------
begin
   Memo7.Text :=    '   IN QUEUE : ' + inttostr (InQueue);
   Memo7.Lines.Add ('downloading : ' + inttostr (Downloading));
   Memo7.Lines.Add (' to analyze : ' + inttostr (ToAnalyze));
   Memo7.Lines.Add ('       DONE : ' + inttostr (Done));
   Memo7.Lines.Add ('    retries : ' + inttostr (Retries));
   Memo7.Lines.Add ('     errors : ' + inttostr (Errors));
end;

//------------------------------------------------------------------------------
procedure TForm1.HttpScan1MetaTag(Sender: TObject; Url, ReferringUrl,
  TagType, Tag1stAttrib, Tag1stValue, Tag2ndAttrib, Tag2ndValue,
  Tag3rdAttrib, Tag3rdValue: String);
//------------------------------------------------------------------------------
begin
   memo10.Lines.Add ('');
   memo10.Lines.Add (Url);
   memo10.Lines.Add ('----------------------------------');
   memo10.Lines.Add (TagType);
   memo10.Lines.Add (Format ('%-15s ', [Tag1stAttrib]) + Tag1stValue);
   if Tag2ndAttrib <> '' then begin
      memo10.Lines.Add (Format ('%-15s ', [Tag2ndAttrib]) + Tag2ndValue);
   end;
   if Tag3rdAttrib <> '' then begin
      memo10.Lines.Add (Format ('%-15s ', [Tag3rdAttrib]) + Tag3rdValue);
   end;
   memo10.Tag := memo10.Tag + 7;
end;

//------------------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   if HttpScan1.Stop then begin
      StatusBar1.SimpleText := StatusBar1.SimpleText + '    stopping...';
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.Button2Click(Sender: TObject);
//------------------------------------------------------------------------------
var
   Ok : boolean;
begin
   Button2.Enabled := false;
   HttpScan1.FileOfResults := Edit2.Text;
   HttpScan1.TypeFilter := Memo11.Text;
   Ok := HttpScan1.Start (Memo12.text);

   if Ok then begin
      CountLinks := 0;

      Memo12.Text := HttpScan1.StartingUrl;
      Memo1.Text := '';
      Memo2.Text := '';
      Memo3.Text := '';
      Memo4.Text := '';
      Memo6.Text := '';
      Memo10.Text := '';
   end;
   Button2.Enabled := true;
end;

//------------------------------------------------------------------------------
procedure TForm1.Button3Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   OpenDialog1.FileName := 'c:\result.txt';
   if OpenDialog1.Execute then begin
      Edit2.Text := OpenDialog1.FileName;
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
//------------------------------------------------------------------------------
begin
   if Key = chr(13) then begin
      Button2Click (Sender);
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
//------------------------------------------------------------------------------
begin
   Key := char(0);
end;

//------------------------------------------------------------------------------
procedure TForm1.Edit6KeyPress(Sender: TObject; var Key: Char);
//------------------------------------------------------------------------------
begin
   Key := char(0);
end;

//------------------------------------------------------------------------------
procedure TForm1.HttpScan1Error(Sender: TObject; Url: String; ErrorCode: Cardinal; ErrorMsg: String);
//------------------------------------------------------------------------------
begin
   Memo4.Lines.Add ('ERROR ' + inttostr (ErrorCode) + ' : ' + Url);
end;

//------------------------------------------------------------------------------
procedure TForm1.UpDown2Click(Sender: TObject; Button: TUDBtnType);
//------------------------------------------------------------------------------
begin
   HttpScan1.ConcurrentDownloads := StrToIntDef (Edit6.Text, 2);
end;

//------------------------------------------------------------------------------
procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
//------------------------------------------------------------------------------
begin
   HttpScan1.DepthSearchLevel := StrToIntDef (Edit3.Text, 3);
end;

//------------------------------------------------------------------------------
procedure TForm1.RadioGroup1Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.ProxyType := TProxyType (RadioGroup1.ItemIndex);
end;

//------------------------------------------------------------------------------
procedure TForm1.Edit8Change(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.ProxyAddress := Edit8.Text;
end;

//------------------------------------------------------------------------------
procedure TForm1.Edit4Change(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.ProxyUser := Edit4.Text;
end;

//------------------------------------------------------------------------------
procedure TForm1.Edit9Change(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.ProxyPort := StrToIntDef (Edit9.Text, 80);
end;

//------------------------------------------------------------------------------
procedure TForm1.MaskEdit1Change(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.ProxyPassword := MaskEdit1.Text;
end;

//------------------------------------------------------------------------------
procedure TForm1.CheckBox3Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.KeywordsFilterEnabled := CheckBox3.Checked;
end;

//------------------------------------------------------------------------------
procedure TForm1.CheckBox4Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.KeywordsLimiterEnabled := CheckBox4.Checked;
end;

//------------------------------------------------------------------------------
procedure TForm1.Memo8Change(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.KeywordsLimiter := Memo8.Text;
end;

//------------------------------------------------------------------------------
procedure TForm1.Memo9Change(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.KeywordsFilter := Memo9.Text;
end;

//------------------------------------------------------------------------------
procedure TForm1.Edit5Change(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.Retries := StrToIntDef (Edit5.Text, 3);
end;

//------------------------------------------------------------------------------
procedure TForm1.Edit7Change(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.TimeOut := StrToIntDef (Edit7.Text, 300);
end;

//------------------------------------------------------------------------------
procedure TForm1.CheckBox5Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.TypeFilterEnabled := CheckBox5.Checked;
end;

//------------------------------------------------------------------------------
procedure TForm1.Memo11Change(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.TypeFilter := Memo11.Text;
end;

//------------------------------------------------------------------------------
procedure TForm1.RadioGroup2Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   Memo1.Text := '';
   HttpScan1.LinkScan := TLinkScan (RadioGroup2.ItemIndex);
   case HttpScan1.LinkScan of
          scanAllLinks: Memo1.lines.Add ('this option scans all the HTML links found.' + #13#10);
       scanInitialSite: Memo1.lines.Add ('this option scans all the HTML links found on the site of the starting URL.' + #13#10);
      scanInitialPath : Memo1.Lines.add ('this option scans only links with the same sub path than the starting URL.' + #13#10 + 'WARNING: it may scan few or no links.' + #13#10);
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.RadioGroup3Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   Memo1.Text := '';
   HttpScan1.LinkReport := TLinkReport (RadioGroup3.ItemIndex);
   case HttpScan1.LinkReport of
              reportAllLinks: Memo1.lines.Add ('this option reports all the links found.' + #13#10);
      reportCurrentSiteLinks: Memo1.lines.Add ('this option reports all the links found on the same site than the currently scanned URL.' + #13#10);
      reportCurrentPathLinks: Memo1.Lines.add ('this option reports only links with the same path than the currently analyzed URL.' +#13#10+'WARNING: it may report few or no links.' + #13#10);
   end;
end;

//------------------------------------------------------------------------------
procedure TForm1.CheckBox1Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   HttpScan1.AllowRedirect := CheckBox1.Checked;
end;

//------------------------------------------------------------------------------
procedure TForm1.Exit1Click(Sender: TObject);
//------------------------------------------------------------------------------
begin
   Close;
end;

end.


