A Simple Web Crawler

This demonstrates a very simple web crawler using the Chilkat Spider component.

Download Chilkat Spider ActiveX

Dim fso, outFile
Set fso = CreateObject("Scripting.FileSystemObject")
Set outFile = fso.CreateTextFile("output.txt", True)

'  The Chilkat Spider component/library is free.
set spider = CreateObject("Chilkat.Spider")

set seenDomains = CreateObject("Chilkat.CkStringArray")
set seedUrls = CreateObject("Chilkat.CkStringArray")

seenDomains.Unique = 1
seedUrls.Unique = 1

seedUrls.Append "http://directory.google.com/Top/Recreation/Outdoors/Hiking/Backpacking/"

'  Set our outbound URL exclude patterns
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 = 1
spider.UpdateCache = 1

Do While seedUrls.Count > 0

    url = seedUrls.Pop()
    spider.Initialize url

    '  Spider 5 URLs of this domain.
    '  but first, save the base domain in seenDomains
    domain = spider.GetDomain(url)
    seenDomains.Append spider.GetBaseDomain(domain)

    For i = 0 To 5
        success = spider.CrawlNext()
        If (success <> 1) Then
            Exit Do
        End If

        '  Display the URL we just crawled.
        outFile.WriteLine(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 <> 1) Then
            spider.SleepMs 1000
        End If

    Next

    '  Add the outbound links to seedUrls, except
    '  for the domains we've already seen.
    For i = 0 To spider.NumOutboundLinks - 1

        url = spider.GetOutboundLink(i)
        domain = spider.GetDomain(url)
        baseDomain = spider.GetBaseDomain(domain)
        If (Not seenDomains.Contains(baseDomain)) Then
            seedUrls.Append url
        End If

        '  Don't let our list of seedUrls grow too large.
        If (seedUrls.Count > 1000) Then
            Exit Do
        End If

    Next

Loop
outFile.Close