<%
'###########################################################
'## COPYRIGHT (C) 2003, Metasun Software
'##
'## For licensing details, lease read the license.txt file
'## included with MetaTraffic or located at:
'## http://www.metasun.com/products/metatraffic/license.asp
'##
'## All copyright notices regarding MetaTraffic
'## must remain intact in the scripts and in the
'## outputted HTML. All text and logos with
'## references to Metasun or MetaTraffic must
'## remain visible when the pages are viewed on
'## the internet or intranet.
'##
'## For support, please visit http://www.metasun.com
'## and use the support forum.
'###########################################################
Class clsMetaTraffic
' DEFINE CLASS ONLY VARIABLES
Private strSql, rsCount, rsConfig, rsOnline, blnPageCount
Private datFirstHit, datLastHit
Private objConn
Private intAnalyzeData, blnAnalyzeData
Private blnRemoveAliases, intSessionDuration, strAction
Private strSiteAliases, strInstance, blnExcludeRobots
' REQUIRED PROPERTIES FOR ALL METHODS
Public DatabaseType ' DEFAULTS TO MS ACCESS
Public DatabaseLocation
Public DatabaseName
Public DatabaseUsername
Public DatabasePassword
' CONFIGURABLE LOGGING PROPERTIES
Public ActualUrl
' CONFIGURABLE PROPERTIES
Public ShowGraph
Public ReportType
Public ReportItems
Public StartDate
Public EndDate
' SET SOME MORE PUBLIC PROPERTIES
Public Property Let Instance(pInstance)
strInstance = pInstance
End Property
Public Property Let ExcludeRobots(pExcludeRobots)
blnExcludeRobots = pExcludeRobots
End Property
Public Property Let SiteAliases(pSiteAliases)
Dim arySiteAliases, intLoop
' FORMAT SITE ALIASES
If Len(pSiteAliases) > 0 Then
blnRemoveAliases = True
strSiteAliases = pSiteAliases
' REMOVE SOME ILLEGAL CHARACTERS
strSiteAliases = Replace(strSiteAliases, " ", "")
strSiteAliases = Replace(strSiteAliases, "'", "")
' CREATE ARRAY
arySiteAliases = Split(strSiteAliases, ",")
strSiteAliases = ""
For intLoop = 0 To UBound(arySiteAliases)
strSiteAliases = strSiteAliases & "'" & arySiteAliases(intLoop) & "',"
Next
strSiteAliases = Mid(strSiteAliases, 1, Len(strSiteAliases) - 1)
Else
blnRemoveAliases = False
End If
End Property
Public Property Let SessionDuration(pSessionDuration)
If IsNumeric(pSessionDuration) = False Then
intSessionDuration = 60
Else
intSessionDuration = pSessionDuration
End If
End Property
Public Property Let AnalyzeData(pAnalyzeData)
' SET VARIABLES WITH PROPERTIES
intAnalyzeData = pAnalyzeData
' SET DEFAULT VARIABLES
If IsNumeric(intAnalyzeData) Then
intAnalyzeData = Int(intAnalyzeData)
If intAnalyzeData < 0 Or intAnalyzeData > 3 Then
intAnalyzeData = 1
End If
Else
intAnalyzeData = 1
End If
End Property
Public Property Let Action(pAction)
strAction = pAction
End Property
Public Property Let DeleteAfterDays(pDeleteAfterDays)
intDeleteAfterDays = pDeleteAfterDays
End Property
Public Sub LogFile(strLogUrl, intLogType, strResolution)
' DEFINE VARIABLES
Dim strDateTime, strReferrer, strIPAddress, strScriptName
Dim strUserAgent, strQuerystring, strSessionID, strRemoteHost
Dim strAcceptLanguage, strBrowser, strBrowserType, strOS
Dim strLanguageActual, blnLogFile, strScreenArea, strScriptUrl
Dim strExtension
' MAKE SURE intTYPE IS AN INTEGER FOR COMPARISONS
intLogType = CInt(intLogType)
' SET VARIABLES
strDateTime = Now()
strReferrer = Request.Servervariables("HTTP_REFERER")
strIPAddress = Request.Servervariables("REMOTE_ADDR")
strScriptName = Request.Servervariables("SCRIPT_NAME")
strUserAgent = Request.Servervariables("HTTP_USER_AGENT")
strQuerystring = Request.Querystring
strSessionID = Session.SessionID
strRemoteHost = Request.Servervariables("REMOTE_HOST")
strAcceptLanguage = Request.ServerVariables("HTTP_ACCEPT_LANGUAGE")
' CREATE UNIQUE SESSIONID BASED ON IP ADDRESS
strSessionID = strSessionID & Replace(strIPAddress, ".", "")
' FORMAT DATE / TIME
strDateTime = FormatDatabaseDate(strDateTime)
' SET RIGHT LOGGING DATA DEPENDING ON intTYPE
Select Case intLogType
Case 0
strScriptUrl = strScriptName
If strQuerystring <> "" Then
strScriptUrl = strScriptUrl & "?" & strQuerystring
End If
Case 1
strScriptName = ExtractScriptName(strLogUrl)
strScriptUrl = strLogUrl
strQuerystring = ""
Case 2
strScriptName = ExtractScriptName(strReferrer)
strQuerystring = ExtractQuerystring(strReferrer)
strScriptUrl = ExtractScriptName(strReferrer)
If ExtractQuerystring(strReferrer) <> "" Then
strScriptUrl = strScriptUrl & "?" & ExtractQuerystring(strReferrer)
End If
strReferrer = strLogUrl
strScreenArea = strResolution
End Select
' DO A FINAL CHECK TO SEE IF WE SHOULD ABORT
If strScriptName = "" Then
blnLogFile = False
Else
blnLogFile = True
End If
If blnLogFile = True Then
Call CreateDatabaseConnection(DatabaseType, DatabaseLocation, DatabaseName, _
DatabaseUsername, DatabasePassword)
' FIGURE OUT WHETHER TO ANALYZE DATA
If intAnalyzeData = 1 Or intAnalyzeData = 3 Then
blnAnalyzeData = True
Else
blnAnalyzeData = False
End If
' ANALYZE USER AGENT ON THE FLY
If blnAnalyzeData Then
Dim aryBrowser, aryRobot, aryOS, strDomain, strHost, strUrl, strKeywords
' GENERATE USER AGENT DATA
If strUserAgent <> "" Then
aryBrowser = GetBrowserArray()
strBrowser = MatchUserAgent(aryBrowser, strUserAgent)
If strBrowser <> "" Then
strBrowserType = "Browser"
Else
aryRobot = GetRobotArray()
strBrowser = MatchUserAgent(aryRobot, strUserAgent)
If strBrowser <> "" Then
strBrowserType = "Robot"
End If
End If
aryOS = GetOSArray()
strOS = MatchUserAgent(aryOS, strUserAgent)
End If
'GENERATE REFERRAL DATA
If strReferrer <> "" Then
strHost = ExtractReferrerHost(strReferrer)
If InStr(strSiteAliases, "'" & strHost & "'") = 0 Then
strUrl = ExtractReferrerUrl(strReferrer)
strDomain = ExtractReferrerDomain(strReferrer)
strExtension = ExtractReferrerExtension(strReferrer)
End If
' EXTRACT KEYWORDS
If Instr(strReferrer, "?") > 0 Then
strKeywords = ExtractKeywords(strReferrer)
End If
End If
If strAcceptLanguage <> "" Then
If InStr(strAcceptLanguage, ",") > 0 Then
strAcceptLanguage = Trim(Left(strAcceptLanguage, InStr(strAcceptLanguage, ",") - 1))
Else
strAcceptLanguage = Trim(strAcceptLanguage)
End If
If InStr(strAcceptLanguage, ";") > 0 Then
strAcceptLanguage = Trim(Left(strAcceptLanguage, InStr(strAcceptLanguage, ";") - 1))
End If
End If
End If
' INSERT STATS INTO DATABASE
strSql ="INSERT INTO " & strInstance & "PageLog " &_
"(pl_datetime, pl_referrer, pl_ipaddress, pl_scriptname, " &_
"pl_useragent, pl_querystring, pl_sessionid, pl_remotehost, " &_
"pl_language, pl_browser, pl_browsertype, pl_os, pl_referrerhost, " &_
"pl_referrerdomain, pl_referrerurl, pl_referrerextension, " &_
"pl_keywords, pl_screenarea, pl_scripturl) " &_
"VALUES (" & strDateTime & ", " &_
FormatDatabaseString(strReferrer, 255) & ", " &_
FormatDatabaseString(strIPAddress, 15) & ", " &_
FormatDatabaseString(strScriptName, 255) & ", " &_
FormatDatabaseString(strUserAgent, 255) & ", " &_
FormatDatabaseString(strQuerystring, 255) & ", " &_
FormatDatabaseString(strSessionID, 50) & ", " &_
FormatDatabaseString(strRemoteHost, 255) & ", " &_
FormatDatabaseString(strAcceptLanguage, 20) & ", " &_
FormatDatabaseString(strBrowser, 50) & ", " &_
FormatDatabaseString(strBrowserType, 10) & ", " &_
FormatDatabaseString(strOS, 20) & ", " &_
FormatDatabaseString(strHost, 150) & ", " &_
FormatDatabaseString(strDomain, 150) & ", " &_
FormatDatabaseString(strUrl, 255) & ", " &_
FormatDatabaseString(strExtension, 10) & ", " &_
FormatDatabaseString(strKeywords, 100) & ", " &_
FormatDatabaseString(strScreenArea, 11) & ", " &_
FormatDatabaseString(strScriptUrl, 255) & ")"
objConn.Execute(strSql)
If intDeleteAfterDays > 0 Then
strSql = "DELETE FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime < " & FormatDatabaseDate(Dateadd("d", (0 - intDeleteAfterDays), Now()))
objConn.Execute(strSql)
End If
' CLEANUP DATABASE CONNECTION OBJECT
Call CloseDatabaseConnection()
End If
End Sub
Public Sub GenerateReport()
Dim intTotalPageViews, intBlindVisits, intReferredVisits
Dim intDistinctPages, intVisits, intVisitors
Dim sngPagesPerVisit, sngPageViewsPerHour, sngPageViewsPerDay, sngVisitsPerDay, sngVisitorsPerDay
Dim intDay, intMonth, intYear, intCount, blnMovenext, aryDay
Dim sngPercent, intTotal
Dim datReportStart, datReportEnd, datCurrentDate
Dim intUsersOnline, intMaxNumber, intDayLoop, intHourLoop
Dim strReport, intReportItems
Dim datNow, intRow, strClass, blnShowGraph, strTruncatedUrl
' SET DEFAULT VALUES
If ReportType = "" Then
ReportType = "TRAFFICSUMMARY"
End If
If ShowGraph = "" Then
ShowGraph = True
End If
If IsNumeric(ReportItems) = False Then
ReportItems = 20
End If
If IsDate(StartDate) = False Then
StartDate = Date()
Else
StartDate = StartDate
End If
If IsDate(EndDate) = False Then
EndDate = Date()
Else
EndDate = EndDate
End If
' SET INTERNAL VARIABLES
blnShowGraph = ShowGraph
strReport = UCase(ReportType)
intReportItems = ReportItems
datReportStart = StartDate
datReportEnd = EndDate
' SET ROW COUNTER TO ZERO
intRow = 0
' FIGURE OUT WHETHER TO ANALYZE DATA
If intAnalyzeData = 2 Or intAnalyzeData = 3 Then
blnAnalyzeData = True
Else
blnAnalyzeData = False
End If
Select Case strReport
Case "TRAFFICSUMMARY"
' DO SOME CALCULATIONS
Dim intReportHours, sngReportDays
' SET LOG RANGE
GetLogRange()
intUsersOnline = CountUsersOnline()
intTotalPageViews = CountPageViews(datReportStart, datReportEnd, "")
intDistinctPages = CountDistinctPages()
intVisits = CountVisits(datReportStart, datReportEnd)
intVisitors = CountVisitors(datReportStart, datReportEnd)
intReportHours = DateDiff("n", datReportStart, datReportEnd & " 23:59:59") / 60
sngReportDays = FormatNumber(intReportHours / 24, 2)
If intVisits > 0 Then
sngPagesPerVisit = FormatNumber(intTotalPageViews / intVisits, 2)
Else
sngPagesPerVisit = 0
End If
' CALCULATE SUMMARY AVGS
If intReportHours > 0 Then
sngPageViewsPerHour = FormatNumber(intTotalPageViews / intReportHours, 2)
Else
sngPageViewsPerHour = 0
End If
If sngReportDays > 0 Then
sngPageViewsPerDay = FormatNumber(intTotalPageViews / sngReportDays, 2)
sngVisitsPerDay = FormatNumber(intVisits / sngReportDays, 2)
sngVisitorsPerDay = FormatNumber(intVisitors / sngReportDays, 2)
Else
sngPageViewsPerDay = 0
sngVisitsPerDay = 0
sngVisitorsPerDay = 0
End If
With Response
.Write("
")
End With
' QUERY AND DISPLAY PAGE ACTIVITY BY PAGE
strSql = "SELECT TOP " & intReportItems & " pl_scriptname, COUNT(pl_scriptname) FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "GROUP BY pl_scriptname " &_
"ORDER BY COUNT(pl_scriptname) DESC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(1) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(1)
End If
Response.Write("
")
End With
' QUERY AND DISPLAY PAGE ACTIVITY BY PAGE
strSql = "SELECT TOP " & intReportItems & " pl_scripturl, COUNT(pl_scripturl) FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "GROUP BY pl_scripturl " &_
"ORDER BY COUNT(pl_scripturl) DESC, pl_scripturl ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(1) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(1)
End If
Response.Write("
")
rsCount.Movenext
Loop
rsCount.Close
Set rsCount = Nothing
If blnPageCount=True Then
Response.Write("
")
Response.Write("
Total:
")
Response.Write("
" & intTotal & "
")
Response.Write("
")
If blnShowGraph = True Then
Response.Write("
")
End If
Response.Write("
")
Response.Write("
")
End if
Case "PAGEVIEWSBYDATE"
intTotal = CountPageViews(datReportStart, datReportEnd, "")
datCurrentDate = datReportStart
If blnShowGraph = True Then
intMaxNumber = GetMaxPageViews(datReportStart, datReportEnd)
End If
With Response
.Write("
")
datCurrentDate = DateAdd("d", 1, datCurrentDate)
If blnMovenext = True Then
rsCount.Movenext
End If
Next
rsCount.Close
Set rsCount = Nothing
Response.Write("
")
Response.Write("
Total:
")
Response.Write("
" & intTotal & "
")
Response.Write("
")
If blnShowGraph = True Then
Response.Write("
")
End If
Response.Write("
")
Response.Write("
")
Case "PAGEVIEWSBYHOUR"
intTotal = CountPageViews(datReportStart, datReportEnd, "")
If blnShowGraph = True Then
intMaxNumber = GetMaxHourlyPageViews(datReportStart, datReportEnd)
End If
With Response
.Write("
")
If blnMovenext = True Then
rsCount.Movenext
End If
Next
Response.Write("
")
Response.Write("
Total:
")
Response.Write("
" & intTotal & "
")
Response.Write("
")
If blnShowGraph = True Then
Response.Write("
")
End If
Response.Write("
")
Response.Write("
")
CASE "VISITSBYDATE"
intTotal = CountVisits(datReportStart, datReportEnd)
datCurrentDate = datReportStart
If blnShowGraph = True Then
intMaxNumber = GetMaxVisits(datReportStart, datReportEnd)
End If
With Response
.Write("
")
datCurrentDate = DateAdd("d", 1, datCurrentDate)
If blnMovenext = True Then
rsCount.Movenext
End If
Next
rsCount.Close
Set rsCount = Nothing
Response.Write("
")
Response.Write("
Total:
")
Response.Write("
" & intTotal & "
")
Response.Write("
")
If blnShowGraph = True Then
Response.Write("
")
End If
Response.Write("
")
Response.Write("
")
CASE "VISITORSBYDATE"
intTotal = CountVisitors(datReportStart, datReportEnd)
datCurrentDate = datReportStart
If blnShowGraph = True Then
intMaxNumber = GetMaxVisitors(datReportStart, datReportEnd)
End If
With Response
.Write("
")
datCurrentDate = DateAdd("d", 1, datCurrentDate)
If blnMovenext = True Then
rsCount.Movenext
End If
Next
rsCount.Close
Set rsCount = Nothing
Response.Write("
")
Response.Write("
Total:
")
Response.Write("
" & intTotal & "
")
Response.Write("
")
If blnShowGraph = True Then
Response.Write("
")
End If
Response.Write("
")
Response.Write("
")
Case "REFERRERDOMAINS"
If blnAnalyzeData Then
Call GenerateReferrerDomainData(datReportStart, datReportEnd)
End If
intTotal = CountTotalReferrers(datReportStart, datReportEnd, "Domain")
With Response
.Write("
")
End With
strSql = "SELECT TOP " & intReportItems & " pl_referrerdomain, pl_referrerextension, COUNT(pl_referrerdomain) " &_
"FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrerdomain <> '' "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
If blnRemoveAliases = True Then
strSql = strSql & " AND pl_referrerhost NOT IN (" & strSiteAliases & ") "
End If
strSql = strSql & "GROUP BY pl_referrerdomain, pl_referrerextension " &_
"ORDER BY COUNT(pl_referrerdomain) DESC, pl_referrerdomain ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(2) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(2)
End If
Response.Write("
")
rsCount.Movenext
Loop
rsCount.Close
Set rsCount = Nothing
If blnPageCount=True Then
Response.Write("
")
Response.Write("
Total:
")
Response.Write("
" & intTotal & "
")
Response.Write("
")
If blnShowGraph = True Then
Response.Write("
")
End If
Response.Write("
")
Response.Write("
")
End if
Case "REFERRERHOSTS"
If blnAnalyzeData Then
Call GenerateReferrerHostData(datReportStart, datReportEnd)
End If
intTotal = CountTotalReferrers(datReportStart, datReportEnd, "Host")
With Response
.Write("
")
End With
strSql = "SELECT TOP " & intReportItems & " pl_referrerhost, pl_referrerdomain, pl_referrerextension, COUNT(pl_referrerhost) FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrerhost <> '' "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
If blnRemoveAliases = True Then
strSql = strSql & " AND pl_referrerhost NOT IN (" & strSiteAliases & ") "
End If
strSql = strSql & "GROUP BY pl_referrerhost, pl_referrerdomain, pl_referrerextension " &_
"ORDER BY COUNT(pl_referrerhost) DESC, pl_referrerhost ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(3) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(3)
End If
Response.Write("
")
rsCount.Movenext
Loop
rsCount.Close
Set rsCount = Nothing
If blnPageCount=True Then
Response.Write("
")
Response.Write("
Total:
")
Response.Write("
" & intTotal & "
")
Response.Write("
")
If blnShowGraph = True Then
Response.Write("
")
End If
Response.Write("
")
Response.Write("
")
End if
Case "REFERRERPAGES"
If blnAnalyzeData Then
Call GenerateReferrerPageData(datReportStart, datReportEnd)
End If
intTotal = CountTotalReferrers(datReportStart, datReportEnd, "Page")
With Response
.Write("
")
End With
strSql = "SELECT TOP " & intReportItems & " pl_referrerurl, pl_referrerdomain, pl_referrerextension, COUNT(pl_referrerurl) " &_
"FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrerurl<>'' "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
If blnRemoveAliases = True Then
strSql = strSql & " AND pl_referrerhost NOT IN (" & strSiteAliases & ") "
End If
strSql = strSql & "GROUP BY pl_referrerurl, pl_referrerdomain, pl_referrerextension " &_
"ORDER BY COUNT(pl_referrerurl) DESC, pl_referrerurl ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(3) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(3)
End If
strTruncatedUrl = TruncateUrl(rsCount(0), False)
Response.Write("
")
End With
strSql = "SELECT TOP " & intReportItems & " pl_referrer, pl_referrerdomain, pl_referrerextension, COUNT(pl_referrer) " &_
"FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrer <> '' "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
If blnRemoveAliases = True Then
strSql = strSql & "AND pl_referrerhost NOT IN (" & strSiteAliases & ") "
End If
strSql = strSql & "GROUP BY pl_referrer, pl_referrerdomain, pl_referrerextension " &_
"ORDER BY COUNT(pl_referrer) DESC, pl_referrer ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(3) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(3)
End If
strTruncatedUrl = TruncateUrl(rsCount(0), True)
Response.Write("
")
rsCount.Movenext
Loop
rsCount.Close
Set rsCount = Nothing
If blnPageCount=True Then
Response.Write("
")
Response.Write("
Total:
")
Response.Write("
" & intTotal & "
")
Response.Write("
")
If blnShowGraph = True Then
Response.Write("
")
End If
Response.Write("
")
Response.Write("
")
End if
Case "REFERREREXTENSIONS"
If blnAnalyzeData Then
Call GenerateReferrerExtensionData(datReportStart, datReportEnd)
End If
intTotal = CountTotalReferrers(datReportStart, datReportEnd, "Extension")
With Response
.Write("
")
End With
strSql = "SELECT TOP " & intReportItems & " pl_referrerextension, COUNT(pl_referrer) FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrerextension <> '' "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
If blnRemoveAliases = True Then
strSql = strSql & "AND pl_referrerhost NOT IN (" & strSiteAliases & ") "
End If
strSql = strSql & "GROUP BY pl_referrerextension " &_
"ORDER BY COUNT(pl_referrerextension) DESC, pl_referrerextension ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(1) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(1)
End If
Response.Write("
")
End With
strSql = "SELECT TOP " & intReportItems & " pl_ipaddress, pl_remotehost, COUNT(pl_ipaddress) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_ipaddress, pl_remotehost FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_ipaddress <> '' ) DT_PageLog " &_
"GROUP BY pl_ipaddress, pl_remotehost " &_
"ORDER BY COUNT(pl_ipaddress) DESC, pl_ipaddress ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(2) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(2)
End If
Response.Write("
")
End With
strSql = "SELECT TOP " & intReportItems & " pl_ipaddress, pl_remotehost, COUNT(pl_ipaddress) " &_
"FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_ipaddress <> '' " &_
"GROUP BY pl_ipaddress, pl_remotehost " &_
"ORDER BY COUNT(pl_ipaddress) DESC, pl_ipaddress ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(2) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(2)
End If
Response.Write("
")
End With
' COUNT TOTAL LANGUAGES
strSql = "SELECT COUNT(pl_language) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_language FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_language <> '') DT_PageLog"
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTotal=rsCount(0)
Else
intTotal=0
End If
rsCount.Close
Set rsCount = Nothing
strSql = "SELECT TOP " & intReportItems & " pl_language, COUNT(pl_language) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_language FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_language <> '') DT_PageLog " &_
"GROUP BY pl_language " &_
"ORDER BY COUNT(pl_language) DESC, pl_language ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(1) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(1)
End If
Response.Write("
")
End With
strSql = "SELECT COUNT(pl_os) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_os FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_os <> '' ) DT_PageLog"
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTotal=rsCount(0)
Else
intTotal=0
End If
rsCount.Close
Set rsCount = Nothing
strSql = "SELECT TOP " & intReportItems & " pl_os, COUNT(pl_os) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_os FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_os <> '') DT_PageLog " &_
"GROUP BY pl_os " &_
"ORDER BY COUNT(pl_os) DESC, pl_os ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(1) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(1)
End If
Response.Write("
")
End With
strSql = "SELECT COUNT(pl_browser) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_browser FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_browser <> '' " &_
"AND pl_browsertype = 'Browser') DT_PageLog"
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTotal = rsCount(0)
Else
intTotal = 0
End If
rsCount.Close
Set rsCount = Nothing
strSql = "SELECT TOP " & intReportItems & " pl_browser, COUNT(pl_browser) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_browser FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_browser <> '' " &_
"AND pl_browsertype = 'Browser') DT_PageLog " &_
"GROUP BY pl_browser " &_
"ORDER BY COUNT(pl_browser) DESC, pl_browser ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(1) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(1)
End If
Response.Write("
")
End With
strSql = "SELECT COUNT(pl_browser) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_browser FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_browsertype = 'Robot') DT_PageLog"
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTotal=rsCount(0)
Else
intTotal=0
End If
rsCount.Close
Set rsCount = Nothing
strSql = "SELECT TOP " & intReportItems & " pl_browser, COUNT(pl_browser) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_browser FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_browser <> '' " &_
"AND pl_browsertype = 'Robot') DT_PageLog " &_
"GROUP BY pl_browser " &_
"ORDER BY COUNT(pl_browser) DESC, pl_browser ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(1) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(1)
End If
Response.Write("
")
End With
strSql = "SELECT COUNT(pl_keywords) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_keywords FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_keywords <> '') dt_PageLog "
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTotal = rsCount(0)
Else
intTotal = 0
End If
rsCount.Close
Set rsCount = Nothing
strSql = "SELECT TOP " & intReportItems & " pl_keywords, COUNT(pl_keywords) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_keywords FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_keywords <> '') dt_PageLog " &_
"GROUP BY pl_keywords " &_
"ORDER BY COUNT(pl_keywords) DESC, pl_keywords ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(1) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(1)
End If
Response.Write("
")
End With
strSql = "SELECT COUNT(pl_screenarea) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_screenarea FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_screenarea <> '') dt_PageLog "
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTotal=rsCount(0)
Else
intTotal=0
End If
rsCount.Close
Set rsCount = Nothing
strSql = "SELECT TOP " & intReportItems & " pl_screenarea, COUNT(pl_screenarea) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_screenarea FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_screenarea <> '') dt_PageLog " &_
"GROUP BY pl_screenarea " &_
"ORDER BY COUNT(pl_screenarea) DESC, pl_screenarea ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(1) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(1)
End If
Response.Write("
")
End With
strSql = "SELECT COUNT(pl_useragent) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_useragent FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_useragent <> '') dt_PageLog "
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTotal = rsCount(0)
Else
intTotal = 0
End If
rsCount.Close
Set rsCount = Nothing
strSql = "SELECT TOP " & intReportItems & " pl_useragent, pl_browser, COUNT(pl_useragent) " &_
"FROM (SELECT DISTINCT pl_sessionid, pl_useragent, pl_browser FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_useragent <> '') dt_PageLog " &_
"GROUP BY pl_useragent, pl_browser " &_
"ORDER BY COUNT(pl_useragent) DESC, pl_useragent ASC"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
Response.Write("
")
blnPageCount=True
Else
Response.Write("
There is no data to display.
")
End if
Do While Not rsCount.Eof
If intTotal > 0 Then
sngPercent = FormatPercent(rsCount(2) / intTotal, 2)
Else
sngPercent = FormatPercent(0, 2)
End If
intRow = intRow + 1
If (intRow Mod 2) = 1 Then
strClass = "data"
Else
strClass = "dataalt"
End If
If intRow = 1 Then
intMaxNumber = rsCount(2)
End If
Response.Write("
")
rsCount.Movenext
Loop
rsCount.Close
Set rsCount = Nothing
If blnPageCount=True Then
Response.Write("
")
Response.Write("
Total:
")
Response.Write("
" & intTotal & "
")
Response.Write("
")
If blnShowGraph = True Then
Response.Write("
")
End If
Response.Write("
")
Response.Write("
")
End if
End Select
End Sub
Public Sub GenerateSetup()
Dim strTable, datStart, datEnd
If strAction <> "COMPACT" Then
Call CreateDatabaseConnection(DatabaseType, DatabaseLocation, DatabaseName, _
DatabaseUsername, DatabasePassword)
End If
If blnLog = True And DatabaseType = "MSACCESS" Then
With Response
.Write ("
WARNING! Logging is enabled in the config file. ")
.Write ("If you have configured pages to log, it is recommended you set ")
.Write ("this to false before compacting / repairing the database.
")
End With
End If
Select Case strAction
Case "DELETE"
strTable = Request.Form("table")
datStart = Request.Form("startdate")
datEnd = Request.Form("enddate")
Response.Write ("
Deleting Records...
")
Call DeleteRecords(datStart, datEnd, strTable)
Case "COMPACT"
Response.Write ("
Compacting Database...
")
Call CompactDatabase(strDatabaseLocation, strDatabaseName)
Call CreateDatabaseConnection(DatabaseType, DatabaseLocation, DatabaseName, _
DatabaseUsername, DatabasePassword)
End Select
With Response
If strDatabaseType = "MSSQL" Then
Call DisplayMSSQLSetup()
Else
Call DisplayMSACCESSSetup()
End If
End With
Call CloseDatabaseConnection()
End Sub
Private Sub DisplayMSACCESSSetup()
Dim intRecords, datStart, datEnd
Response.Write ("
")
Response.Write ("
")
Response.Write ("
")
Response.Write ("
Database Information
")
intRecords = CountRecords("PageLog")
If intRecords > 0 Then
datStart = GetLogDate("PageLog", "MIN")
datEnd = GetLogDate("PageLog", "MAX")
End If
With Response
.Write ("
Rows
")
.Write ("
" & intRecords & "
")
.Write ("
Log Start
")
.Write ("
" & datStart & "
")
.Write ("
Log End
")
.Write ("
" & datEnd & "
")
.Write ("
")
.Write ("
")
.Write("
")
.Write("
")
.Write("
Database Maintenance
")
End With
If intRecords > 0 Then
With Response
.Write("")
End With
End If
With Response
.Write("")
.Write("
")
.Write ("
")
End With
End Sub
Private Sub DisplayMSSQLSetup()
Dim objRS, strTable, intRecords, strError, datStart, datEnd
Dim intForm
Const AdSchemaTables = 20
intForm = 0
Set objRS = objConn.OpenSchema(adSchemaTables)
If Not objRS.EOF Then
Response.Write ("
")
Response.Write("
Table
Rows
Log Start
Log End
")
Response.Write("
Delete Records
")
objRs.MoveFirst
While Not objRS.EOF
intForm = intForm + 1
strTable = objRS("Table_Name")
If UCase(Right(strTable, 7)) = "PAGELOG" Then
Response.Write("
")
Response.Write("
" & strTable & "
")
intRecords = CountRecords(strTable)
If intRecords > 0 Then
datStart = GetLogDate(strTable, "MIN")
datEnd = GetLogDate(strTable, "MAX")
End If
Response.Write("
" & intRecords & "
")
If intRecords > 0 Then
Response.Write("
" & datStart & "
")
Response.Write("
" & datEnd & "
")
Else
Response.Write("
")
Response.Write("
")
End If
If intRecords > 0 Then
Response.Write("")
Else
Response.Write("
")
End If
Response.Write("
") & vbcrlf & vbcrlf
End If
objRs.MoveNext
Wend
Response.Write("
")
Else
Response.Write ("
Database is empty.
")
End If
objRs.Close
Set objRs = Nothing
End Sub
Private Function GetLogDate(strTable, strType)
Dim strSql, objRs, datTemp
strType = UCase(strType)
strSql = "SELECT " & strType & "(pl_datetime) FROM " & strTable
Set objRs = objConn.Execute(strSql)
If Not objRs.Eof Then
datTemp = FormatDateTime(objRS(0), 2)
Else
datTemp = "Empty"
End If
objRs.Close
Set objRs = Nothing
GetLogDate = datTemp
End Function
Private Function CountRecords(strTable)
Dim strSql, objRs, intRecords
strSql = "SELECT COUNT(*) FROM " & strTable
Set objRs = objConn.Execute(strSql)
If Not objRs.Eof Then
intRecords = objRs(0)
Else
intRecords = 0
End If
objRs.Close
Set objRs = Nothing
CountRecords = intRecords
End Function
Private Sub DeleteRecords(datStart, datEnd, strTable)
Dim strSql
strSql = "DELETE FROM " & strTable & " " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datEnd & " 23:59:59")
objConn.Execute(strSql)
Response.Write "
Successfully deleted records between " & datStart & " and " & datEnd & ".
"
End Sub
Private Sub CompactDatabase(strLocation, strName)
Dim objFSO, objJRO
Dim strConn, strConnBak, strLocationType, strDB
Dim intRandom, intMinutes, intSeconds, strTempDB
' CREATE RANDOM NUMBER
intSeconds = Second(Now())
intMinutes = Minute(Now())
intRandom = intMinutes * intSeconds
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
' CHECK TO SEE IF THERE IS A COLON IN strLOCATION
If Len(strLocation) > 2 Then
If Mid(strLocation, 2, 1) = ":" Or Mid(strLocation, 1, 2) = "\\" Then
' PATH USES A DRIVE LETTER, MUST BE ABSOLUTE
strLocationType = "ABSOLUTE"
Else
strLocationType = "VIRTUAL"
End If
Else
strLocationType = "VIRTUAL"
End If
If strLocationType = "ABSOLUTE" Then
strDB = strLocation & "\" & strName
strTempDB = strLocation & "\" & "db" & intRandom & ".mdb"
Else ' VIRTUAL
strDB = Server.MapPath(strLocation & "/" & strName)
strTempDB = Server.MapPath(strLocation & "/" & "db" & intRandom & ".mdb")
End If
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDB
strConnBak = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strTempDB
Set objJRO = Server.CreateObject("JRO.JetEngine")
objJRO.CompactDatabase strConn, strConnBak
Set objJRO = Nothing
If objFSO.FileExists(strDB) And objFSO.FileExists(strTempDB) Then
objFSO.DeleteFile(strDB)
objFSO.MoveFile strTempDB, strDB
Response.Write "
Compact and Repair was successful.
"
Else
Response.Write "
Compact and Repair failed.
"
End If
Set objFSO = Nothing
End Sub
' **************************
' * VERSION / LICENSE INFO *
' **************************
Public Function ShowVersionInfo()
ShowVersionInfo = "MetaTraffic v1.301"
End Function
Public Function ShowProductInfo()
Dim strTemp
strTemp = "
" &_
"
ABOUT METATRAFFIC
" &_
"If you are using MetaTraffic on a commercial site, " &_
"you must purchase a license to use MetaTraffic beyond the 30 day trial period.
"
ShowProductInfo = strTemp
End Function
' ************
' * DATABASE *
' ************
Public Sub CreateDatabaseConnection(strType, strLocation, strName, strUsername, strPassword)
Dim strConn, strLocationType, strTemp
Select Case strType
Case "MSSQL"
strTemp = "SERVER=" & strLocation & ";Database=" & strName &_
";UID=" & strUsername & ";PWD=" & strPassword
strConn = "DRIVER={SQL Server};" & strTemp
Case Else
' CHECK TO SEE IF THERE IS A COLON IN strLOCATION
If Len(strLocation) > 2 Then
If Mid(strLocation, 2, 1) = ":" Or Mid(strLocation, 1, 2) = "\\" Then
' PATH USES A DRIVE LETTER, MUST BE ABSOLUTE
strLocationType = "ABSOLUTE"
Else
strLocationType = "VIRTUAL"
End If
Else
strLocationType = "VIRTUAL"
End If
If strLocationType = "ABSOLUTE" Then
strTemp = strLocation & "\" & strName
Else ' VIRTUAL
strTemp = Server.MapPath(strLocation & "/" & strName)
End If
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strTemp
End Select
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.Mode = 3 '3 = adModeReadWrite
objConn.CommandTimeout = 120
objConn.ConnectionTimeout = 30
objConn.Open strConn
End Sub
Public Sub CloseDatabaseConnection()
objConn.Close
Set objConn = Nothing
End Sub
' ************************************
' * DATE / TIME FORMATTING AND MISC. *
' ************************************
Private Function GetLogRange()
' GET FIRST HIT DATE, LAST HIT DATE
strSql = "SELECT MIN(pl_datetime), MAX(pl_datetime) FROM " & strInstance & "PageLog"
Set rsConfig = objConn.Execute(strSql)
If Not rsConfig.Eof Then
datFirstHit = rsConfig(0)
datLastHit = rsConfig(1)
End If
rsConfig.Close
Set rsConfig = Nothing
End Function
Public Function FormatDatabaseDate(datDate)
Dim datDateTemp, datTimeTemp, strDateFormat, strTimeFormat
Dim datTemp, strSeparator, strDatabaseType
Dim datDatabaseDate, datDatabaseTime, datFull
strDatabaseType = DatabaseType
' SET DATABASE DATE AND TIME FORMATS
If strDatabaseType = "MSSQL" Then
strDateFormat = "YYYYMMDD"
Else
strDateFormat = "YYYY-MM-DD"
End If
strTimeFormat = "HH:MM:SS"
' MAKE SURE FORMAT IS ALL UPPERCASE
datDateTemp = UCase(strDateFormat)
datTimeTemp = UCase(strTimeFormat)
' BEGIN REPLACING TOKENS ON DATE
datDateTemp = Replace(datDateTemp, "DD", FormatDatePart(Day(datDate)))
datDateTemp = Replace(datDateTemp, "MMMM", MonthName(Month(datDate), False))
datDateTemp = Replace(datDateTemp, "MMM", MonthName(Month(datDate), True))
datDateTemp = Replace(datDateTemp, "MM", FormatDatePart(Month(datDate)))
datDateTemp = Replace(datDateTemp, "YYYY", Year(datDate))
datDateTemp = Replace(datDateTemp, "YY", Right(Year(datDate), 2))
' BEGIN REPLACING TOKENS ON TIME
datTimeTemp = Replace(datTimeTemp, "HH", FormatDatePart(DatePart("h", datDate)))
datTimeTemp = Replace(datTimeTemp, "MM", FormatDatePart(DatePart("n", datDate)))
datTimeTemp = Replace(datTimeTemp, "SS", FormatDatePart(DatePart("s", datDate)))
' SEPARATOR DEPENDS ON THE DATABASE TYPE
If strDatabaseType = "MSSQL" Then
strSeparator = "'"
Else
strSeparator = "#"
End If
' BUILD FINAL DATE FORMAT
datTemp = strSeparator & datDateTemp & " " & datTimeTemp & strSeparator
FormatDatabaseDate = datTemp
End Function
Private Function FormatDatabaseString(strString, intLength)
Dim strTemp
strTemp = "'" & Replace(Left(strString, intLength), "'", "''") & "'"
FormatDatabaseString = strTemp
End Function
Private Function FormatDate (intDay, intMonth, intYear)
Dim datTemp, datReference
datReference = Date()
datTemp = datReference
' SET YEAR
datTemp = DateAdd("yyyy", intYear - Year(datReference), datTemp)
' SET MONTH
datTemp = DateAdd("m", intMonth - Month(datReference), datTemp)
' SET DAY
datTemp = DateAdd("d", intDay - Day(datReference), datTemp)
FormatDate = datTemp
End Function
' ADDS A ZERO TO BEGINNING OF DATE PART
Private Function FormatDatePart(datPart)
Dim datTemp
If Len(datPart) = 1 Then
datTemp = "0" & datPart
Else
datTemp = datPart
End If
FormatDatePart = datTemp
End Function
' ************
' * COUNTING *
' ************
Public Function CountPageViews(datReportStart, datReportEnd, strScriptName)
Dim intTemp
strSql = "SELECT COUNT(pl_scriptname) FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
If strScriptName <> "" Then
strSql = strSql & "AND pl_scriptname LIKE '" & strScriptName & "'"
End If
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
CountPageViews = intTemp
End Function
' COUNT REFERRED VISITS
Public Function CountReferredVisits(datReportStart, datReportEnd)
Dim intTemp
If DatabaseType = "MSSQL" Then
strSql = "SELECT COUNT(DISTINCT pl_sessionid) FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_referrer <> '' "
If blnRemoveAliases = True Then
strSql = strSql & "AND pl_referrerhost NOT IN (" & strSiteAliases & ")"
End If
Else
strSql = "SELECT COUNT(pl_sessionid) FROM (SELECT DISTINCT pl_sessionid FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & "AND pl_referrer <> '' "
If blnRemoveAliases = True Then
strSql = strSql & "AND pl_referrerhost NOT IN (" & strSiteAliases & ")"
End If
strSql = strSql & ")"
End If
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
CountReferredVisits = intTemp
End Function
Public Function CountTotalReferrers(datReportStart, datReportEnd, strType)
Dim intTemp
Select Case strType
Case "Domain"
strSql = "SELECT COUNT(pl_referrerdomain) FROM " & strInstance & "PageLog " &_
"WHERE pl_referrerdomain <> '' "
Case "Host"
strSql = "SELECT COUNT(pl_referrerhost) FROM " & strInstance & "PageLog " &_
"WHERE pl_referrerhost <> '' "
Case "Page"
strSql = "SELECT COUNT(pl_referrerurl) FROM " & strInstance & "PageLog " &_
"WHERE pl_referrerurl <> '' "
Case "Extension"
strSql = "SELECT COUNT(pl_referrerextension) FROM " & strInstance & "PageLog " &_
"WHERE pl_referrerextension <> '' "
Case Else 'Url
strSql = "SELECT COUNT(pl_referrer) FROM " & strInstance & "PageLog " &_
"WHERE pl_referrer <> '' "
End Select
strSql = strSql & "AND pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
If blnRemoveAliases = True Then
strSql = strSql & "AND pl_referrerhost NOT IN (" & strSiteAliases & ") "
End If
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
CountTotalReferrers = intTemp
End Function
Public Function CountDistinctReferrers(datReportStart, datReportEnd, strType)
Dim intTemp
Select Case strType
Case "Domain"
strSql = "SELECT COUNT(pl_referrerdomain) FROM " &_
"(SELECT DISTINCT pl_referrerdomain FROM " & strInstance & "PageLog "
Case "Host"
strSql = "SELECT COUNT(pl_referrerhost) FROM " &_
"(SELECT DISTINCT pl_referrerhost FROM " & strInstance & "PageLog "
Case "Page"
strSql = "SELECT COUNT(pl_referrerurl) FROM " &_
"(SELECT DISTINCT pl_referrerurl FROM " & strInstance & "PageLog "
Case Else 'Url
strSql = "SELECT COUNT(pl_referrer) FROM " &_
"(SELECT DISTINCT pl_referrer FROM " & strInstance & "PageLog "
End Select
strSql = strSql & "WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
If blnRemoveAliases = True Then
strSql = strSql & "AND pl_referrerhost NOT IN (" & strSiteAliases & ")"
End If
strSql = strSql & "AND pl_referrer <> ''" &_
") dt_PageLog"
Set rsCount=objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
CountDistinctReferrers = intTemp
End Function
Public Function CountDistinctPages()
Dim intTemp
' COUNT DISTINCT PAGES
If DatabaseType = "MSSQL" Then
strSql = "SELECT COUNT(DISTINCT pl_scriptname) FROM " & strInstance & "PageLog"
Else
strSql = "SELECT COUNT(pl_scriptname) FROM (SELECT DISTINCT pl_scriptname FROM " & strInstance & "PageLog)"
End If
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
CountDistinctPages = intTemp
End Function
Public Function CountVisits(datReportStart, datReportEnd)
Dim intTemp
' COUNT DISTINCT VISITS
If DatabaseType = "MSSQL" Then
strSql = "SELECT COUNT(DISTINCT pl_sessionid) FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
Else
strSql = "SELECT COUNT(pl_sessionid) FROM (SELECT DISTINCT pl_sessionid FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & ")"
End If
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
CountVisits = intTemp
End Function
Public Function CountVisitors(datReportStart, datReportEnd)
Dim intTemp
' COUNT DISTINCT VISITS
If DatabaseType = "MSSQL" Then
strSql = "SELECT COUNT(DISTINCT pl_ipaddress) FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
Else
strSql = "SELECT COUNT(pl_ipaddress) FROM (SELECT DISTINCT pl_ipaddress FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " "
If blnExcludeRobots = True Then
strSql = strSql & "AND pl_browsertype <> 'Robot' "
End If
strSql = strSql & ")"
End If
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
CountVisitors = intTemp
End Function
Public Function CountUsersOnline()
Dim intTemp, datNow
' WHO'S ONLINE REPORT
datNow = Now()
strSql = "SELECT COUNT(pl_ipaddress) FROM (SELECT DISTINCT pl_ipaddress FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " &_
FormatDatabaseDate(Dateadd("n", (0 - intSessionDuration), datNow)) &_
" AND " & FormatDatabaseDate(datNow) & ") DT_PageLog"
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
CountUsersOnline = intTemp
End Function
Public Function GetStartDate()
Dim strSql, objRs, datTemp
strSql = "SELECT MIN(pl_datetime) FROM " & strInstance & "PageLog"
Set objRs = objConn.Execute(strSql)
If Not objRs.Eof Then
datTemp = FormatDateTime(objRS(0), 2)
Else
datTemp = Empty
End If
objRs.Close
Set objRs = Nothing
GetStartDate = datTemp
End Function
' *****************
' * MISC. LOGGING *
' *****************
Private Function ExtractScriptName(strScriptName)
Dim strTemp, objSearch
strTemp = strScriptName
Set objSearch = New RegExp
With objSearch
.Pattern = "(http|https)://[\w|-|\.]+"
.IgnoreCase = True
.Global = False
End With
' REPLACE PATTERN MATCH WITH AN EMPTY STRING
strTemp = objSearch.Replace(strTemp, "")
If Instr(strTemp, "?") > 0 Then
strTemp = Mid(strTemp, 1, Instr(strTemp, "?") - 1)
End If
Set objSearch = Nothing
ExtractScriptName = strTemp
End Function
Private Function ExtractQuerystring(strScriptName)
Dim strTemp, strQuerystring
strTemp = strScriptName
If Instr(strTemp, "?") > 0 Then
strQuerystring = Mid(strTemp, Instr(strTemp, "?") + 1)
Else
strQuerystring = ""
End If
ExtractQuerystring = strQuerystring
End Function
Public Function MatchIPAddress(strIPList)
Dim aryIPAddress, strIPAddress, intLoop, blnMatch
Dim aryIPAddressList, aryIPAddressSource, strIPAddressCheck
blnMatch = False
aryIPAddress = Split(Replace(strIPList, " ", ""), ",")
strIPAddress = Request.Servervariables("REMOTE_ADDR")
' CHECK TO SEE IF A MATCH
For intLoop = 0 To UBound(aryIPAddress)
' DO A DIFFERENT CHECK IF THERE'S A WILDCARD
If Instr(aryIPAddress(intLoop), "*") Then
' CONVERT IP SOURCE AND LIST INTO MINI ARRAYS
aryIPAddressList = Split(aryIPAddress(intLoop), ".")
aryIPAddressSource = Split(strIPAddress, ".")
If UBound(aryIPAddressList) = 3 And UBound(aryIPAddressSource) = 3 Then
If aryIPAddressList(2) = "*" Then
aryIPAddressList(2) = aryIPAddressSource(2)
End If
If aryIPAddressList(3) = "*" Then
aryIPAddressList(3) = aryIPAddressSource(3)
End If
'RE-ASSEMBLE IP ADDRESS FROM MINI ARRAY
strIPAddressCheck = aryIPAddressList(0) & "." & aryIPAddressList(1) & "." & aryIPAddressList(2) & "." & aryIPAddressList(3)
' CHECK FOR MATCH
If strIPAddress = strIPAddressCheck Then
blnMatch = True
Exit For
End If
End If
Else ' NO WILDCARD -- SIMPLE CHECK
If strIPAddress = aryIPAddress(intLoop) Then
blnMatch = True
Exit For
End If
End If
Next
MatchIPAddress = blnMatch
End Function
' ****************************
' * REPORT GENERATOR DISPLAY *
' ****************************
Public Sub GenerateReportChooser(strReport, intSize)
' SET DEFAULTS
If strReport = "" Then
strReport = "TRAFFICSUMMARY"
End If
If IsNumeric(intReportChooserSize) = False Then
intReportChooser = 1
End If
With Response
.Write("")
End With
End Sub
Public Sub GeneratePresetDates(strPresetDate)
With Response
.Write("")
End With
End Sub
Public Sub GenerateItemsChooser(intReportItems)
If CInt(intReportItems) = 0 Then
intReportItems = 50
End If
With Response
.Write("")
End With
End Sub
Public Sub GenerateCalendarJS()
With Response
.Write(" function calendar(formname,currentdate)" & vbcrlf)
.Write(" {" & vbcrlf)
.Write(" self.name = 'opener';" & vbcrlf)
.Write(" remote = open('calendar.asp?name=' + formname + '&sdate=' + currentdate, 'remote', 'width=160,height=165,location=no,scrollbars=no,menubars=no,toolbars=no,resizable=yes,fullscreen=no');" & vbcrlf)
.Write(" remote.focus();" & vbcrlf)
.Write(" }" & vbcrlf)
End With
End Sub
Public Sub GenerateHelpJS()
With Response
.Write(" function showhelp(bookmark)" & vbcrlf)
.Write(" {" & vbcrlf)
.Write(" self.name = 'opener';" & vbcrlf)
.Write(" helpwin = open('help.htm#' + bookmark, 'helpwin', 'width=400,height=500,location=no,scrollbars=yes,menubars=no,toolbars=no,resizable=yes,fullscreen=no');" & vbcrlf)
.Write(" helpwin.focus();" & vbcrlf)
.Write(" }" & vbcrlf)
End With
End Sub
Public Sub GeneratePresetDatesJS()
With Response
.Write("function presetdate()" & vbcrlf)
.Write("{" & vbcrlf)
.Write("if (document.report.PresetDate.value == 'TODAY')" & vbcrlf)
.Write(" {" & vbcrlf)
.Write(" document.report.StartDate.value='" & Date() & "';" & vbcrlf)
.Write(" document.report.EndDate.value='" & Date() & "';" & vbcrlf)
.Write(" }" & vbcrlf)
.Write("if (document.report.PresetDate.value=='YESTERDAY')" & vbcrlf)
.Write(" {" & vbcrlf)
.Write(" document.report.StartDate.value='" & DateAdd("d", -1, Date()) & "';" & vbcrlf)
.Write(" document.report.EndDate.value='" & DateAdd("d", -1, Date()) & "';" & vbcrlf)
.Write(" } " & vbcrlf)
.Write("if (document.report.PresetDate.value=='LASTWEEKROLL')" & vbcrlf)
.Write(" {" & vbcrlf)
.Write(" document.report.StartDate.value='" & DateAdd("d", -7, Date()) & "';" & vbcrlf)
.Write(" document.report.EndDate.value='" & DateAdd("d", -1, Date()) & "';" & vbcrlf)
.Write(" } " & vbcrlf)
.Write("if (document.report.PresetDate.value=='THISMONTH')" & vbcrlf)
.Write(" {" & vbcrlf)
.Write(" document.report.StartDate.value='" & FormatDate(1, Month(Date()), Year(Date())) & "';" & vbcrlf)
.Write(" document.report.EndDate.value='" & Date() & "';" & vbcrlf)
.Write(" }" & vbcrlf)
.Write("if (document.report.PresetDate.value=='LASTMONTH')" & vbcrlf)
.Write(" {" & vbcrlf)
.Write(" document.report.StartDate.value='" & FormatDate(1, Month(DateAdd("m", -1, Date())), Year(DateAdd("m", -1, Date()))) & "';" & vbcrlf)
.Write(" document.report.EndDate.value='" & FormatDate(Day(DateAdd("d", 0 - Day(Date()), Date())), Month(DateAdd("m", -1, Date())), Year(DateAdd("m", -1, Date()))) & "';" & vbcrlf)
.Write(" } " & vbcrlf)
.Write("if (document.report.PresetDate.value=='LASTMONTHROLL')" & vbcrlf)
.Write(" {" & vbcrlf)
.Write(" document.report.StartDate.value='" & DateAdd("m", -1, Date()) & "';" & vbcrlf)
.Write(" document.report.EndDate.value='" & DateAdd("d", -1, Date()) & "';" & vbcrlf)
.Write(" } " & vbcrlf)
.Write("}")
End With
End Sub
' *********************
' * REPORT GENERATION *
' *********************
Private Function GetMaxPageViews(datReportStart, datReportEnd)
Dim intTemp
strSql = "SELECT MAX(PageCount) FROM " &_
"(SELECT COUNT(pl_scriptname) AS PageCount FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"GROUP BY YEAR(pl_datetime), MONTH(pl_datetime), DAY(pl_datetime)) dt_PageLog "
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
GetMaxPageViews = intTemp
End Function
Private Function GetMaxHourlyPageViews(datReportStart, datReportEnd)
Dim intTemp
If DatabaseType = "MSSQL" Then
strSql = "SELECT MAX(HourCount) " &_
"FROM (SELECT COUNT(pl_scriptname) AS HourCount " &_
"FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"GROUP BY DATEPART(hh, pl_datetime)) dt_PageLog"
Else
strSql = "SELECT MAX(HourCount) " &_
"FROM (SELECT COUNT(pl_scriptname) AS HourCount " &_
"FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"GROUP BY HOUR(pl_datetime)) dt_PageLog"
End If
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
GetMaxHourlyPageViews = intTemp
End Function
Private Function GetMaxVisitors(datReportStart, datReportEnd)
Dim intTemp
strSql = "SELECT MAX(VisitorCount) FROM " &_
"(SELECT LogYear, LogMonth, LogDay, COUNT(pl_ipaddress) As VisitorCount FROM " &_
"(SELECT DISTINCT YEAR(pl_datetime) AS LogYear, MONTH(pl_datetime) AS LogMonth, DAY(pl_datetime) AS LogDay, pl_ipaddress FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " ) DT_PageLog " &_
"GROUP BY LogYear, LogMonth, LogDay) DT2_PageLog "
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
GetMaxVisitors = intTemp
End Function
Private Function GetMaxVisits(datReportStart, datReportEnd)
Dim intTemp
strSql = "SELECT MAX(VisitCount) FROM " &_
"(SELECT LogYear, LogMonth, LogDay, COUNT(pl_sessionid) As VisitCount FROM " &_
"(SELECT DISTINCT YEAR(pl_datetime) AS LogYear, MONTH(pl_datetime) AS LogMonth, DAY(pl_datetime) AS LogDay, pl_sessionid FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " ) DT_PageLog " &_
"GROUP BY LogYear, LogMonth, LogDay) DT2_PageLog "
Set rsCount = objConn.Execute(strSql)
If Not rsCount.Eof Then
intTemp = rsCount(0)
Else
intTemp = 0
End If
rsCount.Close
Set rsCount = Nothing
GetMaxVisits = intTemp
End Function
Private Function DisplayReportDate(datReportStart, datReportEnd)
Dim strTemp, datRange
If FormatDateTime(datReportStart, 1) = FormatDateTime(datReportEnd, 1) Then
datRange = FormatDateTime(datReportStart, 1)
Else
datRange = FormatDateTime(datReportStart, 1) & " - " & FormatDateTime(datReportEnd, 1)
End If
strTemp = datRange
DisplayReportdate = strTemp
End Function
Private Function DisplayDomainWhois(strData, strType)
Dim strTemp, strExtension
If Len(strType) > 1 Then
strExtension = Right(strType, InStr(StrReverse(strType), "."))
Else
strExtension = ""
End If
Select Case strExtension
Case ".aero", ".arpa", ".biz", ".com", ".coop", ".edu", ".info", ".int", ".museum", ".net", ".org"
strTemp = "
"
End Select
DisplayDomainWhois = strTemp
End Function
Private Function DisplayIPWhois(strData)
Dim strTemp
strTemp = "" & vbcrlf
DisplayIPWhois = strTemp
End Function
Private Function DisplayRobotLink(strData)
Dim strTemp, aryRobot, intLoop, strLink
aryRobot = GetRobotArray()
For intLoop = 0 To UBound(aryRobot)
If aryRobot(intLoop, 0) = strData Then
strLink = aryRobot(intLoop, 2)
Exit For
End If
Next
If strLink <> "" Then
strTemp = "
"
End If
DisplayRobotLink = strTemp
End Function
Private Sub GenerateGraph(intNumber, intMaxNumber, strClass)
Dim intWidth, intMaxWidth
intMaxwidth = 150
If intMaxNumber > 0 Then
intWidth = Round(((intNumber / intMaxNumber) * intMaxWidth), 0)
With Response
.Write("
")
.Write("
")
.Write("
")
.Write("")
.Write("
")
.Write("
")
.Write("
")
End With
End If
End Sub
Private Function ShowExtensionDescription(strExtension)
Dim strDescription, aryExtensions, intLoop
aryExtensions = GetDomainExtensionArray()
For intLoop = 0 To UBound(aryExtensions)
'Response.Write strExtension & " - " & aryExtensions(intLoop, 1) & " "
If strExtension = Replace(aryExtensions(intLoop, 1), "\", "") Then
strDescription = aryExtensions(intLoop, 0)
Exit For
End If
Next
ShowExtensionDescription = strDescription
End Function
Private Function TruncateUrl(strUrl, blnQueryString)
Dim strTemp, strBase, colItem, intLoop, intLength
Dim objSearch, objBaseSearch, objBaseResults
Dim strMatch, strStart, strEnd, intPosition
intLength = 50
strTemp = strUrl
If Len(strTemp) > intLength Then
Set objBaseSearch = New RegExp
With objBaseSearch
.Pattern = "(http|https)://[\w|\-|\.|:]+/"
.IgnoreCase = True
.Global = False
End With
' CHECK FOR BASE URL
Set objBaseResults = objBaseSearch.Execute(strTemp)
If objBaseResults.Count > 0 Then
For Each colItem In objBaseResults
strBase = colItem.Value
Next
' REMOVE URL BASE BEFORE WE START LOOP
strTemp = Mid(strTemp, Len(strBase) + 1)
For intLoop = 1 To 10
Set objSearch = New RegExp
With objSearch
.Pattern = "[\w|\.|\-]+/"
.IgnoreCase = True
.Global = False
End With
' REPLACE PATTERN
strTemp = objSearch.Replace(strTemp, "##/")
Set objSearch = Nothing
If Len(strTemp) + Len(strBase) < intLength Then
Exit For
End If
Next
strTemp = Replace(strTemp, "##/", "../")
If blnQueryString = True And InStr(strTemp, "?") Then
Dim intCount
For intLoop = 1 To 10
Set objSearch = New RegExp
With objSearch
.Pattern = "[\w|\.|-|_|%|\.|\+]+=[\w|\.|\-|_|%|\.|\+]+"
.IgnoreCase = True
.Global = False
End With
' REPLACE PATTERN
strTemp = objSearch.Replace(strTemp, "##")
Set objSearch = Nothing
If Len(strTemp) + Len(strBase) < intLength Then
Exit For
End If
Next
strTemp = Replace(strTemp, "##", "::")
End If
' REASSEMBLE URL WITH BASE
strTemp = strBase & strTemp
End If
End If
Set objBaseSearch = Nothing
Set objBaseResults = Nothing
TruncateUrl = strTemp
End Function
' *******************
' * DATA GENERATION *
' *******************
Private Sub GenerateReferrerDomainData(datReportStart, datReportEnd)
Dim rsConn, strSql
Dim strReferrer, strDomain
strSql = "SELECT DISTINCT pl_referrer FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND (pl_referrer IS NOT NULL OR pl_referrer <> '') " &_
"AND (pl_referrerdomain IS NULL OR pl_referrerdomain='')"
Set rsConn = objConn.Execute(strSql)
Do While Not rsConn.Eof
' EXTRACT DOMAIN
strReferrer = rsConn(0)
strDomain = ExtractReferrerDomain(strReferrer)
' UPDATE RECORD
If strDomain <> "" Then
strSql = "UPDATE " & strInstance & "PageLog " &_
"SET pl_referrerdomain=" & FormatDatabaseString(strDomain, 150) & " " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrer=" & FormatDatabaseString(strReferrer, 255)
objConn.Execute(strSql)
End If
rsConn.Movenext
Loop
rsConn.Close
Set rsConn = Nothing
End Sub
Private Sub GenerateReferrerExtensionData(datReportStart, datReportEnd)
Dim rsConn, strSql
Dim strReferrer, strExtension
strSql = "SELECT DISTINCT pl_referrer FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND (pl_referrer IS NOT NULL OR pl_referrer <> '') " &_
"AND (pl_referrerextension IS NULL OR pl_referrerextension='')"
Set rsConn = objConn.Execute(strSql)
Do While Not rsConn.Eof
' EXTRACT EXTENSION
strReferrer = rsConn(0)
strExtension = ExtractReferrerExtension(strReferrer)
' UPDATE RECORD
If strExtension <> "" Then
strSql = "UPDATE " & strInstance & "PageLog " &_
"SET pl_referrerextension=" & FormatDatabaseString(strExtension, 10) & " " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrer=" & FormatDatabaseString(strReferrer, 255)
objConn.Execute(strSql)
End If
rsConn.Movenext
Loop
rsConn.Close
Set rsConn = Nothing
End Sub
Private Sub GenerateReferrerHostData(datReportStart, datReportEnd)
Dim rsConn, strSql
Dim strReferrer, strHost
strSql = "SELECT DISTINCT pl_referrer FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND (pl_referrer IS NOT NULL OR pl_referrer <> '') " &_
"AND (pl_referrerhost IS NULL OR pl_referrerhost='')"
Set rsConn = objConn.Execute(strSql)
Do While Not rsConn.Eof
' EXTRACT DOMAIN
strReferrer = rsConn(0)
strHost = ExtractReferrerHost(strReferrer)
' UPDATE RECORD
If strHost <> "" Then
strSql = "UPDATE " & strInstance & "PageLog " &_
"SET pl_referrerhost=" & FormatDatabaseString(strhost, 150) & " " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrer=" & FormatDatabaseString(strReferrer, 255)
objConn.Execute(strSql)
End If
rsConn.Movenext
Loop
rsConn.Close
Set rsConn = Nothing
End Sub
Private Sub GenerateReferrerPageData(datReportStart, datReportEnd)
Dim rsConn, strSql
Dim strReferrer, strUrl
strSql = "SELECT DISTINCT pl_referrer FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND (pl_referrer IS NOT NULL OR pl_referrer <> '') " &_
"AND (pl_referrerurl IS NULL OR pl_referrerurl='')"
Set rsConn = objConn.Execute(strSql)
Do While Not rsConn.Eof
' EXTRACT DOMAIN
strReferrer = rsConn(0)
strUrl = ExtractReferrerUrl(strReferrer)
If strUrl <> "" Then
strSql = "UPDATE " & strInstance & "PageLog " &_
"SET pl_referrerurl=" & FormatDatabaseString(strUrl, 255) & " " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrer=" & FormatDatabaseString(strReferrer, 255)
objConn.Execute(strSql)
End If
rsConn.Movenext
Loop
rsConn.Close
Set rsConn = Nothing
End Sub
Public Function ExtractReferrerDomain(strReferrer)
Dim strDomain, intLocation, aryDomainExtension, intLoop
Dim objDomainSearch, objDomainResults, colItem, strHost
' FIRST EXTRACT THE HOST
strHost = ExtractReferrerHost(strReferrer)
strHost = RemovePort(strHost)
If CheckIpAddress(strHost) = False Then
If strHost <> "" Then
' GET DOMAIN EXTENSION ARRAY
aryDomainExtension = GetDomainExtensionArray()
For intLoop = 0 To UBound(aryDomainExtension)
' DO SOME PATTERN MATCHING
Set objDomainSearch = New RegExp
With objDomainSearch
.Pattern = "[\w|\-]+" & aryDomainExtension(intLoop, 1) & "$"
.IgnoreCase = True
.Global = False
End With
' CHECK FOR RESULTS OF PATTERN SEARCH
Set objDomainResults = objDomainSearch.Execute(strHost)
If objDomainResults.Count > 0 Then
For Each colItem In objDomainResults
strDomain = colItem.Value
Next
Exit For
End If
Set objDomainSearch = Nothing
Set objDomainResults = Nothing
Next
End If
End If
ExtractReferrerDomain = strDomain
End Function
Public Function ExtractReferrerExtension(strReferrer)
Dim strExtension, aryDomainExtension, intLoop
Dim objDomainSearch, objDomainResults, strHost
' FIRST EXTRACT THE HOST
strHost = ExtractReferrerHost(strReferrer)
strHost = RemovePort(strHost)
If CheckIpAddress(strHost) = False Then
If strHost <> "" Then
' GET DOMAIN EXTENSION ARRAY
aryDomainExtension = GetDomainExtensionArray()
For intLoop = 0 To UBound(aryDomainExtension)
' DO SOME PATTERN MATCHING
Set objDomainSearch = New RegExp
With objDomainSearch
.Pattern = "[\w|\-]+" & aryDomainExtension(intLoop, 1) & "$"
.IgnoreCase = True
.Global = False
End With
' CHECK FOR RESULTS OF PATTERN SEARCH
Set objDomainResults = objDomainSearch.Execute(strHost)
If objDomainResults.Count > 0 Then
strExtension = Replace(aryDomainExtension(intLoop, 1), "\", "")
Exit For
End If
Set objDomainSearch = Nothing
Set objDomainResults = Nothing
Next
End If
End If
ExtractReferrerExtension = strExtension
End Function
Private Function RemovePort(strHost)
Dim strTemp
strTemp = strHost
If Instr(strTemp, ":") Then
strTemp = Mid(strTemp, 1, Instr(strTemp, ":") - 1)
End If
RemovePort = strTemp
End Function
' CHECK TO SEE IF HOST IS AN IP ADDRESS
Private Function CheckIPAddress(strHost)
Dim strTemp, blnCheck, blnTest, objSearch
strTemp = strHost
Set objSearch = New RegExp
With objSearch
.Pattern = "[a-z]"
.IgnoreCase = True
.Global = False
End With
' CHECK FOR RESULTS OF PATTERN SEARCH
blnTest = objSearch.Test(strTemp)
If blnTest = True Then
blnCheck = False
Else
blnCheck = True
End If
Set objSearch = Nothing
CheckIPAddress = blnCheck
End Function
Public Function ExtractReferrerHost(strReferrer)
Dim strHost, intLocation
strHost = strReferrer
strHost = Replace(strHost, "http://", "")
strHost = Replace(strHost, "https://", "")
intLocation = Instr(strHost, "/")
If intLocation = 0 Then
intLocation = Instr(strHost, "?")
End If
If intLocation > 0 Then
strHost = Mid(strHost, 1, intLocation - 1)
End If
ExtractReferrerHost = strHost
End Function
Public Function ExtractReferrerUrl(strReferrer)
Dim strUrl, intLocation, strCharacters, strChar, intLoop
strUrl = strReferrer
strCharacters = "?*;\$="
For intLoop = 1 To Len(strCharacters)
strChar = Mid(strCharacters, intLoop, 1)
intLocation = Instr(strUrl, strChar)
If intLocation > 0 Then
strUrl = Mid(strUrl, 1, intLocation - 1)
End If
Next
' REMOVE TRAILING BACKSLASH
If Len(strUrl) > 0 Then
If Mid(strUrl, Len(strUrl)) = "/" Then
strUrl = Mid(strUrl, 1, Len(strUrl)-1)
End If
End If
If Left(LCase(strUrl), 4) <> "http" Then
strUrl = ""
End If
ExtractReferrerUrl = strUrl
End Function
Private Sub GenerateKeywordData(datReportStart, datReportEnd)
Dim rsConn, strSql
Dim strReferrer, strKeywords
strSql = "SELECT DISTINCT pl_referrer FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrer LIKE '%?%' " &_
"AND (pl_keywords = '' OR pl_keywords IS NULL)"
Set rsConn = objConn.Execute(strSql)
Do While Not rsConn.Eof
strReferrer = rsConn(0)
strKeywords = ""
strKeywords = ExtractKeywords(strReferrer)
' UPDATE RECORD
strReferrer = Replace(rsConn(0), "'", "''")
strSql = "UPDATE " & strInstance & "PageLog " &_
"SET pl_keywords=" & FormatDatabaseString(strKeywords, 100) & " " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_referrer=" & FormatDatabaseString(strReferrer, 255)
objConn.Execute(strSql)
rsConn.Movenext
Loop
End Sub
Private Function ExtractKeywords(strReferrer)
Dim strKeywords, objKeywordSearch, objKeywordResults
Dim objReferrerSearch, objEncodedSearch, objEncodedResults
Dim aryReferrer, intLoop, colItem, strKeywordPattern
Dim strKeywordsClean, blnKeywordsClean, strKeywordsTemp, strReferrerSite
' REFERRER ARRAY -- LIST OF KNOWN REFERRERS
aryReferrer = GetReferrerArray()
' ITERATE ARRAY FOR FIRST PATTERN MATCH OF REFERRER
For intLoop = 0 To UBound(aryReferrer)
Set objReferrerSearch = New RegExp
With objReferrerSearch
.Pattern = "^.*" & aryReferrer(intLoop, 1) & ".*$"
.IgnoreCase = True
.Global = False
End With
If objReferrerSearch.Test(strReferrer)=True Then
' DECODE URL ENCODED CHARACTERS
strReferrer = DecodeUrl(strReferrer)
strReferrerSite = aryReferrer(intLoop, 0)
strKeywordPattern = "[\?|&]" & aryReferrer(intLoop, 2) & "=.+"
Set objKeywordSearch = New RegExp
With objKeywordSearch
.Pattern = strKeywordPattern
.IgnoreCase = True
.Global = False
End With
' CHECK FOR KEYWORDS
Set objKeywordResults = objKeywordSearch.Execute(strReferrer)
' IF KEYWORDS ARE FOUND, GRAB THEM
If objKeywordResults.Count > 0 Then
For Each colItem In objKeywordResults
strKeywords = colItem.Value
Next
End If
Set objKeywordSearch = Nothing
Set objKeywordResults = Nothing
If strKeywords <> "" Then
Set objKeywordSearch = New RegExp
With objKeywordSearch
.Pattern = "([\?|%3f|&|%26]" & aryReferrer(intLoop, 2) & "[=|%3d])"
.IgnoreCase = True
.Global = False
End With
Set objKeywordResults = objKeywordSearch.Execute(strKeywords)
If objKeywordResults.Count > 0 Then
For Each colItem In objKeywordResults
strKeywords = Mid(strKeywords, Len(colItem.Value) + 1)
Next
End If
Set objKeywordSearch = Nothing
Set objKeywordResults = Nothing
If Instr(strKeywords, "&") > 1 Then
strKeywords = Mid(strKeywords, 1, Instr(strKeywords, "&") - 1)
ElseIf Instr(strKeywords, "&") = 1 Then
strKeywords = ""
End If
' CLEAN UP KEYWORDS
blnKeywordsClean = False
strKeywordsClean = ""
strKeywordsTemp = strKeywords
' COUNTER IS TO ESCAPE SO THAT NO MORE THAN 20 KEYWORD LOOPS
Dim intCounter
intCounter = 0
Do Until blnKeywordsClean = True
blnKeywordsClean = True
intCounter = intCounter +1
Set objKeywordSearch = New RegExp
With objKeywordSearch
.Pattern = "[\w|\.|\-|']+"
.IgnoreCase = True
.Global = False
End With
Set objKeywordResults = objKeywordSearch.Execute(strKeywordsTemp)
If objKeywordResults.Count > 0 Then
For Each colItem In objKeywordResults
strKeywordsClean = strKeywordsClean & colItem.Value & " "
If Len(strKeywordsTemp)-colItem.FirstIndex > 1 Then
strKeywordsTemp = Mid(strKeywordsTemp, ColItem.FirstIndex + Len(ColItem.Value) + 1)
blnKeywordsClean = False
End If
Next
End If
Set objKeywordSearch = Nothing
Set objKeywordResults = Nothing
If intCounter = 20 Then blnKeywordsClean = True
Loop
strKeywords = LCase(Trim(strKeywordsClean))
End If
Exit For
End If
Set objReferrerSearch = Nothing
Next
ExtractKeywords = strKeywords
End Function
' FUNCTION TO DECODE URL ENCODED CHARACTERS
Private Function DecodeUrl(strDecode)
Dim strTemp, objEncodedSearch, objEncodedResults, colItem
strTemp = strDecode
Set objEncodedSearch = New RegExp
With objEncodedSearch
.Pattern = "(%..)"
.IgnoreCase = True
.Global = True
End With
Set objEncodedResults = objEncodedSearch.Execute(strTemp)
If objEncodedResults.Count > 0 Then
For Each colItem In objEncodedResults
If DecodeString(Ucase(colItem.Value)) <> "" Then
strTemp = Replace(strTemp, colItem.Value, DecodeString(Ucase(colItem.Value)))
End If
Next
End If
Set objEncodedSearch = Nothing
Set objEncodedResults = Nothing
DecodeUrl = strTemp
End Function
Private Sub GenerateOSData(datReportStart, datReportEnd)
Dim rsConn, strSql, strUserAgent, strOSActual, intLoop, aryOS, objOSSearch
aryOS = GetOSArray()
strSql = "SELECT DISTINCT pl_useragent FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND (pl_useragent IS NOT NULL OR pl_useragent <> '') " &_
"AND (pl_os IS NULL OR pl_os='') " &_
"AND pl_browsertype <> 'Robot' "
Set rsConn = objConn.Execute(strSql)
Do While Not rsConn.Eof
strUserAgent = rsConn(0)
strOSActual = MatchUserAgent(aryOS, strUserAgent)
If strOSActual <> "" Then
strSql = "UPDATE " & strInstance & "PageLog " &_
"SET pl_os=" & FormatDatabaseString(strOSActual, 20) & " " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_useragent = " & FormatDatabaseString(strUserAgent, 255)
objConn.Execute(strSql)
End If
rsConn.Movenext
Loop
rsConn.Close
Set rsConn = Nothing
End Sub
Public Sub GenerateBrowserData(datReportStart, datReportEnd)
Dim rsConn, strSql, strUserAgent, strBrowser, intLoop, aryBrowser, objBrowserSearch
aryBrowser = GetBrowserArray()
strSql = "SELECT DISTINCT pl_useragent FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND (pl_useragent IS NOT NULL OR pl_useragent <> '') " &_
"AND (pl_browser IS NULL OR pl_browser='') " &_
"AND (pl_browsertype IS NULL OR pl_browsertype = '')"
Set rsConn = objConn.Execute(strSql)
Do While Not rsConn.Eof
strUserAgent = rsConn(0)
strBrowser = MatchUserAgent(aryBrowser, strUserAgent)
strUserAgent = Replace(strUserAgent, "'", "''")
If strBrowser <> "" Then
strSql = "UPDATE " & strInstance & "PageLog " &_
"SET pl_browser=" & FormatDatabaseString(strBrowser, 50) & ", " &_
"pl_browsertype='Browser' " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_useragent=" & FormatDatabaseString(strUserAgent, 255)
objConn.Execute(strSql)
End If
rsConn.Movenext
Loop
rsConn.Close
Set rsConn = Nothing
End Sub
Private Sub GenerateRobotData(datReportStart, datReportEnd)
Dim rsConn, strSql, strUserAgent, strRobot, intLoop, aryRobot, objRobotSearch
aryRobot = GetRobotArray()
strSql = "SELECT DISTINCT pl_useragent FROM " & strInstance & "PageLog " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND (pl_useragent IS NOT NULL OR pl_useragent <> '') " &_
"AND (pl_browser IS NULL OR pl_browser='') " &_
"AND (pl_browsertype IS NULL or pl_browsertype='')"
Set rsConn = objConn.Execute(strSql)
Do While Not rsConn.Eof
strUserAgent = rsConn(0)
strRobot = MatchUserAgent(aryRobot, strUserAgent)
strUserAgent = Replace(strUserAgent, "'", "''")
If strRobot <> "" Then
strSql = "UPDATE " & strInstance & "PageLog " &_
"SET pl_browser=" & FormatDatabaseString(strRobot, 50) & ", " &_
"pl_browsertype='Robot' " &_
"WHERE pl_datetime BETWEEN " & FormatDatabaseDate(datReportStart & " 00:00:00") &_
" AND " & FormatDatabaseDate(datReportEnd & " 23:59:59") & " " &_
"AND pl_useragent=" & FormatDatabaseString(strUserAgent, 255)
objConn.Execute(strSql)
End If
rsConn.Movenext
Loop
rsConn.Close
Set rsConn = Nothing
End Sub
Private Function MatchUserAgent(aryCompareArray, strUserAgent)
Dim strMatch, intLoop, objSearch
For intLoop = 0 to UBound(aryCompareArray)
Set objSearch = New RegExp
With objSearch
.Pattern = aryCompareArray(intLoop, 1)
.IgnoreCase = True
.Global = False
End With
If objSearch.Test(strUserAgent)=True Then
strMatch = aryCompareArray(intLoop, 0)
Exit For
End If
Set objSearch = Nothing
Next
MatchUserAgent = strMatch
End Function
' ***************
' * DATA ARRAYS *
' ***************
Private Function GetOSArray()
Dim aryTemp(41,1)
aryTemp(0,1)=".*(Windows NT 5.[1-9]|Windows XP).*"
aryTemp(0,0)="WinXP"
aryTemp(1,1)=".*(Win2000|Windows 2000|Windows NT 5.0).*"
aryTemp(1,0)="Win2000"
aryTemp(2,1)=".*(68k|68000).*"
aryTemp(2,0)="Mac68k"
aryTemp(3,1)=".*(9x 4.90|Win9(5|8)|Windows 9(5|8)|95/NT|Win32|32bit).*"
aryTemp(3,0)="Win9x"
aryTemp(4,1)=".*(Mac|apple|MacOS8).*"
aryTemp(4,0)="Mac"
aryTemp(5,1)=".*(WinNT|Windows NT).*"
aryTemp(5,0)="WinNT"
aryTemp(6,1)=".*16bit.*"
aryTemp(6,0)="Win16"
aryTemp(7,1)=".*(PowerPC|PPC).*"
aryTemp(7,0)="MacPPC"
aryTemp(8,1)=".*(Windows 3.*1|Win3.*1|Win16|Windows 16-bit).*"
aryTemp(8,0)="Win31"
aryTemp(9,1)=".*WebTV.*"
aryTemp(9,0)="WebTV"
aryTemp(10,1)=".*Windows CE.*"
aryTemp(10,0)="WinCE"
aryTemp(11,1)=".*Linux.*"
aryTemp(11,0)="Linux"
aryTemp(12,1)=".*(Amiga|Ibrowse).*"
aryTemp(12,0)="Amiga"
aryTemp(13,1)=".*(dec|osf1|dec_alpha|alphaserver|ultrix|alphastation).*"
aryTemp(13,0)="DEC"
aryTemp(14,1)=".*(OS/2|ibm-webexplorer).*"
aryTemp(14,0)="OS/2"
aryTemp(15,1)=".*(VAX|OpenVMS).*"
aryTemp(15,0)="VMS"
aryTemp(16,1)=".*AIX.*"
aryTemp(16,0)="AIX"
aryTemp(17,1)=".*ANT Fresco.*"
aryTemp(17,0)="RISC"
aryTemp(18,1)=".*AOLTV.*"
aryTemp(18,0)="AOLTV"
aryTemp(19,1)=".*BSD.*"
aryTemp(19,0)="BSD"
aryTemp(20,1)=".*CJPENNYCATE.*"
aryTemp(20,0)="Web2U"
aryTemp(21,1)=".*Compaq.*"
aryTemp(21,0)="Compaq"
aryTemp(22,1)=".*CP/M.*"
aryTemp(22,0)="CP/M"
aryTemp(23,1)=".*Dreamcast.*"
aryTemp(23,0)="Dreamcast"
aryTemp(24,1)=".*Elaine/.*"
aryTemp(24,0)="Palm"
aryTemp(25,1)=".*EPOC.*"
aryTemp(25,0)="Epoc"
aryTemp(26,1)=".*FreeBSD.*"
aryTemp(26,0)="FreeBSD"
aryTemp(27,1)=".*Geos.*"
aryTemp(27,0)="Geos"
aryTemp(28,1)=".*hp-ux(09\.|10\.)*.*"
aryTemp(28,0)="HPUX"
aryTemp(29,1)=".*IRIX.*"
aryTemp(29,0)="IRIX"
aryTemp(30,1)=".*ncr.*"
aryTemp(30,0)="MPRAS"
aryTemp(31,1)=".*Nokia.*"
aryTemp(31,0)="Nokia"
aryTemp(32,1)=".*reliantunix.*"
aryTemp(32,0)="Reliant"
aryTemp(33,1)=".*SGI.*"
aryTemp(33,0)="SGI"
aryTemp(34,1)=".*sinix.*"
aryTemp(34,0)="SINIX"
aryTemp(35,1)=".*Solaris.*"
aryTemp(35,0)="Solaris"
aryTemp(36,1)=".*SunI86.*"
aryTemp(36,0)="Suni86"
aryTemp(37,1)=".*SunOS 4.*"
aryTemp(37,0)="SunOS4"
aryTemp(38,1)=".*SunOS 5.*"
aryTemp(38,0)="SunOS5"
aryTemp(39,1)=".*SunOS.*"
aryTemp(39,0)="SunOS"
aryTemp(40,1)=".*unix_system_v.*"
aryTemp(40,0)="Unixware"
aryTemp(41,1)=".*X11.*"
aryTemp(41,0)="UNIX"
GetOSArray = aryTemp
End Function
Private Function GetBrowserArray()
Dim aryTemp(14,1)
aryTemp(0,0)="Opera 5"
aryTemp(0,1)="^.*Opera 5.[0-9]+.*$"
aryTemp(1,0)="Opera 6"
aryTemp(1,1)="^.*Opera 6.[0-9]+.*$"
aryTemp(2,0)="Opera 7"
aryTemp(2,1)="^.*Opera 7.[0-9]+.*$"
aryTemp(3,0)="Internet Explorer 3"
aryTemp(3,1)="^Mozilla/.*\(.*MSIE [1-3].*\)$"
aryTemp(4,0)="Internet Explorer 6"
aryTemp(4,1)="^Mozilla/4.0 \(.*MSIE 6\.0.*\).*$"
aryTemp(5,0)="Internet Explorer 4"
aryTemp(5,1)="^Mozilla/4.0 \(.*MSIE 4\..*\)$"
aryTemp(6,0)="Internet Explorer 5"
aryTemp(6,1)="^Mozilla/4.0 \(.*MSIE 5\.\d{1,2}.*\).*$"
aryTemp(7,0)="Netscape 6"
aryTemp(7,1)="^Mozilla/5\.\d \(.*\) Gecko/\d{8} Netscape/6(\.\d{1,2}){1,2}$"
aryTemp(8,0)="Netscape 7"
aryTemp(8,1)="^Mozilla/5\.\d \(.*\) Gecko/\d{8} Netscape/7(\.\d{1,2}){1,2}$"
aryTemp(9,0)="Netscape 4"
aryTemp(9,1)="^Mozilla/4\.0[6-9]\s*\[.*\] \(.*\)$"
aryTemp(10,0)="Netscape 4.7"
aryTemp(10,1)="^Mozilla/4\.[6-7][2|5-9]\s*\[.*\] \(.*\)$"
aryTemp(11,0)="Mozilla 1"
aryTemp(11,1)="^Mozilla/[4-5]\.\d \(.*(rv:\d\.\d\.\d).*\) Gecko/\d{8}.*$"
aryTemp(12,0)="Mozilla 1"
aryTemp(12,1)="^Mozilla/[4-5]\.\d \(.*(rv:\d\.\drc\d).*\) .*$"
aryTemp(13,0)="Mozilla 1"
aryTemp(13,1)="^Mozilla/[4-5]\.\d \(.*(rv:\d\.\d[a-z]).*\) .*$"
aryTemp(14,0)="Mozilla 1"
aryTemp(14,1)="^Mozilla/[4-5]\.\d \(.*(rv:\d\.\d).*\) .*$"
GetBrowserArray = aryTemp
End Function
Private Function GetRobotArray()
Dim aryTemp(35,2)
aryTemp(0,0)="Googlebot"
aryTemp(0,1)="^Googlebot/2\.\d \((\+)*http://www.googlebot.com/bot.html\)$"
aryTemp(0,2)="http://www.google.com/bot.html"
aryTemp(1,0)="Fast Webcrawler"
aryTemp(1,1)="^(FAST(-)*WebCrawler/\d\.\d.* \(.*\)|AvantGo \d\.\d \(Fast PDA Crawler\)|Mozilla/4\.0 \(.*FastCrawler/\d\.\d.*\))$"
aryTemp(1,2)="http://www.fastsearch.com/support/crawler.asp"
aryTemp(2,0)="Alexa"
aryTemp(2,1)="^ia_archiver$"
aryTemp(2,2)="http://pages.alexa.com/help/webmasters/"
aryTemp(3,0)="InternetSeer"
aryTemp(3,1)="^sitecheck\.internetseer\.com \(For more info see: http://sitecheck\.internetseer\.com\)$"
aryTemp(3,2)="http://sitecheck.internetseer.com/"
aryTemp(4,0)="Zealbot"
aryTemp(4,1)="^Mozilla/4\.0\(compatible; Zealbot \d\.\d\)$"
aryTemp(4,2)="http://www.zeal.com/"
aryTemp(5,0)="Ask Jeeves"
aryTemp(5,1)="^Mozilla/2\.0 \(compatible; Ask Jeeves\)$"
aryTemp(5,2)="http://www.askjeeves.com/"
aryTemp(6,0)="Slurp (Inktomi)"
aryTemp(6,1)="^Mozilla/\d\.0 \(Slurp/[a-z]+; slurp@inktomi\.com; http://www\.inktomi\.com/slurp\.html\)$"
aryTemp(6,2)="http://www.inktomi.com/slurp.html"
aryTemp(7,0)="Mercator (Altavista)"
aryTemp(7,1)="^Mercator-.+$"
aryTemp(7,2)="http://www.altavista.com/"
aryTemp(8,0)="Lycos Spider"
aryTemp(8,1)="^Lycos_Spider_\(.*\)$"
aryTemp(8,2)="http://www.lycos.com/"
aryTemp(9,0)="LinksManager.com"
aryTemp(9,1)="^LinksManager\.com \(http://linksmanager\.com/linkchecker\.html\)$"
aryTemp(9,2)="http://linksmanager.com/linkchecker.html"
aryTemp(10,0)="Baidu Spider"
aryTemp(10,1)="^BaiDuSpider$"
aryTemp(10,2)="http://www.baidu.com/"
aryTemp(11,0)="LinkChecker"
aryTemp(11,1)="^LinkWalker$"
aryTemp(11,2)="http://www.seventwentyfour.com/"
aryTemp(12,0)="Unknown Robot (cURL)"
aryTemp(12,1)="^curl/.*$"
aryTemp(12,2)="http://curl.sourceforge.net/"
aryTemp(13,0)="WebTrends"
aryTemp(13,1)="^WebTrends/.*$"
aryTemp(13,2)="http://www.webtrends.com/"
aryTemp(14,0)="Beijing Express Email Address Extractor"
aryTemp(14,1)="^Mozilla/4\.0 \(compatible; MSIE 5\.0; Windows NT; DigExt; DTS Agent$"
aryTemp(14,2)="http://www.zstools.com/"
aryTemp(15,0)="Unknown Robot (Delphi/C++ Builder)"
aryTemp(15,1)="^Mozilla/3\.0 \(compatible; Indy Library\)$"
aryTemp(15,2)=""
aryTemp(16,0)="Unknown Robot (Microsoft URL Control)"
aryTemp(16,1)="^Microsoft URL Control.*$"
aryTemp(16,2)=""
aryTemp(17,0)="Scooter (AltaVista)"
aryTemp(17,1)="^Scooter/.*$"
aryTemp(17,2)="http://www.altavista.com/"
aryTemp(18,0)="Unknown Robot (Perl)"
aryTemp(18,1)="^libwww-perl/.*$"
aryTemp(18,2)="http://www.perl.org/"
aryTemp(19,0)="TurnitinBot"
aryTemp(19,1)="^TurnitinBot/.*$"
aryTemp(19,2)="http://www.turnitin.com/robot/crawlerinfo.html"
aryTemp(20,0)="WiseNutBot"
aryTemp(20,1)="^Mozilla/4\.0 compatible ZyBorg/1\.0 \(wn.zyborg@looksmart\.net; http://www\.WISEnutbot\.com\)$"
aryTemp(20,2)="http://www.wisenutbot.com/"
aryTemp(21,0)="GigaBot"
aryTemp(21,1)="^Gigabot/1\.0$"
aryTemp(21,2)="http://www.gigablast.com/"
aryTemp(22,0)="SynoBot"
aryTemp(22,1)="^SynoBot$"
aryTemp(22,2)=""
aryTemp(23,0)="Unknown Robot (Python)"
aryTemp(23,1)="^Python-urllib/.*$"
aryTemp(23,2)="http://www.python.org/"
aryTemp(24,0)="LNSpiderguy"
aryTemp(24,1)="^LNSpiderguy$"
aryTemp(24,2)="http://www.lexis-nexis.com/"
aryTemp(25,0)="OpenBot"
aryTemp(25,1)="^Openfind data gatherer, Openbot/3\.0\+\(.*\)$"
aryTemp(25,2)="http://www.openfind.com.tw/robot.html"
aryTemp(26,0)="IBM Research Division"
aryTemp(26,1)="^http://www\.almaden\.ibm\.com/cs/crawler.*$"
aryTemp(26,2)="http://www.almaden.ibm.com/cs/crawler"
aryTemp(27,0)="Download Accelerator"
aryTemp(27,1)="^DA \d\.\d$"
aryTemp(27,2)="http://www.downloadaccelerator.com/"
aryTemp(28,0)="LinksManager.com"
aryTemp(28,1)="^LinksManager.com \(http://linksmanager.com/linkchecker.html\)$"
aryTemp(28,2)="http://linksmanager.com/linkchecker.html"
aryTemp(29,0)="Whats Up (Ipswitch)"
aryTemp(29,1)="^WhatsUp.+/\d\.\d+$"
aryTemp(29,2)="http://www.ipswitch.com/Products/WhatsUp/index.html"
aryTemp(30,0)="VisualPulse"
aryTemp(30,1)="^VisualPulse$"
aryTemp(30,2)="http://www.visualware.com/visualpulse/"
aryTemp(31,0)="Grub"
aryTemp(31,1)="^Mozilla/4\.0 \(compatible; grub-client-\d\.\d\.\d; Crawl your own stuff with http://grub\.org\)$"
aryTemp(31,2)="http://grub.org/"
aryTemp(32,0)="NameProtect Web Crawler"
aryTemp(32,1)="^NPBot.*$"
aryTemp(32,2)="http://www.nameprotect.com/botinfo.html"
aryTemp(33,0)="MSNBot"
aryTemp(33,1)="^MSNBOT/\d\.\d+.*$"
aryTemp(33,2)="http://search.msn.com/msnbot.htm"
aryTemp(34,0)="Teleport Webspider"
aryTemp(34,1)="^Teleport.*/\d\.\d+.*$"
aryTemp(34,2)="http://www.tenmax.com/"
aryTemp(35,0)="Ask Jeeves/Teoma Bot"
aryTemp(35,1)="^Mozilla/2\.0 \(compatible; Ask Jeeves/Teoma\)$"
aryTemp(35,2)="http://www.ask.com/"
GetRobotArray = aryTemp
End Function
Private Function GetReferrerArray()
Dim aryTemp(19,2)
aryTemp(0,0)="Google"
aryTemp(0,1)="www\.google\."
aryTemp(0,2)="q"
aryTemp(1,0)="Yahoo"
aryTemp(1,1)="yahoo\.com/"
aryTemp(1,2)="p"
aryTemp(2,0)="Zeal"
aryTemp(2,1)="zeal\.com/"
aryTemp(2,2)="keyword"
aryTemp(3,0)="Teoma"
aryTemp(3,1)="teoma\.com/"
aryTemp(3,2)="t"
aryTemp(4,0)="Looksmart"
aryTemp(4,1)="looksmart\.com/"
aryTemp(4,2)="t"
aryTemp(5,0)="Lycos"
aryTemp(5,1)="lycos\."
aryTemp(5,2)="query"
aryTemp(6,0)="Ask Jeeves"
aryTemp(6,1)="(ask|askjeeves)\.com/"
aryTemp(6,2)="(qry|ask)"
aryTemp(7,0)="MSN"
aryTemp(7,1)="\.msn.com/"
aryTemp(7,2)="q"
aryTemp(8,0)="DMOZ"
aryTemp(8,1)="dmoz\.org/"
aryTemp(8,2)="search"
aryTemp(9,0)="AOL"
aryTemp(9,1)="\.aol\."
aryTemp(9,2)="query"
aryTemp(10,0)="Excite"
aryTemp(10,1)="excite\.com/"
aryTemp(10,2)="qkw"
aryTemp(11,0)="Metacrawler"
aryTemp(11,1)="metacrawler\.com/"
aryTemp(11,2)="q"
aryTemp(12,0)="Hotbot"
aryTemp(12,1)="hotbot\.com/"
aryTemp(12,2)="general"
aryTemp(13,0)="Altavista"
aryTemp(13,1)="altavista\.com/"
aryTemp(13,2)="q"
aryTemp(14,0)="Alltheweb"
aryTemp(14,1)="alltheweb\.com/"
aryTemp(14,2)="q"
aryTemp(15,0)="Netscape"
aryTemp(15,1)="netscape\.com/"
aryTemp(15,2)="query"
aryTemp(16,0)="iWon"
aryTemp(16,1)="iwon\.com/"
aryTemp(16,2)="searchfor"
aryTemp(17,0)="Overture"
aryTemp(17,1)="overture\.com/"
aryTemp(17,2)="keywords"
aryTemp(18,0)="Search.com"
aryTemp(18,1)="www\.search\.com/"
aryTemp(18,2)="q"
aryTemp(19,0)="Earthlink"
aryTemp(19,1)="search\.earthlink\.com/"
aryTemp(19,2)="q"
GetReferrerArray=aryTemp
End Function
Private Function GetDomainExtensionArray()
Dim aryTemp(406,1)
' GENERIC TOP LEVEL DOMAINS
aryTemp(0,0) = "US Commercial"
aryTemp(0,1) = "\.com"
aryTemp(1,0) = "US Network"
aryTemp(1,1) = "\.net"
aryTemp(2,0) = "US Organization"
aryTemp(2,1) = "\.org"
' SPECIAL TOP LEVEL DOMAINS
aryTemp(3,0) = "US Educational"
aryTemp(3,1) = "\.edu"
aryTemp(4,0) = "US Government"
aryTemp(4,1) = "\.gov"
aryTemp(5,0) = "US Military"
aryTemp(5,1) = "\.mil"
aryTemp(6,0) = "International Organizations"
aryTemp(6,1) = "\.int"
' NEW GENERIC TOP LEVEL DOMAINS
aryTemp(7,0) = "Air Transport Industry"
aryTemp(7,1) = "\.aero"
aryTemp(8,0) = "Businesses"
aryTemp(8,1) = "\.biz"
aryTemp(9,0) = "Cooperatives"
aryTemp(9,1) = "\.coop"
aryTemp(10,0) = "Information"
aryTemp(10,1) = "\.info"
aryTemp(11,0) = "Museums"
aryTemp(11,1) = "\.museum"
aryTemp(12,0) = "Individual Name"
aryTemp(12,1) = "\.name"
aryTemp(13,0) = "Professionals"
aryTemp(13,1) = "\.pro"
' COUNTRY SPECIFIC TOP LEVEL DOMAINS
aryTemp(14,0) = "Ascension Island - Academic"
aryTemp(14,1) = "\.ac\.ac"
aryTemp(15,0) = "Ascension Island - Commercial"
aryTemp(15,1) = "\.co\.ac"
aryTemp(16,0) = "Ascension Island - Government"
aryTemp(16,1) = "\.gv\.ac"
aryTemp(17,0) = "Ascension Island - Organization"
aryTemp(17,1) = "\.or\.ac"
aryTemp(18,0) = "Ascension Island"
aryTemp(18,1) = "\.ac"
aryTemp(19,0) = "Andorra"
aryTemp(19,1) = "\.ad"
aryTemp(20,0) = "United Arab Emirates"
aryTemp(20,1) = "\.ae"
aryTemp(21,0) = "Afghanistan"
aryTemp(21,1) = "\.af"
aryTemp(22,0) = "Antigua and Barbuda"
aryTemp(22,1) = "\.ag"
aryTemp(23,0) = "Anguilla"
aryTemp(23,1) = "\.ai"
aryTemp(24,0) = "Albania"
aryTemp(24,1) = "\.al"
aryTemp(25,0) = "Urmenia"
aryTemp(25,1) = "\.am"
aryTemp(26,0) = "Netherlands Antilles"
aryTemp(26,1) = "\.an"
aryTemp(27,0) = "Angola"
aryTemp(27,1) = "\.ao"
aryTemp(28,0) = "Antarctica"
aryTemp(28,1) = "\.aq"
aryTemp(29,0) = "Argentina - Commercial"
aryTemp(29,1) = "\.com\.ar"
aryTemp(30,0) = "Argentina - Network (ISP)"
aryTemp(30,1) = "\.net\.ar"
aryTemp(31,0) = "Argentina - Organization"
aryTemp(31,1) = "\.org\.ar"
aryTemp(32,0) = "Argentina - Educational"
aryTemp(32,1) = "\.edu\.ar"
aryTemp(33,0) = "Argentina - International"
aryTemp(33,1) = "\.int\.ar"
aryTemp(34,0) = "Argentina - Government"
aryTemp(34,1) = "\.gov\.ar"
aryTemp(35,0) = "Argentina - Military"
aryTemp(35,1) = "\.mil\.ar"
aryTemp(36,0) = "Argentina"
aryTemp(36,1) = "\.ar"
aryTemp(37,0) = "American Somoa"
aryTemp(37,1) = "\.as"
aryTemp(38,0) = "Austria - Academic"
aryTemp(38,1) = "\.ac\.at"
aryTemp(39,0) = "Austria - Commercial"
aryTemp(39,1) = "\.co\.at"
aryTemp(40,0) = "Austria - Government"
aryTemp(40,1) = "\.gv\.at"
aryTemp(41,0) = "Austria - Organization"
aryTemp(41,1) = "\.or\.at"
aryTemp(42,0) = "Austria"
aryTemp(42,1) = "\.at"
aryTemp(43,0) = "Australia - Association"
aryTemp(43,1) = "\.asn\.au"
aryTemp(44,0) = "Australia - Commercial"
aryTemp(44,1) = "\.com\.au"
aryTemp(45,0) = "Australia - Educational"
aryTemp(45,1) = "\.edu\.au"
aryTemp(46,0) = "Australia - Organization"
aryTemp(46,1) = "\.org\.au"
aryTemp(47,0) = "Australia - ISP"
aryTemp(47,1) = "\.net\.au"
aryTemp(48,0) = "Australia"
aryTemp(48,1) = "\.au"
aryTemp(49,0) = "Aruba"
aryTemp(49,1) = "\.aw"
aryTemp(50,0) = "Azerbaijan"
aryTemp(50,1) = "\.az"
aryTemp(51,0) = "Bosnia and Herzegovina"
aryTemp(51,1) = "\.ba"
aryTemp(52,0) = "Barbados"
aryTemp(52,1) = "\.bb"
aryTemp(53,0) = "Bangladesh"
aryTemp(53,1) = "\.bd"
aryTemp(54,0) = "Belgium - Acedemic"
aryTemp(54,1) = "\.ac\.be"
aryTemp(55,0) = "Belgium"
aryTemp(55,1) = "\.be"
aryTemp(56,0) = "Burkina Faso"
aryTemp(56,1) = "\.bf"
aryTemp(57,0) = "Bulgaria"
aryTemp(57,1) = "\.bg"
aryTemp(58,0) = "Bahrain"
aryTemp(58,1) = "\.bh"
aryTemp(59,0) = "Burundi"
aryTemp(59,1) = "\.bi"
aryTemp(60,0) = "Benin"
aryTemp(60,1) = "\.bj"
aryTemp(61,0) = "Bermuda"
aryTemp(61,1) = "\.bm"
aryTemp(62,0) = "Brunei Darussalam"
aryTemp(62,1) = "\.bn"
aryTemp(63,0) = "Bolivia"
aryTemp(63,1) = "\.bo"
aryTemp(64,0) = "Brazil - Commercial"
aryTemp(64,1) = "\.com\.br"
aryTemp(65,0) = "Brazil - Government"
aryTemp(65,1) = "\.gov\.br"
aryTemp(66,0) = "Brazil - Military"
aryTemp(66,1) = "\.mil\.br"
aryTemp(67,0) = "Brazil - Network (ISP)"
aryTemp(67,1) = "\.net\.br"
aryTemp(68,0) = "Brazil - Organization"
aryTemp(68,1) = "\.org\.br"
aryTemp(69,0) = "Brazil"
aryTemp(69,1) = "\.br"
aryTemp(70,0) = "Bahamas"
aryTemp(70,1) = "\.bs"
aryTemp(71,0) = "Bhutan"
aryTemp(71,1) = "\.bt"
aryTemp(72,0) = "Bouvet Island"
aryTemp(72,1) = "\.bv"
aryTemp(73,0) = "Botswana"
aryTemp(73,1) = "\.bw"
aryTemp(74,0) = "Belarus"
aryTemp(74,1) = "\.by"
aryTemp(75,0) = "Belize"
aryTemp(75,1) = "\.bz"
aryTemp(76,0) = "Canada - Alberta"
aryTemp(76,1) = "\.ab\.ca"
aryTemp(77,0) = "Canada - British Columbia"
aryTemp(77,1) = "\.bc\.ca"
aryTemp(78,0) = "Canada - Manitoba"
aryTemp(78,1) = "\.mb\.ca"
aryTemp(79,0) = "Canada - New Brunswick"
aryTemp(79,1) = "\.nb\.ca"
aryTemp(80,0) = "Canada - Newfoundland"
aryTemp(80,1) = "\.nf\.ca"
aryTemp(81,0) = "Canada - Nova Scotia"
aryTemp(81,1) = "\.ns\.ca"
aryTemp(82,0) = "Canada - Northwest Territories"
aryTemp(82,1) = "\.nt\.ca"
aryTemp(83,0) = "Canada - Nunavut"
aryTemp(83,1) = "\.nu\.ca"
aryTemp(84,0) = "Canada - Ontario"
aryTemp(84,1) = "\.on\.ca"
aryTemp(85,0) = "Canada - Prince Edward Island"
aryTemp(85,1) = "\.pe\.ca"
aryTemp(86,0) = "Canada - Quebec"
aryTemp(86,1) = "\.qc\.ca"
aryTemp(87,0) = "Canada - Saskatchewan"
aryTemp(87,1) = "\.sk\.ca"
aryTemp(88,0) = "Canada - Yukon Territories"
aryTemp(88,1) = "\.yk\.ca"
aryTemp(89,0) = "Cocos Islands"
aryTemp(89,1) = "\.cc"
aryTemp(90,0) = "Congo90, Democratic Republic"
aryTemp(90,1) = "\.cd"
aryTemp(91,0) = "Central African Republic"
aryTemp(91,1) = "\.cf"
aryTemp(92,0) = "Congo, Republic Of"
aryTemp(92,1) = "\.cg"
aryTemp(93,0) = "Switzerland"
aryTemp(93,1) = "\.ch"
aryTemp(94,0) = "Cote d'Ivoire"
aryTemp(94,1) = "\.ci"
aryTemp(95,0) = "Cook Islands"
aryTemp(95,1) = "\.ck"
aryTemp(96,0) = "Chile"
aryTemp(96,1) = "\.cl"
aryTemp(97,0) = "Camaroon"
aryTemp(97,1) = "\.cm"
aryTemp(98,0) = "China - Academic"
aryTemp(98,1) = "\.ac\.cn"
aryTemp(99,0) = "China - Commercial"
aryTemp(99,1) = "\.com\.cn"
aryTemp(100,0) = "China - Educational"
aryTemp(100,1) = "\.edu\.cn"
aryTemp(101,0) = "China - Government"
aryTemp(101,1) = "\.gov\.cn"
aryTemp(102,0) = "China - Network (ISP)"
aryTemp(102,1) = "\.net\.cn"
aryTemp(103,0) = "China - Organization"
aryTemp(103,1) = "\.org\.cn"
aryTemp(104,0) = "China"
aryTemp(104,1) = "\.cn"
aryTemp(105,0) = "Colombia"
aryTemp(105,1) = "\.co"
aryTemp(106,0) = "Costa Rica"
aryTemp(106,1) = "\.cr"
aryTemp(107,0) = "Cuba"
aryTemp(107,1) = "\.cu"
aryTemp(108,0) = "Cap Verde"
aryTemp(108,1) = "\.cv"
aryTemp(109,0) = "Christmas Islan"
aryTemp(109,1) = "\.cx"
aryTemp(110,0) = "Cyprus"
aryTemp(110,1) = "\.cy"
aryTemp(111,0) = "Czeck Republic"
aryTemp(111,1) = "\.cz"
aryTemp(112,0) = "Germany"
aryTemp(112,1) = "\.de"
aryTemp(113,0) = "Djibouti"
aryTemp(113,1) = "\.dj"
aryTemp(114,0) = "Denmark"
aryTemp(114,1) = "\.dk"
aryTemp(115,0) = "Dominica"
aryTemp(115,1) = "\.dm"
aryTemp(116,0) = "Dominican Republic"
aryTemp(116,1) = "\.do"
aryTemp(117,0) = "Algeria"
aryTemp(117,1) = "\.dz"
aryTemp(118,0) = "Ecuador - Commercial"
aryTemp(118,1) = "\.com\.ec"
aryTemp(119,0) = "Ecuador - Organization"
aryTemp(119,1) = "\.org\.ec"
aryTemp(120,0) = "Ecuador - Network (ISP)"
aryTemp(120,1) = "\.net\.ec"
aryTemp(121,0) = "Ecuador - Government"
aryTemp(121,1) = "\.gov\.ec"
aryTemp(122,0) = "Ecuador - Military"
aryTemp(122,1) = "\.mil\.ec"
aryTemp(123,0) = "Ecuador - Finance"
aryTemp(123,1) = "\.fin\.ec"
aryTemp(124,0) = "Ecuador - Medical"
aryTemp(124,1) = "\.med\.ec"
aryTemp(125,0) = "Ecuador"
aryTemp(125,1) = "\.ec"
aryTemp(126,0) = "Estonia"
aryTemp(126,1) = "\.ee"
aryTemp(127,0) = "Egypt"
aryTemp(127,1) = "\.eg"
aryTemp(128,0) = "Western Sahara"
aryTemp(128,1) = "\.eh"
aryTemp(129,0) = "Eritrea"
aryTemp(129,1) = "\.er"
aryTemp(130,0) = "Spain"
aryTemp(130,1) = "\.es"
aryTemp(131,0) = "Ethiopa"
aryTemp(131,1) = "\.et"
aryTemp(132,0) = "Finland"
aryTemp(132,1) = "\.fi"
aryTemp(133,0) = "Fiji"
aryTemp(133,1) = "\.fj"
aryTemp(134,0) = "Falkland Islands"
aryTemp(134,1) = "\.fk"
aryTemp(135,0) = "Faroa Islands"
aryTemp(135,1) = "\.fo"
aryTemp(136,0) = "France - Trademark"
aryTemp(136,1) = "\.tm\.fr"
aryTemp(137,0) = "France - Commercial"
aryTemp(137,1) = "\.com\.fr"
aryTemp(138,0) = "France - Association"
aryTemp(138,1) = "\.asso\.fr"
aryTemp(139,0) = "France - Press"
aryTemp(139,1) = "\.presse\.fr"
aryTemp(140,0) = "France"
aryTemp(140,1) = "\.fr"
aryTemp(141,0) = "Gabon"
aryTemp(141,1) = "\.ga"
aryTemp(142,0) = "Grenada"
aryTemp(142,1) = "\.gd"
aryTemp(143,0) = "Georgia"
aryTemp(143,1) = "\.ge"
aryTemp(144,0) = "French Guiana"
aryTemp(144,1) = "\.gf"
aryTemp(145,0) = "Guernsey"
aryTemp(145,1) = "\.gg"
aryTemp(146,0) = "Ghana"
aryTemp(146,1) = "\.gh"
aryTemp(147,0) = "Gibraltar"
aryTemp(147,1) = "\.gi"
aryTemp(148,0) = "Greenland"
aryTemp(148,1) = "\.gl"
aryTemp(149,0) = "Gambia"
aryTemp(149,1) = "\.gm"
aryTemp(150,0) = "Guinea"
aryTemp(150,1) = "\.gn"
aryTemp(151,0) = "Guadaloupe"
aryTemp(151,1) = "\.gp"
aryTemp(152,0) = "Equatoria Guinea"
aryTemp(152,1) = "\.gq"
aryTemp(153,0) = "Greece"
aryTemp(153,1) = "\.gr"
aryTemp(154,0) = "South Georgia"
aryTemp(154,1) = "\.gs"
aryTemp(155,0) = "Guatamala"
aryTemp(155,1) = "\.gt"
aryTemp(156,0) = "Guam"
aryTemp(156,1) = "\.gu"
aryTemp(157,0) = "Guinea-Bissau"
aryTemp(157,1) = "\.gw"
aryTemp(158,0) = "Guyana"
aryTemp(158,1) = "\.gy"
aryTemp(159,0) = "Hong Kong - Commercial"
aryTemp(159,1) = "\.com\.hk"
aryTemp(160,0) = "Hong Kong - Netwonk"
aryTemp(160,1) = "\.net\.hk"
aryTemp(161,0) = "Hong Kong - Organization"
aryTemp(161,1) = "\.org\.hk"
aryTemp(162,0) = "Hong Kong - Educational"
aryTemp(162,1) = "\.edu\.hk"
aryTemp(163,0) = "Hong Kong - Government"
aryTemp(163,1) = "\.gov\.hk"
aryTemp(164,0) = "Hong Kong"
aryTemp(164,1) = "\.hk"
aryTemp(165,0) = "Heard and McDonald Islands"
aryTemp(165,1) = "\.hm"
aryTemp(166,0) = "Honduras"
aryTemp(166,1) = "\.hn"
aryTemp(167,0) = "Croatia/Hrvatska"
aryTemp(167,1) = "\.hr"
aryTemp(168,0) = "Haiti"
aryTemp(168,1) = "\.ht"
aryTemp(169,0) = "Hungary"
aryTemp(169,1) = "\.hu"
aryTemp(170,0) = "Indonesia"
aryTemp(170,1) = "\.id"
aryTemp(171,0) = "Ireland"
aryTemp(171,1) = "\.ie"
aryTemp(172,0) = "Israel - Commercial"
aryTemp(172,1) = "\.co\.il"
aryTemp(173,0) = "Israel - Organization"
aryTemp(173,1) = "\.org\.il"
aryTemp(174,0) = "Israel - Network"
aryTemp(174,1) = "\.net\.il"
aryTemp(175,0) = "Israel - Academic"
aryTemp(175,1) = "\.ac\.il"
aryTemp(176,0) = "Israel - K12"
aryTemp(176,1) = "\.k12\.il"
aryTemp(177,0) = "Israel - Government"
aryTemp(177,1) = "\.gov\.il"
aryTemp(178,0) = "Israel - Municipality"
aryTemp(178,1) = "\.\.il"
aryTemp(179,0) = "Isle Of Man"
aryTemp(179,1) = "\.im"
aryTemp(180,0) = "India - Academic"
aryTemp(180,1) = "\.ac\.in"
aryTemp(181,0) = "India - Commercial"
aryTemp(181,1) = "\.co\.in"
aryTemp(182,0) = "India - ERNET"
aryTemp(182,1) = "\.ernet\.in"
aryTemp(183,0) = "India - Government"
aryTemp(183,1) = "\.gov\.in"
aryTemp(184,0) = "India - Network (ISP)"
aryTemp(184,1) = "\.net\.in"
aryTemp(185,0) = "India - Research"
aryTemp(185,1) = "\.res\.in"
aryTemp(186,0) = "India"
aryTemp(186,1) = "\.in"
aryTemp(187,0) = "British Indian Ocean Territory"
aryTemp(187,1) = "\.io"
aryTemp(188,0) = "Iraq"
aryTemp(188,1) = "\.iq"
aryTemp(189,0) = "Iran"
aryTemp(189,1) = "\.ir"
aryTemp(190,0) = "Iceland"
aryTemp(190,1) = "\.is"
aryTemp(191,0) = "Italy"
aryTemp(191,1) = "\.it"
aryTemp(192,0) = "Jersey"
aryTemp(192,1) = "\.je"
aryTemp(193,0) = "Jamaica"
aryTemp(193,1) = "\.jm"
aryTemp(194,0) = "Jordan"
aryTemp(194,1) = "\.jo"
aryTemp(195,0) = "Japan - Academic"
aryTemp(195,1) = "\.ac\.jp"
aryTemp(196,0) = "Japan - Commercial"
aryTemp(196,1) = "\.co\.jp"
aryTemp(197,0) = "Japan - Government"
aryTemp(197,1) = "\.go\.jp"
aryTemp(198,0) = "Japan - Organization"
aryTemp(198,1) = "\.or\.jp"
aryTemp(199,0) = "Japan - Network (ISP)"
aryTemp(199,1) = "\.ne\.jp"
aryTemp(200,0) = "Japan"
aryTemp(200,1) = "\.jp"
aryTemp(201,0) = "Kenya"
aryTemp(201,1) = "\.ke"
aryTemp(202,0) = "Kyrgyzstan"
aryTemp(202,1) = "\.j"
aryTemp(203,0) = "Cambodia"
aryTemp(203,1) = "\.kh"
aryTemp(204,0) = "Kiribati"
aryTemp(204,1) = "\.ki"
aryTemp(205,0) = "Comoros"
aryTemp(205,1) = "\.km"
aryTemp(206,0) = "Saint Kitts and Nevis"
aryTemp(206,1) = "\.kn"
aryTemp(207,0) = "Korea207, Democratic People's Republic"
aryTemp(207,1) = "\.kp"
aryTemp(208,0) = "Korea - Acedemic"
aryTemp(208,1) = "\.ac\.kr"
aryTemp(209,0) = "Korea - Commercial"
aryTemp(209,1) = "\.co\.kr"
aryTemp(210,0) = "Korea - Government"
aryTemp(210,1) = "\.go\.kr"
aryTemp(211,0) = "Korea - Network"
aryTemp(211,1) = "\.ne\.kr"
aryTemp(212,0) = "Korea - NM"
aryTemp(212,1) = "\.nm\.kr"
aryTemp(213,0) = "Korea - Organization"
aryTemp(213,1) = "\.or\.kr"
aryTemp(214,0) = "Korea - Research"
aryTemp(214,1) = "\.re\.kr"
aryTemp(215,0) = "Korea"
aryTemp(215,1) = "\.kr"
aryTemp(216,0) = "Kuwait"
aryTemp(216,1) = "\.kw"
aryTemp(217,0) = "Cayman Islands"
aryTemp(217,1) = "\.ky"
aryTemp(218,0) = "Kazakhstan"
aryTemp(218,1) = "\.kz"
aryTemp(219,0) = "Lao People's Democratic Republic"
aryTemp(219,1) = "\.la"
aryTemp(220,0) = "Lebanon"
aryTemp(220,1) = "\.lb"
aryTemp(221,0) = "Saint Lucia"
aryTemp(221,1) = "\.lc"
aryTemp(222,0) = "Liechtenstein"
aryTemp(222,1) = "\.li"
aryTemp(223,0) = "Sri Lanka"
aryTemp(223,1) = "\.lk"
aryTemp(224,0) = "Liberia"
aryTemp(224,1) = "\.lr"
aryTemp(225,0) = "Lesotho"
aryTemp(225,1) = "\.ls"
aryTemp(226,0) = "Lithuania"
aryTemp(226,1) = "\.lt"
aryTemp(227,0) = "Latvia"
aryTemp(227,1) = "\.lv"
aryTemp(228,0) = "Libyan Arab Jamahiriya"
aryTemp(228,1) = "\.ly"
aryTemp(229,0) = "Morocco"
aryTemp(229,1) = "\.ma"
aryTemp(230,0) = "Monoco - Organization"
aryTemp(230,1) = "\.asso\.mc"
aryTemp(231,0) = "Monoco - Commercial"
aryTemp(231,1) = "\.tm\.mc"
aryTemp(232,0) = "Morocco"
aryTemp(232,1) = "\.mc"
aryTemp(233,0) = "Moldova"
aryTemp(233,1) = "\.md"
aryTemp(234,0) = "Madagascar"
aryTemp(234,1) = "\.mg"
aryTemp(235,0) = "Marshall Islands"
aryTemp(235,1) = "\.mh"
aryTemp(236,0) = "Macedonia"
aryTemp(236,1) = "\.mk"
aryTemp(237,0) = "Mali"
aryTemp(237,1) = "\.ml"
aryTemp(238,0) = "Myanmar - Commercia"
aryTemp(238,1) = "\.com\.mm"
aryTemp(239,0) = "Myanmar - Organization"
aryTemp(239,1) = "\.org\.mm"
aryTemp(240,0) = "Myanmar - Network"
aryTemp(240,1) = "\.net\.mm"
aryTemp(241,0) = "Myanmar - Educational"
aryTemp(241,1) = "\.edu\.mm"
aryTemp(242,0) = "Myanmar - Government"
aryTemp(242,1) = "\.gov\.mm"
aryTemp(243,0) = "Myanmar"
aryTemp(243,1) = "\.mm"
aryTemp(244,0) = "Mongolia"
aryTemp(244,1) = "\.mn"
aryTemp(245,0) = "Macau"
aryTemp(245,1) = "\.mo"
aryTemp(246,0) = "Northern Mariana Islands"
aryTemp(246,1) = "\.mp"
aryTemp(247,0) = "Martinique"
aryTemp(247,1) = "\.mq"
aryTemp(248,0) = "Mauritania"
aryTemp(248,1) = "\.mr"
aryTemp(249,0) = "Montserrat"
aryTemp(249,1) = "\.ms"
aryTemp(250,0) = "Malta"
aryTemp(250,1) = "\.mt"
aryTemp(251,0) = "Mauritius"
aryTemp(251,1) = "\.mu"
aryTemp(252,0) = "Maldives"
aryTemp(252,1) = "\.mv"
aryTemp(253,0) = "Malawi"
aryTemp(253,1) = "\.mw"
aryTemp(254,0) = "Mexico - Commercial"
aryTemp(254,1) = "\.com\.mx"
aryTemp(255,0) = "Mexico - Network"
aryTemp(255,1) = "\.net\.mx"
aryTemp(256,0) = "Mexico - Organization"
aryTemp(256,1) = "\.org\.mx"
aryTemp(257,0) = "Mexico - Educational"
aryTemp(257,1) = "\.edu\.mx"
aryTemp(258,0) = "Mexico - Government"
aryTemp(258,1) = "\.gov\.mx"
aryTemp(259,0) = "Mexico"
aryTemp(259,1) = "\.mx"
aryTemp(260,0) = "Malaysia"
aryTemp(260,1) = "\.my"
aryTemp(261,0) = "Mozambique"
aryTemp(261,1) = "\.mz"
aryTemp(262,0) = "Namibia"
aryTemp(262,1) = "\.na"
aryTemp(263,0) = "New Caledonia"
aryTemp(263,1) = "\.nc"
aryTemp(264,0) = "Niger"
aryTemp(264,1) = "\.ne"
aryTemp(265,0) = "Norfolk Island"
aryTemp(265,1) = "\.nf"
aryTemp(266,0) = "Nicaragua"
aryTemp(266,1) = "\.ni"
aryTemp(267,0) = "Netherlands"
aryTemp(267,1) = "\.nl"
aryTemp(268,0) = "Norway"
aryTemp(268,1) = "\.no"
aryTemp(269,0) = "Nepal"
aryTemp(269,1) = "\.np"
aryTemp(270,0) = "Nauru"
aryTemp(270,1) = "\.nr"
aryTemp(271,0) = "Niue"
aryTemp(271,1) = "\.nu"
aryTemp(272,0) = "New Zealand - Commercial"
aryTemp(272,1) = "\.co\.nz"
aryTemp(273,0) = "New Zealand - Network (ISP)"
aryTemp(273,1) = "\.net\.nz"
aryTemp(274,0) = "New Zealand - Organization"
aryTemp(274,1) = "\.org\.nz"
aryTemp(275,0) = "New Zealand - Government"
aryTemp(275,1) = "\.govt\.nz"
aryTemp(276,0) = "New Zealand"
aryTemp(276,1) = "\.nz"
aryTemp(277,0) = "Oman"
aryTemp(277,1) = "\.om"
aryTemp(278,0) = "Panama"
aryTemp(278,1) = "\.pa"
aryTemp(279,0) = "Peru"
aryTemp(279,1) = "\.pe"
aryTemp(280,0) = "French Polynesia"
aryTemp(280,1) = "\.pf"
aryTemp(281,0) = "Papua New Guinea"
aryTemp(281,1) = "\.pg"
aryTemp(282,0) = "Philippines"
aryTemp(282,1) = "\.ph"
aryTemp(283,0) = "Pakistan"
aryTemp(283,1) = "\.pk"
aryTemp(284,0) = "Poland - Commercial"
aryTemp(284,1) = "\.com\.pl"
aryTemp(285,0) = "Poland - Network (ISP)"
aryTemp(285,1) = "\.net\.pl"
aryTemp(286,0) = "Poland - Organization"
aryTemp(286,1) = "\.org\.pl"
aryTemp(287,0) = "St. Pierre and Miquelon"
aryTemp(287,1) = "\.pm"
aryTemp(288,0) = "Pitcairn Island"
aryTemp(288,1) = "\.pn"
aryTemp(289,0) = "Puerto Rico"
aryTemp(289,1) = "\.pr"
aryTemp(290,0) = "Palestinian Territories"
aryTemp(290,1) = "\.ps"
aryTemp(291,0) = "Portugal"
aryTemp(291,1) = "\.pt"
aryTemp(292,0) = "Palau"
aryTemp(292,1) = "\.pw"
aryTemp(293,0) = "Paraguay"
aryTemp(293,1) = "\.py"
aryTemp(294,0) = "Qatar"
aryTemp(294,1) = "\.qa"
aryTemp(295,0) = "Reunion Island"
aryTemp(295,1) = "\.re"
aryTemp(296,0) = "Romania - Commercial"
aryTemp(296,1) = "\.com\.ro"
aryTemp(297,0) = "Romania - Organization"
aryTemp(297,1) = "\.org\.ro"
aryTemp(298,0) = "Romania - Store"
aryTemp(298,1) = "\.store\.ro"
aryTemp(299,0) = "Romania - Trademark"
aryTemp(299,1) = "\.tm\.ro"
aryTemp(300,0) = "Romania - Firm"
aryTemp(300,1) = "\.firm\.ro"
aryTemp(301,0) = "Romania - Web"
aryTemp(301,1) = "\.www\.ro"
aryTemp(302,0) = "Romania - Artistic"
aryTemp(302,1) = "\.arts\.ro"
aryTemp(303,0) = "Romania - Recreational"
aryTemp(303,1) = "\.rec\.ro"
aryTemp(304,0) = "Romania - Informational"
aryTemp(304,1) = "\.info\.ro"
aryTemp(305,0) = "Romania - Personal"
aryTemp(305,1) = "\.nom\.ro"
aryTemp(306,0) = "Romania - NT"
aryTemp(306,1) = "\.nt\.ro"
aryTemp(307,0) = "Romania"
aryTemp(307,1) = "\.ro"
aryTemp(308,0) = "Russia - Commercial"
aryTemp(308,1) = "\.com\.ru"
aryTemp(309,0) = "Russia - Network (ISP)"
aryTemp(309,1) = "\.net\.ru"
aryTemp(310,0) = "Russia - Organization"
aryTemp(310,1) = "\.org\.ru"
aryTemp(311,0) = "Russia"
aryTemp(311,1) = "\.ru"
aryTemp(312,0) = "Rwanda"
aryTemp(312,1) = "\.rw"
aryTemp(313,0) = "Saudi Arabia"
aryTemp(313,1) = "\.sa"
aryTemp(314,0) = "Solomon Islands"
aryTemp(314,1) = "\.sb"
aryTemp(315,0) = "Seychelles"
aryTemp(315,1) = "\.sc"
aryTemp(316,0) = "Sudan"
aryTemp(316,1) = "\.sd"
aryTemp(317,0) = "Swedan"
aryTemp(317,1) = "\.se"
aryTemp(318,0) = "Singapore - Commercial"
aryTemp(318,1) = "\.com\.sg"
aryTemp(319,0) = "Singapore - Organization"
aryTemp(319,1) = "\.org\.sg"
aryTemp(320,0) = "Singapore - Network"
aryTemp(320,1) = "\.net\.sg"
aryTemp(321,0) = "Singapore - Government"
aryTemp(321,1) = "\.gov\.sg"
aryTemp(322,0) = "Singapore"
aryTemp(322,1) = "\.sg"
aryTemp(323,0) = "St. Helena"
aryTemp(323,1) = "\.sh"
aryTemp(324,0) = "Slovenia"
aryTemp(324,1) = "\.si"
aryTemp(325,0) = "Svalbard and Jan Mayen Islands"
aryTemp(325,1) = "\.sj"
aryTemp(326,0) = "Slovak Republic"
aryTemp(326,1) = "\.sk"
aryTemp(327,0) = "Sierra Leone"
aryTemp(327,1) = "\.sl"
aryTemp(328,0) = "San Marino"
aryTemp(328,1) = "\.sm"
aryTemp(329,0) = "Senegal"
aryTemp(329,1) = "\.sn"
aryTemp(330,0) = "Somalia"
aryTemp(330,1) = "\.so"
aryTemp(331,0) = "Suriname"
aryTemp(331,1) = "\.sr"
aryTemp(332,0) = "Sao Tome and Principe"
aryTemp(332,1) = "\.st"
aryTemp(333,0) = "El Salvador"
aryTemp(333,1) = "\.sv"
aryTemp(334,0) = "Syrian Arab Republic"
aryTemp(334,1) = "\.sy"
aryTemp(335,0) = "Swaziland"
aryTemp(335,1) = "\.sz"
aryTemp(336,0) = "Turks and Caicos Islands"
aryTemp(336,1) = "\.tc"
aryTemp(337,0) = "Chad"
aryTemp(337,1) = "\.td"
aryTemp(338,0) = "French Souther Territories"
aryTemp(338,1) = "\.tf"
aryTemp(339,0) = "Togo"
aryTemp(339,1) = "\.tg"
aryTemp(340,0) = "Thailand - Academic"
aryTemp(340,1) = "\.ac\.th"
aryTemp(341,0) = "Thailand - Commercial"
aryTemp(341,1) = "\.co\.th"
aryTemp(342,0) = "Thailand - Government"
aryTemp(342,1) = "\.go\.th"
aryTemp(343,0) = "Thailand - Military"
aryTemp(343,1) = "\.mi\.th"
aryTemp(344,0) = "Thailand - Network (ISP)"
aryTemp(344,1) = "\.net\.th"
aryTemp(345,0) = "Thailand - Organization"
aryTemp(345,1) = "\.or\.th"
aryTemp(346,0) = "Thailand"
aryTemp(346,1) = "\.th"
aryTemp(347,0) = "Tajikistan"
aryTemp(347,1) = "\.tj"
aryTemp(348,0) = "Tokelau"
aryTemp(348,1) = "\.tk"
aryTemp(349,0) = "Turkmenistan"
aryTemp(349,1) = "\.tm"
aryTemp(350,0) = "Tunisia"
aryTemp(350,1) = "\.tn"
aryTemp(351,0) = "Tonga"
aryTemp(351,1) = "\.to"
aryTemp(352,0) = "East Timor"
aryTemp(352,1) = "\.tp"
aryTemp(353,0) = "Turkey - BBS"
aryTemp(353,1) = "\.bbs\.tr"
aryTemp(354,0) = "Turkey - Commercial"
aryTemp(354,1) = "\.com\.tr"
aryTemp(355,0) = "Turkey - Educational"
aryTemp(355,1) = "\.edu\.tr"
aryTemp(356,0) = "Turkey - Government"
aryTemp(356,1) = "\.gov\.tr"
aryTemp(357,0) = "Turkey - K12"
aryTemp(357,1) = "\.k12\.tr"
aryTemp(358,0) = "Turkey - Military"
aryTemp(358,1) = "\.mil\.tr"
aryTemp(359,0) = "Turkey - Network"
aryTemp(359,1) = "\.net\.tr"
aryTemp(360,0) = "Turkey - Organization"
aryTemp(360,1) = "\.org\.tr"
aryTemp(361,0) = "Turkey"
aryTemp(361,1) = "\.tr"
aryTemp(362,0) = "Trinidad and Tobago"
aryTemp(362,1) = "\.tt"
aryTemp(363,0) = "Tuvalu"
aryTemp(363,1) = "\.tv"
aryTemp(364,0) = "Taiwan"
aryTemp(364,1) = "\.tw"
aryTemp(365,0) = "Tanzania"
aryTemp(365,1) = "\.tz"
aryTemp(366,0) = "Ukraine"
aryTemp(366,1) = "\.ua"
aryTemp(367,0) = "Uganda"
aryTemp(367,1) = "\.ug"
aryTemp(368,0) = "UK - Acedemic"
aryTemp(368,1) = "\.ac\.uk"
aryTemp(369,0) = "UK - Commercial"
aryTemp(369,1) = "\.co\.uk"
aryTemp(370,0) = "UK - Network (ISP)"
aryTemp(370,1) = "\.net\.uk"
aryTemp(371,0) = "UK - Ltd"
aryTemp(371,1) = "\.ltd\.uk"
aryTemp(372,0) = "UK - Organization"
aryTemp(372,1) = "\.org\.uk"
aryTemp(373,0) = "UK - Plc"
aryTemp(373,1) = "\.plc\.uk"
aryTemp(374,0) = "United Kingdom"
aryTemp(374,1) = "\.uk"
aryTemp(375,0) = "US Minor Outlying Islands"
aryTemp(375,1) = "\.um"
aryTemp(376,0) = "United States"
aryTemp(376,1) = "\.us"
aryTemp(377,0) = "Uruguay"
aryTemp(377,1) = "\.uy"
aryTemp(378,0) = "Uzbekistan"
aryTemp(378,1) = "\.uz"
aryTemp(379,0) = "Vatican City"
aryTemp(379,1) = "\.vc"
aryTemp(380,0) = "Venezuela"
aryTemp(380,1) = "\.ve"
aryTemp(381,0) = "Virgin Islands (British)"
aryTemp(381,1) = "\.vg"
aryTemp(382,0) = "Virgin Islands (USA)"
aryTemp(382,1) = "\.vi"
aryTemp(383,0) = "Vietnam"
aryTemp(383,1) = "\.vn"
aryTemp(384,0) = "Vanuatu"
aryTemp(384,1) = "\.vu"
aryTemp(385,0) = "Wallis And Futana Islands"
aryTemp(385,1) = "\.wf"
aryTemp(386,0) = "Western Samoa"
aryTemp(386,1) = "\.ws"
aryTemp(387,0) = "Yemen"
aryTemp(387,1) = "\.ye"
aryTemp(388,0) = "Mayotte"
aryTemp(388,1) = "\.yt"
aryTemp(389,0) = "Yugoslavia"
aryTemp(389,1) = "\.yu"
aryTemp(390,0) = "South Africa - Acedemic"
aryTemp(390,1) = "\.ac\.za"
aryTemp(391,0) = "South Africa - Alternative"
aryTemp(391,1) = "\.alt\.za"
aryTemp(392,0) = "South Africa - Commercial"
aryTemp(392,1) = "\.co\.za"
aryTemp(393,0) = "South Africa - Educational"
aryTemp(393,1) = "\.edu\.za"
aryTemp(394,0) = "South Africa - Government"
aryTemp(394,1) = "\.gov\.za"
aryTemp(395,0) = "South Africa - Military"
aryTemp(395,1) = "\.mil\.za"
aryTemp(396,0) = "South Africa - Network"
aryTemp(396,1) = "\.net\.za"
aryTemp(397,0) = "South Africa - Non Gov't Organization"
aryTemp(397,1) = "\.ngo\.za"
aryTemp(398,0) = "South Africa -Individual "
aryTemp(398,1) = "\.nom\.za"
aryTemp(399,0) = "South Africa - Organization"
aryTemp(399,1) = "\.org\.za"
aryTemp(400,0) = "South Africa - School"
aryTemp(400,1) = "\.school\.za"
aryTemp(401,0) = "South Africa - Trademark"
aryTemp(401,1) = "\.tm\.za"
aryTemp(402,0) = "South Africa - Web"
aryTemp(402,1) = "\.web\.za"
aryTemp(403,0) = "South Africa"
aryTemp(403,1) = "\.za"
aryTemp(404,0) = "Zambia"
aryTemp(404,1) = "\.zm"
aryTemp(405,0) = "Zimbabwe"
aryTemp(405,1) = "\.zw"
aryTemp(406,0) = "Canada"
aryTemp(406,1) = "\.ca"
GetDomainExtensionArray = aryTemp
End Function
' FUNCTION TO CONVERT LANGUAGE CODE TO NAME
Private Function ConvertToLanguageName(strLanguage)
Dim strTemp, strLanguageAbbrev
If InStr(strLanguage, ",") > 0 Then
strLanguageAbbrev=Trim(Left(strLanguage, InStr(strLanguage, ",")-1))
Else
strLanguageAbbrev=Trim(strLanguage)
End If
If InStr(strLanguageAbbrev, ";") > 0 Then
strLanguageAbbrev=Trim(Left(strLanguage, InStr(strLanguage, ";")-1))
End If
Select Case LCase(strLanguageAbbrev)
Case "af"
strTemp = "Afrikaans"
Case "sq"
strTemp = "Albanian"
Case "ar"
strTemp = "Arabic"
Case "ar-sa"
strTemp = "Arabic (Saudi Arabia)"
Case "ar-iq"
strTemp = "Arabic (Iraq)"
Case "ar-eg"
strTemp = "Arabic (Egypt)"
Case "ar-ly"
strTemp = "Arabic (Libya)"
Case "ar-dz"
strTemp = "Arabic (Algeria)"
Case "ar-ma"
strTemp = "Arabic (Morocco)"
Case "ar-tn"
strTemp = "Arabic (Tunisia)"
Case "ar-om"
strTemp = "Arabic (Oman)"
Case "ar-ye"
strTemp = "Arabic (Yemen)"
Case "ar-sy"
strTemp = "Arabic (Syria)"
Case "ar-jo"
strTemp = "Arabic (Jordan)"
Case "ar-lb"
strTemp = "Arabic (Lebanon)"
Case "ar-kw"
strTemp = "Arabic (Kuwait)"
Case "ar-ae"
strTemp = "Arabic (U.A.E.)"
Case "ar-bh"
strTemp = "Arabic (Bahrain)"
Case "ar-qa"
strTemp = "Arabic (Qatar)"
Case "eu"
strTemp = "Basque"
Case "bg"
strTemp = "Bulgarian"
Case "be"
strTemp = "Belarusian"
Case "ca"
strTemp = "Catalan"
Case "zh-tw"
strTemp = "Chinese (Taiwan)"
Case "zh-cn"
strTemp = "Chinese (PRC)"
Case "zh-hk"
strTemp = "Chinese (Hong Kong)"
Case "zh-sg"
strTemp = "Chinese (Singapore)"
Case "zh"
strTemp = "Chinese"
Case "hr"
strTemp = "Croatian"
Case "cs"
strTemp = "Czech"
Case "da"
strTemp = "Danish"
Case "nl"
strTemp = "Dutch (Standard)"
Case "nl-be"
strTemp = "Dutch (Belgian)"
Case "en"
strTemp = "English"
Case "en-us"
strTemp = "English (United States)"
Case "en-gb"
strTemp = "English (British)"
Case "en-au"
strTemp = "English (Australian)"
Case "en-ca"
strTemp = "English (Canadian)"
Case "en-nz"
strTemp = "English (New Zealand)"
Case "en-ie"
strTemp = "English (Ireland)"
Case "en-za"
strTemp = "English (South Africa)"
Case "en-jm"
strTemp = "English (Jamaica)"
Case "en"
strTemp = "English (Caribbean)"
Case "en-bz"
strTemp = "English (Belize)"
Case "en-tt"
strTemp = "English (Trinidad)"
Case "et"
strTemp = "Estonian"
Case "fo"
strTemp = "Faeroese"
Case "fa"
strTemp = "Farsi"
Case "fi"
strTemp = "Finnish"
Case "fr", "fr-fr"
strTemp = "French (Standard)"
Case "fr-be"
strTemp = "French (Belgian)"
Case "fr-ca"
strTemp = "French (Canadian)"
Case "fr-ch"
strTemp = "French (Swiss)"
Case "fr-lu"
strTemp = "French (Luxembourg)"
Case "mk"
strTemp = "FYRO Macedonian"
Case "gd"
strTemp = "Gaelic (Scots)"
Case "gd-ie"
strTemp = "Gaelic (Irish)"
Case "de"
strTemp = "German (Standard)"
Case "de-ch"
strTemp = "German (Swiss)"
Case "de-at"
strTemp = "German (Austrian)"
Case "de-lu"
strTemp = "German (Luxembourg)"
Case "de-li"
strTemp = "German (Liechtenstein)"
Case "e", "el"
strTemp = "Greek"
Case "he"
strTemp = "Hebrew"
Case "hi"
strTemp = "Hindi"
Case "hu"
strTemp = "Hungarian"
Case "is"
strTemp = "Icelandic"
Case "id"
strTemp = "Indonesian"
Case "it"
strTemp = "Italian (Standard)"
Case "it-ch"
strTemp = "Italian (Swiss)"
Case "it-it"
strTemp = "Italian"
Case "ja"
strTemp = "Japanese"
Case "ko"
strTemp = "Korean"
Case "ko"
strTemp = "Korean (Johab)"
Case "lv"
strTemp = "Latvian"
Case "lt"
strTemp = "Lithuanian"
Case "ms"
strTemp = "Malaysian"
Case "mt"
strTemp = "Maltese"
Case "no"
strTemp = "Norwegian (Bokmal)"
Case "no"
strTemp = "Norwegian (Nynorsk)"
Case "pl"
strTemp = "Polish"
Case "pt-br"
strTemp = "Portuguese (Brazil)"
Case "pt"
strTemp = "Portuguese (Portugal)"
Case "rm"
strTemp = "Rhaeto-Romanic"
Case "ro"
strTemp = "Romanian"
Case "ro-mo"
strTemp = "Romanian (Moldavia)"
Case "ru"
strTemp = "Russian"
Case "ru-mo"
strTemp = "Russian (Moldavia)"
Case "sz"
strTemp = "Sami (Lappish)"
Case "sr"
strTemp = "Serbian (Cyrillic)"
Case "sr"
strTemp = "Serbian (Latin)"
Case "sk"
strTemp = "Slovak"
Case "s", "sl"
strTemp = "Slovenian"
Case "sb"
strTemp = "Sorbian"
Case "es", "es-es"
strTemp = "Spanish (Spain - Traditional Sort)"
Case "es-mx"
strTemp = "Spanish (Mexican)"
Case "es-gt"
strTemp = "Spanish (Guatemala)"
Case "es-cr"
strTemp = "Spanish (Costa Rica)"
Case "es-pa"
strTemp = "Spanish (Panama)"
Case "es-do"
strTemp = "Spanish (Dominican Republic)"
Case "es-ve"
strTemp = "Spanish (Venezuela)"
Case "es-co"
strTemp = "Spanish (Colombia)"
Case "es-pe"
strTemp = "Spanish (Peru)"
Case "es-ar"
strTemp = "Spanish (Argentina)"
Case "es-ec"
strTemp = "Spanish (Ecuador)"
Case "es-cl"
strTemp = "Spanish (Chile)"
Case "es-uy"
strTemp = "Spanish (Uruguay)"
Case "es-py"
strTemp = "Spanish (Paraguay)"
Case "es-bo"
strTemp = "Spanish (Bolivia)"
Case "es-sv"
strTemp = "Spanish (El Salvador)"
Case "es-hn"
strTemp = "Spanish (Honduras)"
Case "es-ni"
strTemp = "Spanish (Nicaragua)"
Case "es-pr"
strTemp = "Spanish (Puerto Rico)"
Case "sx"
strTemp = "Sutu"
Case "sv"
strTemp = "Swedish"
Case "sv-fi"
strTemp = "Swedish (Finland)"
Case "th"
strTemp = "Thai"
Case "ts"
strTemp = "Tsonga"
Case "tn"
strTemp = "Tswana"
Case "tr"
strTemp = "Turkish"
Case "uk"
strTemp = "Ukrainian"
Case "ur"
strTemp = "Urdu"
Case "ve"
strTemp = "Venda"
Case "vi"
strTemp = "Vietnamese"
Case "xh"
strTemp = "Xhosa"
Case "ji"
strTemp = "Yiddish"
Case "zu"
strTemp = "Zulu"
Case Else
strTemp = strLanguageAbbrev
End Select
ConvertToLanguageName = strTemp
End Function
Private Function DecodeString(strDecode)
Select Case Ucase(strDecode)
Case "%20" ' SPACE
strDecode = " "
Case "%24" ' $
strDecode = "$"
Case "%26" ' &
strDecode = "&"
Case "%26" ' &
strDecode = "&"
Case "%27" ' &
strDecode = "&"
Case "%2B" ' +
strDecode = "+"
Case "%2C" ' ,
strDecode = ","
Case "%2E" ' .
strDecode = "."
Case "%2F" ' /
strDecode = "/"
Case "%3A" ' :
strDecode = ":"
Case "%3B" ' ;
strDecode = ";"
Case "%3D" ' =
strDecode = "="
Case "%3F" ' ?
strDecode = "?"
Case "%40" ' @
strDecode = "@"
Case "%22" ' "
strDecode = """"
Case "%3C" ' <
strDecode = "<"
Case "%3E" ' >
strDecode = ">"
Case "%23" ' #
strDecode = "#"
Case "%25" ' %
strDecode = "%"
Case "%7B" ' {
strDecode = "}"
Case "%7D" ' }
strDecode = "{"
Case "%7C" ' |
strDecode = "|"
Case "%5C" ' \
strDecode = "\"
Case "%5E" ' ^
strDecode = "^"
Case "%7E" ' ~
strDecode = "~"
Case "%5B" ' [
strDecode = "]"
Case "%5D" ' ]
strDecode = "["
Case "%60" ' `
strDecode = "`"
End Select
DecodeString=strDecode
End Function
End Class
%>