
	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

Sponsored by:

FindMyHosting - Web Hosting Search

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: 6566 times

Rating (7 votes):

4.4 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

Web Hosting

ASP Hosting

Domain Names

Windows Web Hosting

Web Hosting

Web Hosting Directory

Website Editor

Web Hosting

Web Hosting Services

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?

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

RELATED ARTICLES
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.

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

Create an ASP SQL Stored Procedure by Jeff Anderson A beginners guide to setting up a stored procedure in SQL server and calling it from an ASP page.

ASP Shopping Cart by CodeToad Plus! Complete source code and demo database(Access, though SQL compatible) to an ASP database driven e-commerce shopping basket, taking the user through from product selection to checkout. Available to CodeToad Plus! Members

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.

Creating an SQL Trigger by Jeff Anderson A beginners guide to creating a Trigger in SQL Server

MagicGrid by Abhijeet Kaulgud MagicGrid is an all-in-one grid for ASP programmers. It is a 3 Level Hierarchial Grid. You can Add, Edit, Delete Items under all the three levels. You can also cut-copy-paste Items from one level to other, It happens just by drag & drop!

The asp:checkbox and asp:checkboxlist control by David Sussman, et al Checkboxes are similar to radio buttons, and in HTML, they were used to allow multiple choices from a group of buttons.

ASP.NET Forum Source Code by ITCN Complete open source website Forum and Discussion Board programmed in Microsoft dot Net 1.1 Framework with Visual Basic.

The asp:listbox control by David Sussman, et al The next HTML server control that we'll look at, <asp:listbox>, is very much related to <asp:dropdownlist>.

Recent Forum Threads

•	Re: sorting and Linked list
•	Re: need help linked list
•	Re: Help with arrays
•	Re: Reading from a file
•	Re: Why Use Method?
•	Re: Help with a simple program
•	Re: need help with quiz
•	Re: Help with filesystem object & displaying in a table
•	Re: Genetic Algorithm Help

Recent Articles

	Multiple submit buttons with form validation
	Understanding Hibernate ORM for Java/J2EE
	HTTP screen-scraping and caching
	a javascript calculator
	A simple way to JTable
	Java Native Interface (JNI)
	Parsing Dynamic Layouts
	MagicGrid
	Caching With ASP.Net
	Creating CSS Buttons

Site Survey

Help us serve you better. Take a five minute survey. Click here!

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