
	ASP Shopping Cart, Forum & BBS - all for $20 from CodeToad Plus!

Home || ASP | ASP.Net | C++/C# | DHTML | HTML | Java | Javascript | Perl | VB | XML || CodeToad Plus! || Forums || RAM

Search Site:

Home » ASP » Article

HTTP screen-scraping and caching

Article by:

Troy Wolf ( 372 ) (5/31/2005)

	Add to Favourites
	Tell a friend

Summary:

An ASP class that makes it easy to leverage data from web pages that may be your own or pages from other websites. The class has methods that make it easy to pull entire pages, specific sections of content, tables of data, or even just a specific image from third-party websites.

Viewed: 35246 times

Rating (13 votes):

4.2 out of 5

Rate this Article

Read Comments

Post Comments

HTTP screen-scraping and caching

The technique of stealing....er...leveraging content from other people's web pages is commonly referred to as "screen-scraping". Screen-scraping is how you get site content from a website if they don't offer a more natural way to get the content such as an RSS feed or an API.

Many companies that are common targets of screen-scraping (such as Amazon.com and IMDB.com) have strict policies against screen-scraping. So please respect the usage policies of any site you wish to screen-scrape.

The script and techniques in this article provide an ASP class to make screen-scraping easy and powerful.

Since many sites don't appreciate you scraping their content, and those that do don't want you to hit them every 10 seconds, it's a good idea to incorporate some kind of caching mechanism in your code that screen-scrapes. This way you can scrape the other site's content once per hour rather than every-time you get a hit on your own site. For example, if you scrape stock market data from finance.yahoo.com to place content on your home page, you'd prefer (and so would Yahoo) that you don't hit Yahoo for every hit to your site. Instead, hit Yahoo once, cache the result, then use that cached result to serve additional hits to your site for whatever period of time makes sense.

For example, let's say I want to grab the Google home page and display it in my own site. Using the httpcache class, you could simply do the following:

Select All Code

<%
<!-- #include file="httpcache_class.asp" -->

set hc = new httpcache
with hc
    .URL = "http://www.google.com"
end with
Response.Write hc.data
set hc = nothing
%>

The code above will go pull the page source for http://www.google.com then display it as the output of your page.

Now, let's add caching. The code above will hit Google everytime you refresh the page. Now, let's only hit Google at most once per hour. The code below shows how to use httpcache's caching feature.

Select All Code

<%
<!-- #include file="httpcache_class.asp" -->

set hc = new httpcache
with hc
    .cacheFilename = "Google_home_page"
    .TTL = 3600
    .URL = "http://www.google.com"
end with
Response.Write hc.data
set hc = nothing
%>

You did 2 things. First, you provided a cache filename for the class to use when saving the scraped results to disk. Second, you provided a Time To Live. Now, when you refresh the page, you will pull the data from your webserver harddrive rather than hit Google. That is until after the file is one hour old. The first hit to your page after the cache file is one hour old (3600 seconds) will cause a new hit to Google and a new cache file save.

In this next example, we'll pull only a specific table of data.

Select All Code

<%
<!-- #include file="httpcache_class.asp" -->

set hc = new httpcache
with hc
    .cacheFilename = "sectors"
    .TTL = 60
    .URL = "http://biz.yahoo.com/p/sectors.html"
    .table_extract "column heading to sort", 0, true
    .table_dump()
end with
set hc = nothing
%>

We used httpcache's table_dump() method to show a default table view of the data we extracted from the external web page. In reality, you'd probably not use table_dump(). You'd probably want to work with the individual cells of data. For example, if you wanted to output just the 3rd column of the 5th data row:

Select All Code

<%
<!-- #include file="httpcache_class.asp" -->

set hc = new httpcache
with hc
    .cacheFilename = "sectors"
    .TTL = 60
    .URL = "http://biz.yahoo.com/p/sectors.html"
    .table_extract "column heading to sort", 0, true
