Pascal (Lazarus/Delphi)

A Simple Web Crawler

See more Spider Examples

This demonstrates a very simple web crawler using the Chilkat Spider component. Pascal (Lazarus/Delphi)

program ChilkatDemo;

// Demonstrates using the Chilkat Pascal wrapper via the C bridge DLL.
// Builds as a console application under Lazarus (FPC) or Delphi.

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  SysUtils,
  CkDllLoader,
  Chilkat.StringArray,
  Chilkat.Spider;

// ---------------------------------------------------------------------------

procedure RunDemo;
var
  success: Boolean;
  spider: TSpider;
  seenDomains: TStringArray;
  seedUrls: TStringArray;
  url: string;
  domain: string;
  i: Integer;
  domain: string;
  baseDomain: string;

begin
  success := False;

  spider := TSpider.Create;

  seenDomains := TStringArray.Create;
  seedUrls := TStringArray.Create;

  seenDomains.Unique := True;
  seedUrls.Unique := True;

  //  You will need to change the start URL to something else...
  seedUrls.Append('http://something.whateverYouWant.com/');

  //  Set outbound URL exclude patterns
  //  URLs matching any of these patterns will not be added to the 
  //  collection of outbound links.
  spider.AddAvoidOutboundLinkPattern('*?id=*');
  spider.AddAvoidOutboundLinkPattern('*.mypages.*');
  spider.AddAvoidOutboundLinkPattern('*.personal.*');
  spider.AddAvoidOutboundLinkPattern('*.comcast.*');
  spider.AddAvoidOutboundLinkPattern('*.aol.*');
  spider.AddAvoidOutboundLinkPattern('*~*');

  //  Use a cache so we don't have to re-fetch URLs previously fetched.
  spider.CacheDir := 'c:/spiderCache/';
  spider.FetchFromCache := True;
  spider.UpdateCache := True;

  while seedUrls.Count > 0 do
    begin

      url := seedUrls.Pop();
      spider.Initialize(url);

      //  Spider 5 URLs of this domain.
      //  but first, save the base domain in seenDomains
      domain := spider.GetUrlDomain(url);
      seenDomains.Append(spider.GetBaseDomain(domain));

      for i := 0 to 4 do
        begin
          success := spider.CrawlNext();
          if (success = True) then
            begin

              //  Display the URL we just crawled.
              WriteLn(spider.LastUrl);

              //  If the last URL was retrieved from cache,
              //  we won't wait.  Otherwise we'll wait 1 second
              //  before fetching the next URL.
              if (spider.LastFromCache <> True) then
                begin
                  spider.SleepMs(1000);
                end;

            end
          else
            begin
              //  cause the loop to exit..
              i := 999;
            end;

        end;

      //  Add the outbound links to seedUrls, except
      //  for the domains we've already seen.
      for i := 0 to spider.NumOutboundLinks - 1 do
        begin

          url := spider.GetOutboundLink(i);
          domain := spider.GetUrlDomain(url);
          baseDomain := spider.GetBaseDomain(domain);
          if (seenDomains.Contains(baseDomain) = False) then
            begin
              //  Don't let our list of seedUrls grow too large.
              if (seedUrls.Count < 1000) then
                begin
                  seedUrls.Append(url);
                end;
            end;

        end;

    end;



  spider.Free;
  seenDomains.Free;
  seedUrls.Free;

end;

// ---------------------------------------------------------------------------

begin

  try
    RunDemo;
  except
    on E: Exception do
      WriteLn('Unhandled exception: ', E.ClassName, ': ', E.Message);
  end;

  WriteLn;
  {$IFDEF MSWINDOWS}
  WriteLn('Press Enter to exit...');
  ReadLn;
  {$ENDIF}
end.