<%
'' REFERER.ASP
'' Sean P. Nolan
'' http://www.yaywastaken.com/
''
'' This code is free for you to use as you see fit. Copy it, rewrite it,
'' run it yourself, whatever. But no warranties or guarantees either. Who
'' knows what the hell it does. Not me, that's for sure!
''
'' Referer module service ... possible parameters are:
''
'' site - name of requesting site (required)
'' referer - referring url
'' homedomain - if this appears in the referer, bail
'' exclude - comma-separated list of strings that, if they
'' appear in the referer, bail
''
%>
<!--#include file="referer-inc.asp" -->
<%
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetSiteID
Function GetSiteID(knex, szSite, szHomeDomain, fRecur)
Dim rows, cmd, param, szCommand
Set cmd = Server.CreateObject("ADODB.Command")
cmd.ActiveConnection = knex
cmd.CommandText = "select site_id from referer_sites where name = ?"
Set param = cmd.CreateParameter("name", adVarChar, adParamInput, _
Len(szSite), szSite)
cmd.Parameters.Append(param)
Set rows = cmd.Execute
If (rows.EOF) Then
Set cmd = Server.CreateObject("ADODB.Command")
cmd.ActiveConnection = knex
cmd.CommandText = "insert into referer_sites (name,home) " & _
"values (?,?)"
Set param = cmd.CreateParameter("name", adVarChar, adParamInput, _
Len(szSite), szSite)
cmd.Parameters.Append(param)
Set param = cmd.CreateParameter("home", adVarChar, adParamInput, _
Len(szHomeDomain), szHomeDomain)
cmd.Parameters.Append(param)
cmd.Execute
If (Err.Number = 0 And Not fRecur) Then
GetSiteID = GetSiteID(knex, szSite, True)
Exit Function
End If
End If
GetSiteID = CLng(rows(0))
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FValidateURL
Function FValidateURL(szURL, ByRef szLinkText)
Dim xmlhttp, ichStart, ichEnd, szText
On Error Resume Next
FValidateURL = False
szLinkText = szURL
Set xmlhttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
xmlhttp.open "GET", szURL, False
xmlhttp.send ""
If (xmlhttp.status <> 200) Then
Exit Function
End If
szText = xmlhttp.responseText
ichStart = InStr(1, szText, "<title>", 1)
If (ichStart <> 0) Then
ichStart = ichStart + 7
ichEnd = InStr(ichStart, szText, "<")
If (ichEnd <> 0) Then
szLinkText = Trim(Mid(szText, ichStart, ichEnd - ichStart))
If (szLinkText = "") Then szLinkText = szURL
End If
End If
FValidateURL = True
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FNormalizeReferer
' GetUrlID
' LogReferer
Function FNormalizeReferer(szHomeDomain, szExclude, ByRef szReferer)
Dim szNormalized, szQuery, ichStart, ichEnd, szKiller
FNormalizeReferer = False
szNormalized = Trim(LCase(szReferer))
If (szNormalized = "") Then Exit Function
If (szHomeDomain <> "") Then
If (InStr(1, szReferer, szHomeDomain, 1) <> 0) Then Exit Function
End If
If (szExclude <> "") Then
For Each szKiller In Split(szExclude, ",")
If (InStr(1, szReferer, szKiller, 1) <> 0) Then
Exit Function
End If
Next
End If
If (InStr(szNormalized, ".google.com") <> 0) Then
ichStart = InStr(szNormalized, "?q=") + 3
If (ichStart = 3) Then
ichStart = InStr(szNormalized, "&q=") + 3
If (ichStart = 3) Then Exit Function
End If
ichEnd = InStr(ichStart, szNormalized, "&")
If (ichEnd = 0) Then
szQuery = Mid(szNormalized, ichStart)
Else
szQuery = Mid(szNormalized, ichStart, ichEnd - ichStart)
End If
szQuery = Server.URLEncode(URLDecode(szQuery))
szReferer = "http://www.google.com/search?q=" & szQuery
FNormalizeReferer = True
Exit Function
End If
' probably more to do here, but hey
FNormalizeReferer = True
End Function
Function GetUrlID(knex, szURL, fRecur)
Dim rows, cmd, param, szCommand, fValid, szLinkText, nIsValid
Set cmd = Server.CreateObject("ADODB.Command")
cmd.ActiveConnection = knex
cmd.CommandText = _
"select url_id, is_valid from referer_urls where url = ?"
Set param = cmd.CreateParameter("url", adVarChar, adParamInput, _
Len(szURL), szURL)
cmd.Parameters.Append(param)
Set rows = cmd.Execute
If (rows.EOF) Then
fValid = FValidateURL(szURL, szLinkText)
If (fValid) Then
nIsValid = 1
Else
nIsValid = 0
End If
Set cmd = Server.CreateObject("ADODB.Command")
cmd.ActiveConnection = knex
cmd.CommandText = "insert into referer_urls " & _
"(url, link_text, is_valid) values (?,?,?)"
Set param = cmd.CreateParameter("url", adVarChar, adParamInput, _
Len(szURL), szURL)
cmd.Parameters.Append(param)
Set param = cmd.CreateParameter("link_text", adVarChar, _
adParamInput, Len(szLinkText), _
szLinkText)
cmd.Parameters.Append(param)
Set param = cmd.CreateParameter("is_valid", adInteger, _
adParamInput, 0, nIsValid)
cmd.Parameters.Append(param)
On Error Resume Next
Err.Clear
cmd.Execute
If (Err.Number = 0 And Not fRecur) Then
GetUrlID = GetUrlID(knex, szURL, True)
Exit Function
End If
End If
GetUrlID = CLng(rows(0))
End Function
Sub LogReferer(knex, szSite, szHomeDomain, szExclude, szReferer)
Dim szNormalized, idurl, idsite, cmd, param, crowsAffected
szNormalized = szReferer
If (Not FNormalizeReferer(szHomeDomain, szExclude, szNormalized)) Then
Exit Sub
End If
idsite = GetSiteID(knex, szSite, szHomeDomain, False)
idurl = GetUrlID(knex, szNormalized, False)
Set cmd = Server.CreateObject("ADODB.Command")
cmd.ActiveConnection = knex
cmd.CommandText = "update referer_service_2 " & _
"set last_visit_date = getdate(), " & _
"vcount = vcount + 1 " & _
"where site_id = ? and url_id = ?"
Set param = cmd.CreateParameter("site_id", adInteger, adParamInput, _
0, idsite)
cmd.Parameters.Append(param)
Set param = cmd.CreateParameter("url_id", adInteger, adParamInput, _
0, idurl)
cmd.Parameters.Append(param)
On Error Resume Next
Err.Clear
cmd.Execute crowsAffected
If ((Err.Number = 0) And (crowsAffected = 0)) Then
Set cmd = Server.CreateObject("ADODB.Command")
cmd.ActiveConnection = knex
cmd.CommandText = "insert into referer_service_2 " & _
"(site_id, url_id, last_visit_date, vcount) " & _
"values(?, ?, getdate(), 1)"
Set param = cmd.CreateParameter("site_id", adInteger, _
adParamInput, 0, idsite)
cmd.Parameters.Append(param)
Set param = cmd.CreateParameter("url_id", adInteger, _
adParamInput, 0, idurl)
cmd.Parameters.Append(param)
On Error Resume Next
Err.Clear
cmd.Execute
End If
Set cmd = Nothing
Set param = Nothing
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' GetOuttaHere
Sub GetOuttaHere()
Response.Redirect "http://www.yaywastaken.com/shared/img/spacer.gif"
Response.End
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Mainline Code
Dim g_knex, g_szSite, g_szReferer, g_szHomeDomain, g_szExclude
If (Application("fucked") <> "") Then
GetOuttaHere
End If
Set g_knex = GetDatabaseConnection
If (g_knex Is Nothing) Then
GetOuttaHere
End If
g_szSite = Request("site")
g_szReferer = Request("referer")
g_szHomeDomain = Trim(LCase(Request("homedomain")))
g_szExclude = Trim(LCase(Request("exclude")))
If ((g_szSite = "") Or (g_szReferer = "")) Then
GetOuttaHere
End If
LogReferer g_knex, g_szSite, g_szHomeDomain, g_szExclude, g_szReferer
GetOuttaHere
%>