end with
Response.Write "Col 3, Row 5: " & hc.table_data.Item(5).Item(3)
set hc = nothing
%>

Finally, another powerful feature of httpcache is the ability to ouput binary data directly. You can use this to output data directly within an <img> tag. You need to create a simple asp page that uses httpcache to return the image. That code is shown at the end of this article. I name this file img_cache.asp.

Select All Code

<img src="img_cache.asp?ttl=60&url=http%3A//www.snippetedit.com/images/snippetedit_screenshot.gif" alt="SnippetEdit ScreenShot from www.SnippetEdit.com" />

The above will output an image from www.snippetedit.com. The image will be cached locally on your webserver's hard drive for 60 seconds. Actually, it will be saved there indefinitely, but any new hits to your page after 60 seconds will cause a new hit to the source site.

Here is the code for img_cache.asp:

Select All Code

<!-- #include file="md5.asp"-->
<!-- #include file="httpcache_class.asp" -->

<%
    set hc = new httpcache
    with hc
        .mode = "binary"
        .cacheFilename = null
        .TTL = Request.QueryString("ttl")
        .URL = Request.QueryString("url")
    end with
    hc.img()
    set hc = Nothing
%>

Notice in the code above their is an include for md5.asp. httpcache uses the md5 function to automatically create a cache filename if you don't supply one. I did not write md5.asp, but it works well, here it is. Copy the code and save it as a file named md5.asp.

Select All Code

<%
' Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm,
' as set out in the memo RFC1321.
'
'
' ASP VBScript code for generating an MD5 'digest' or 'signature' of a string. The
' MD5 algorithm is one of the industry standard methods for generating digital
' signatures. It is generically known as a digest, digital signature, one-way
' encryption, hash or checksum algorithm. A common use for MD5 is for password
' encryption as it is one-way in nature, that does not mean that your passwords
' are not free from a dictionary attack.
'
' This is 'free' software with the following restrictions:
'
' You may not redistribute this code as a 'sample' or 'demo'. However, you are free
' to use the source code in your own code, but you may not claim that you created
' the sample code. It is expressly forbidden to sell or profit from this source code
' other than by the knowledge gained or the enhanced value added by your own code.
'
' Use of this software is also done so at your own risk. The code is supplied as
' is without warranty or guarantee of any kind.
'
' Should you wish to commission some derivative work based on this code provided
' here, or any consultancy work, please do not hesitate to contact us.
'
' Web Site:  http://www.frez.co.uk
' E-mail:    sales@frez.co.uk

Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32

Private m_lOnBits(30)
Private m_l2Power(30)
 
    m_lOnBits(0) = CLng(1)
    m_lOnBits(1) = CLng(3)
    m_lOnBits(2) = CLng(7)
    m_lOnBits(3) = CLng(15)
    m_lOnBits(4) = CLng(31)
    m_lOnBits(5) = CLng(63)
    m_lOnBits(6) = CLng(127)
    m_lOnBits(7) = CLng(255)
    m_lOnBits(8) = CLng(511)
    m_lOnBits(9) = CLng(1023)
    m_lOnBits(10) = CLng(2047)
    m_lOnBits(11) = CLng(4095)
    m_lOnBits(12) = CLng(8191)
    m_lOnBits(13) = CLng(16383)
    m_lOnBits(14) = CLng(32767)
    m_lOnBits(15) = CLng(65535)
    m_lOnBits(16) = CLng(131071)
    m_lOnBits(17) = CLng(262143)
    m_lOnBits(18) = CLng(524287)
    m_lOnBits(19) = CLng(1048575)
    m_lOnBits(20) = CLng(2097151)
    m_lOnBits(21) = CLng(4194303)
    m_lOnBits(22) = CLng(8388607)
    m_lOnBits(23) = CLng(16777215)
    m_lOnBits(24) = CLng(33554431)
    m_lOnBits(25) = CLng(67108863)
    m_lOnBits(26) = CLng(134217727)
    m_lOnBits(27) = CLng(268435455)
    m_lOnBits(28) = CLng(536870911)
    m_lOnBits(29) = CLng(1073741823)
    m_lOnBits(30) = CLng(2147483647)
    
    m_l2Power(0) = CLng(1)
    m_l2Power(1) = CLng(2)
    m_l2Power(2) = CLng(4)
    m_l2Power(3) = CLng(8)
    m_l2Power(4) = CLng(16)
    m_l2Power(5) = CLng(32)
    m_l2Power(6) = CLng(64)
    m_l2Power(7) = CLng(128)
    m_l2Power(8) = CLng(256)
    m_l2Power(9) = CLng(512)
    m_l2Power(10) = CLng(1024)
    m_l2Power(11) = CLng(2048)
    m_l2Power(12) = CLng(4096)
    m_l2Power(13) = CLng(8192)
    m_l2Power(14) = CLng(16384)
    m_l2Power(15) = CLng(32768)
    m_l2Power(16) = CLng(65536)
    m_l2Power(17) = CLng(131072)
    m_l2Power(18) = CLng(262144)
    m_l2Power(19) = CLng(524288)
    m_l2Power(20) = CLng(1048576)
    m_l2Power(21) = CLng(2097152)
    m_l2Power(22) = CLng(4194304)
    m_l2Power(23) = CLng(8388608)
    m_l2Power(24) = CLng(16777216)
    m_l2Power(25) = CLng(33554432)
    m_l2Power(26) = CLng(67108864)
    m_l2Power(27) = CLng(134217728)
    m_l2Power(28) = CLng(268435456)
    m_l2Power(29) = CLng(536870912)
    m_l2Power(30) = CLng(1073741824)

Private Function LShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
        LShift = lValue
        Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And 1 Then
            LShift = &H80000000
        Else
            LShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If

    If (lValue And m_l2Power(31 - iShiftBits)) Then
        LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
    Else
        LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
    End If
End Function

Private Function RShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
        RShift = lValue
        Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And &H80000000 Then
            RShift = 1
        Else
            RShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If
    
    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)

    If (lValue And &H80000000) Then
        RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
End Function

Private Function RotateLeft(lValue, iShiftBits)
    RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function

Private Function AddUnsigned(lX, lY)
    Dim lX4
    Dim lY4
    Dim lX8
    Dim lY8
    Dim lResult
 
    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000
 
    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
 
    If lX4 And lY4 Then
        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
        If lResult And &H40000000 Then
            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
        Else
            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
        End If
    Else
        lResult = lResult Xor lX8 Xor lY8
    End If
 
    AddUnsigned = lResult
End Function

Private Function F(x, y, z)
    F = (x And y) Or ((Not x) And z)
End Function

Private Function G(x, y, z)
    G = (x And z) Or (y And (Not z))
End Function

Private Function H(x, y, z)
    H = (x Xor y Xor z)
End Function

Private Function I(x, y, z)
    I = (y Xor (x Or (Not z)))
End Function

Private Sub FF(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(F(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Private Sub GG(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(G(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Private Sub HH(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(H(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Private Sub II(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(I(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub

Private Function ConvertToWordArray(sMessage)
    Dim lMessageLength
    Dim lNumberOfWords
    Dim lWordArray()
    Dim lBytePosition
    Dim lByteCount
    Dim lWordCount
    
    Const MODULUS_BITS = 512
    Const CONGRUENT_BITS = 448
    
    lMessageLength = Len(sMessage)
    
    lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
    ReDim lWordArray(lNumberOfWords - 1)
    
    lBytePosition = 0
    lByteCount = 0
    Do Until lByteCount >= lMessageLength
        lWordCount = lByteCount \ BYTES_TO_A_WORD
        lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
        lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
        lByteCount = lByteCount + 1
    Loop

    lWordCount = lByteCount \ BYTES_TO_A_WORD
    lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE

    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)

    lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
    lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
    
    ConvertToWordArray = lWordArray
End Function

Private Function WordToHex(lValue)
    Dim lByte
    Dim lCount
    
    For lCount = 0 To 3
        lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
        WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
    Next
End Function

Public Function MD5(sMessage)
    Dim x
    Dim k
    Dim AA
    Dim BB
    Dim CC
    Dim DD
    Dim a
    Dim b
    Dim c
    Dim d
    
    Const S11 = 7
    Const S12 = 12
    Const S13 = 17
    Const S14 = 22
    Const S21 = 5
    Const S22 = 9
    Const S23 = 14
    Const S24 = 20
    Const S31 = 4
    Const S32 = 11
    Const S33 = 16
    Const S34 = 23
    Const S41 = 6
    Const S42 = 10
    Const S43 = 15
    Const S44 = 21

    x = ConvertToWordArray(sMessage)
    
    a = &H67452301
    b = &HEFCDAB89
    c = &H98BADCFE
    d = &H10325476

    For k = 0 To UBound(x) Step 16
        AA = a
        BB = b
        CC = c
        DD = d
    
        FF a, b, c, d, x(k + 0), S11, &HD76AA478
        FF d, a, b, c, x(k + 1), S12, &HE8C7B756
        FF c, d, a, b, x(k + 2), S13, &H242070DB
        FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
        FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
        FF d, a, b, c, x(k + 5), S12, &H4787C62A
        FF c, d, a, b, x(k + 6), S13, &HA8304613
        FF b, c, d, a, x(k + 7), S14, &HFD469501
        FF a, b, c, d, x(k + 8), S11, &H698098D8
        FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
        FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
        FF b, c, d, a, x(k + 11), S14, &H895CD7BE
        FF a, b, c, d, x(k + 12), S11, &H6B901122
        FF d, a, b, c, x(k + 13), S12, &HFD987193
        FF c, d, a, b, x(k + 14), S13, &HA679438E
        FF b, c, d, a, x(k + 15), S14, &H49B40821
    
        GG a, b, c, d, x(k + 1), S21, &HF61E2562
        GG d, a, b, c, x(k + 6), S22, &HC040B340
        GG c, d, a, b, x(k + 11), S23, &H265E5A51
        GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
        GG a, b, c, d, x(k + 5), S21, &HD62F105D
        GG d, a, b, c, x(k + 10), S22, &H2441453
        GG c, d, a, b, x(k + 15), S23, &HD8A1E681
        GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
        GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
        GG d, a, b, c, x(k + 14), S22, &HC33707D6
        GG c, d, a, b, x(k + 3), S23, &HF4D50D87
        GG b, c, d, a, x(k + 8), S24, &H455A14ED
        GG a, b, c, d, x(k + 13), S21, &HA9E3E905
        GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
        GG c, d, a, b, x(k + 7), S23, &H676F02D9
        GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
            
        HH a, b, c, d, x(k + 5), S31, &HFFFA3942
        HH d, a, b, c, x(k + 8), S32, &H8771F681
        HH c, d, a, b, x(k + 11), S33, &H6D9D6122
        HH b, c, d, a, x(k + 14), S34, &HFDE5380C
        HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
        HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
        HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
        HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
        HH a, b, c, d, x(k + 13), S31, &H289B7EC6
        HH d, a, b, c, x(k + 0), S32, &HEAA127FA
        HH c, d, a, b, x(k + 3), S33, &HD4EF3085
        HH b, c, d, a, x(k + 6), S34, &H4881D05
        HH a, b, c, d, x(k + 9), S31, &HD9D4D039
        HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
        HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
        HH b, c, d, a, x(k + 2), S34, &HC4AC5665
    
        II a, b, c, d, x(k + 0), S41, &HF4292244
        II d, a, b, c, x(k + 7), S42, &H432AFF97
        II c, d, a, b, x(k + 14), S43, &HAB9423A7
        II b, c, d, a, x(k + 5), S44, &HFC93A039
        II a, b, c, d, x(k + 12), S41, &H655B59C3
        II d, a, b, c, x(k + 3), S42, &H8F0CCC92
        II c, d, a, b, x(k + 10), S43, &HFFEFF47D
        II b, c, d, a, x(k + 1), S44, &H85845DD1
        II a, b, c, d, x(k + 8), S41, &H6FA87E4F
        II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
        II c, d, a, b, x(k + 6), S43, &HA3014314
        II b, c, d, a, x(k + 13), S44, &H4E0811A1
        II a, b, c, d, x(k + 4), S41, &HF7537E82
        II d, a, b, c, x(k + 11), S42, &HBD3AF235
        II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
        II b, c, d, a, x(k + 9), S44, &HEB86D391
    
        a = AddUnsigned(a, AA)
        b = AddUnsigned(b, BB)
        c = AddUnsigned(c, CC)
        d = AddUnsigned(d, DD)
    Next
    
    MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
End Function
%>

Finally, here is the httpcache_class.asp code that you include in your pages like the examples in this article.

Select All Code

<%
'==============================================================================
class httpcache
'==============================================================================
    private Http
    private mFSO
    private mFile
    private mURL 'URL of source.
    public cacheFilename 'filename of cache file, if blank, will be auto-named
    public data
    public TTL 'Time To Live in seconds
    public cachePath 'Path to your cache directory.
    public mode 'Either "image" or "text"
    public charSet
    public baseHref
    public table_data

    Dim filets, nowts
    
    private sub Class_Initialize()
        TTL = 0  'Default is no cache. Caching recommended!
        'Set default cache directory here. Include trailing slash!
        cachePath = ""
        mode = "text"
        baseHref = null
        set Http=Server.CreateObject("Msxml2.ServerXMLHTTP")
    end sub
    
    private sub Class_Terminate()
        Set Http = Nothing
    end sub

    private sub GetCacheFilename()
        cacheFilename = md5(mURL)
    end sub

    private sub ReadBinaryFile()
        Const adTypeBinary = 1
          
        'Create Stream object
        Dim BinaryStream
        Set BinaryStream = CreateObject("ADODB.Stream")
          
        'Specify stream type - we want To get binary data.
        BinaryStream.Type = adTypeBinary
          
        'Open the stream
        BinaryStream.Open
          
        'Load the file data from disk To stream object
        BinaryStream.LoadFromFile cachePath & cacheFilename
          
        'Open the stream And get binary data from the object
        data = BinaryStream.Read
    End sub

    private sub ReadTextFile()
        Const adTypeText = 2
          
        'Create Stream object
        Dim BinaryStream
        Set BinaryStream = CreateObject("ADODB.Stream")
          
        'Specify stream type - we want To get binary data.
        BinaryStream.Type = adTypeText
          
        'Specify charset For the source text (unicode) data.
        If Len(charSet) > 0 Then
            BinaryStream.CharSet = charSet
        End If
          
        'Open the stream
        BinaryStream.Open
          
        'Load the file data from disk To stream object
        BinaryStream.LoadFromFile cachePath & cacheFilename
          
        'Open the stream And get binary data from the object
        data = baseHref & BinaryStream.ReadText
    End sub
        
    private sub SaveBinaryData()
        Const adTypeBinary = 1
        Const adSaveCreateOverWrite = 2
          
        'Create Stream object
        Dim BinaryStream
        Set BinaryStream = CreateObject("ADODB.Stream")
          
        'Specify stream type - we want To save binary data.
        BinaryStream.Type = adTypeBinary
          
        'Open the stream And write binary data To the object
        BinaryStream.Open
        BinaryStream.Write data
          
        'Save binary data To disk
        BinaryStream.SaveToFile cachePath & cacheFilename, adSaveCreateOverWrite
    End sub

    private sub SaveTextData()
        Const adTypeText = 2
        Const adSaveCreateOverWrite = 2
          
        'Create Stream object
        Dim BinaryStream
        Set BinaryStream = CreateObject("ADODB.Stream")
          
        'Specify stream type - we want To save text/string data.
        BinaryStream.Type = adTypeText
          
        'Specify charset For the source text (unicode) data.
        If Len(charSet) > 0 Then
            BinaryStream.CharSet = charSet
        End If
          
        'Open the stream And write binary data To the object
        BinaryStream.Open
        BinaryStream.WriteText data
          
        'Save binary data To disk
        On Error Resume Next
        BinaryStream.SaveToFile cachePath & cacheFilename, adSaveCreateOverWrite
        if Err.number <> 0 then
            Response.Write "<div style=""font-size:xx-small;color:#cc0000;"">cache save failed</div>"
        end if
        On Error Goto 0

    End sub
        
    private sub GetmURL()
        'Create an Http object, use any of the four objects
        Dim Http
        ' Set Http = CreateObject("Microsoft.XMLHTTP")
        ' Set Http = CreateObject("MSXML2.ServerXMLHTTP")
        Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")
        ' Set Http = CreateObject("WinHttp.WinHttpRequest")
          
        'Send request To mURL
        Http.Open "GET", mURL, False
        Http.Send
        'Get response data As a string
        if mode = "binary" then
            data = Http.ResponseBody
        else
            'Response.Write "<div style=""font-size:xx-small;color:#cccccc;"">live</div>"
            data = baseHref & Http.ResponseText
        end if
    End sub

    private sub ReadFile()
        if mode = "binary" then
            ReadBinaryFile()
        else
            'Response.Write "<div style=""font-size:xx-small;color:#cccccc;"">cache</div>"
            ReadTextFile()
        end if
    end sub

    private sub SaveData()
        if mode = "binary" then
            SaveBinaryData()
        else
            SaveTextData()
        end if
    end sub

    private sub Fetch()
        if TTL > 0 then
            if IsNull(cacheFilename) or (Len(Trim(cacheFilename)) = 0) then GetCacheFileName()
            set mFSO = Server.CreateObject("Scripting.FileSystemObject")
            if mFSO.FileExists(cachePath & cacheFilename) then
                set mFile = mFSO.GetFile(cachePath & cacheFilename)
                filets = mFile.DateLastModified
                nowts = Date() & " " & Time()
                if CLng(DateDiff("S",filets,nowts)) <= CLng(TTL) then
                    ReadFile()
                else
                    set mFile = Nothing
                    GetmURL()
                    SaveData()
                end if
            else
                GetmURL()
                SaveData()
            end if
            set mFSO = Nothing
        else
            GetmURL()
        end if

    end sub

    public function strip_tags( strToStrip )
        Dim objRegExp
        strToStrip = Trim( strToStrip & "" )
        If Len( strToStrip ) > 0 Then
            Set objRegExp = New RegExp
            objRegExp.IgnoreCase = True
            objRegExp.Global = True
            objRegExp.Pattern= "<[^>]+>"
            strToStrip = objRegExp.Replace(strToStrip, "")
            Set objRegExp = Nothing
        End If
        strip_tags = strToStrip
    end function

    public property let URL(x)
        mURL = x
        Fetch()
    end property
    
    'Methods
    public function img()
        Response.ContentType = "image/jpeg"
        Response.BinaryWrite data
    end function

    '------------------------------------------------------------------------------
    public sub table_extract(needle, needle_within, stripTags)
    ' Generic function to return dicionary object from HTML table data
    ' Output is a dictionary where each item represents a row. Each item is a
    ' dictionary where each item represents a column. (Nested dictionary objects.)
    ' In PHP, we'd just use a simple 2 dimensional array, but alas...
    '    rawHTML: the page source
    '    needle: optional string to start parsing source from
    '    needle_within: 0 = needle is BEFORE table, 1 = needle is within table
    '    stripTags: TRUE/FALSE remove all HTML tags, Default = false
    '------------------------------------------------------------------------------
        Dim rawHTML, pos1, pos2, cnt, cols, rowIdx, colIdx, row, xml
        rawHTML = data
        Set table_data = Server.CreateObject("Scripting.Dictionary")
        
        pos1 = 1
        if (Len(needle) > 0) then
            if needle_within = 1 then
                pos1 = InStr(1, rawHTML, needle, 1)
                if pos1 < 1 then exit sub
                pos1 = InStrRev(rawHTML, "<table", pos1, 1)
            else
                pos1 = InStr(1, rawHTML, needle, 1)
                if pos1 < 1 then exit sub
                pos1 = InStr(pos1, rawHTML, "<table", 1)
            end if
        end if
        if pos1 < 1 then exit sub

        pos2 = InStr(pos1, rawHTML, "</table>", 1)
        if pos2 < 1 then exit sub

        rawHTML = Mid(rawHTML, pos1, pos2-pos1+8) '= just the table
        
        rowIdx = 0

        pos1 = InStr(1, rawHTML, "<TR", 1)
        pos2 = InStr(pos1, rawHTML, "</TR>", 1)

        while (pos1 > 0) and (pos2 > 0)

            rowIdx = rowIdx + 1
            colIdx = 0

            xml = xml & "<ROW id=""" & rowIdx & """>" & vbcrlf
            row = Mid(rawHTML, pos1+3, pos2-pos1-1) 'Extract the row minus the row tags.
            rawHTML = Mid(rawHTML,pos2+4) 'Remove this row from the rawHTML so we don't deal with it again.
            pos1 = InStr(1, row,"<T", 1)

            Set cols = Server.CreateObject("Scripting.Dictionary")

            while (pos1 > 0)
                colIdx = colIdx + 1
                xml = xml & "<COL id=""" & colIdx & """>" & vbcrlf
                pos1 = InStr(1, row, ">", 1)
                pos1 = pos1 + 1
                pos2 = InStr(1, row, "</T", 1)
                if stripTags then
                    cols.Add colIdx, trim(strip_tags(Mid(row, pos1, pos2-pos1)))
                else
                    cols.Add colIdx, trim(Mid(row, pos1, pos2-pos1))
                end if
                row = Mid(row, pos2+5)
                pos1 = InStr(1, row,"<T", 1)
            wend
            
            table_data.Add rowIdx, cols
            
            Set cols = Nothing
            pos1 = InStr(1, rawHTML, "<TR", 1)
            if pos1 > 0 then pos2 = InStr(pos1, rawHTML, "</TR>", 1)

        wend
        
    end sub  'table_extract
    
    '------------------------------------------------------------------------------
    public sub table_dump()
    ' Displays a basic table showing the results of the table_data method.
    ' Useful during development and testing.
    '------------------------------------------------------------------------------
        Dim row, col
        Response.Write "<table border=""1"">" & vbcrlf
        for row = 2 to table_data.Count
            Response.Write vbtab & "<tr>" & vbcrlf
            for col = 1 to table_data.Item(row).Count
                Response.Write vbtab & vbtab & "<td>" & table_data.Item(row).Item(col) & "</td>" & vbcrlf
            next
            Response.Write vbtab & "</tr>" & vbcrlf
        next
        Response.Write "</table>" & vbcrlf
    end sub    

end class  'httpcache
%>

This article was a bit more complex than some, but if you put all the pieces together and play with the examples, you'll find httpcache to be a powerful and simple to use class for screen-scraping. The caching feature will make you a good neighbor as it will keep you from causing unnecessary hits to those external sites.

Hope you enjoyed this article and the code. Troy Wolf is the author of SnippetEdit, a website editor written in PHP. SnippetEdit is as simple as it gets for non-technical users to edit pre-defined snippets of content in their websites.

Useful Links

Fat Cow Hosting

FatCow Review

Advertise here

CodeToad Experts

Can't find the answer?
Our Site experts are answering questions for free in the CodeToad forums

Rate this article: Poor Excellent

View highlighted Comments

User Comments on 'HTTP screen-scraping and caching'

Posted by : ghubbell at 15:11 on Tuesday, October 25, 2005

Error in Win Server 2003, IIS6:

Microsoft VBScript runtime error '800a01fa'
Class not defined: 'httpcache'
test1.asp, line 4

Any help?

Posted by : acedish at 15:10 on Sunday, April 23, 2006

in the examples you need to change the first 2 lines from;

<%


to


<%

Posted by : lenehanj at 10:25 on Tuesday, May 23, 2006

Hi

I trying to get the above the script to work. It is loading the external url and extracting the info I need ok! No problems there. However, It will not cache the info.

In the httpcache_class.asp, I have set: cachePath = "cache/".

I have a folder called "cache" at the same level as the asp files in your example.

I keep getting "cache save failed" before the scraped information.

Any ideas? I have never used cache before, so any help is appreciated.

John L

Posted by : !aborabi at 09:19 on Monday, July 24, 2006

Very good tutorial. I like it.

---------------------

http://www.astrawebhosting.net
http://www.visionwebhosting.net

Posted by : rizwanbhutta at 02:18 on Saturday, September 22, 2007

it is very good tutorial, it is working very well, but i have a problem at the example which is grabbing table info from url
but at line

.table_extract "column heading to sort", 0, true

what is "column heading to sort" . is it the name of column or some thing else.

To post comments you need to become a member. If you are already a member, please log in .

RELATED ARTICLES
ASP FilesystemObject by Jeff Anderson An introduction to the Filesystemobject

ASP GetTempName by Jeff Anderson Use the GetTempName method to create a randomly generated temporary file on the server.

ASP OpenTextFile by Jeff Anderson An introduction to the OpenTextFile Method of the FileSystemObject

ASP Format Date and Time Script by Jeff Anderson An ASP script showing the variety of date and time formats possible using the FormatDateTime Function.

Email validation using Regular Expression by Jeff Anderson Using regular expression syntax is an exellent way to thoroughly validate an email. It's possible in ASP.

ASP FileExists by Jeff Anderson An introduction to the FileExistsMethod of the FileSystemObject

Creating a Dynamic Reports using ASP and Excel by Jeff Anderson A simple way to generate Excel reports from a database using Excel.

Concatenate strings in sql by Jeff Anderson A brief introduction to concatenating strings in an sql query (using SQL server or access databases).

Add or Subtract Hours in SQL or ASP using DateAdd by Jeff Anderson A beginners guide to using the SQL DATEADD function to add or subtract hours. Particularly useful when setting the time displayed on the ASP page to a different time zone (eg when the server is in the US, and the site is for a UK audience).

ASP CreateTextFile by Jeff Anderson An explanation of the CreateTextFile Method, part of the ASP FileSystemObject

Recent Forum Threads

•	C++
•	Re: refresh parent after closing pop up window
•	Dynamic Insertion
•	Date and Time function around the world???
•	Significant Factors
•	Perl array access
•	Re: huffman encoding and decoding in C++...
•	Perl One Liner: Replace {(
•	Re: html including php, accessing the functions

Recent Articles

	ASP GetTempName
	Decode and Encode UTF-8
	ASP GetFile
	ASP FolderExists
	ASP FileExists
	ASP OpenTextFile
	ASP FilesystemObject
	ASP CreateFolder
	ASP CreateTextFile
	Javascript Get Selected Text

submit a link - privacy - contact - advertise - hot links - link to us - submit your article