% Option Explicit '########################################################### '## 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. '########################################################### %> <% Server.ScriptTimeout = 3600 Dim strAction, sngVersion strAction = UCase(Request.Querystring("action")) Function DetectVersion(strType) Dim strSql, strConn, objConn, objRS Dim blnLanguage, blnReferrer ' CREATE DATABASE CONNECTION strConn = CreateDatabaseConnection (strDatabaseType, strDatabaseLocation, strDatabaseName, _ strDatabaseUsername, strDatabasePassword) Set objConn = Server.CreateObject("ADODB.Connection") objConn.Mode = 3 '3 = adModeReadWrite objConn.CommandTimeout = 600 objConn.ConnectionTimeout = 30 objConn.Open strConn Select Case strType Case "SCHEMA" Set objRS = objConn.OpenSchema(4) sngVersion = 0.993 blnLanguage = False blnReferrer = False Do While Not objRS.EOF If objRS("Table_Name") = strInstance & "PageLog" Then If objRS("Column_Name") = "pl_referrerextension" Then blnReferrer = True End If If objRS("Column_Name") = "pl_languageactual" Then blnLanguage = True End If End If objRs.Movenext Loop objRS.Close Set objRS = Nothing If blnReferrer = True And blnLanguage = True Then sngVersion = 1.2 ElseIf blnReferrer = True And blnLanguage = False Then sngVersion = 1.3 Else sngVersion = 0.993 End If Case Else 'DATA Dim rsCheck1, rsCheck2 strSql = "SELECT COUNT(*) FROM " & strInstance & "PageLog" Set rsCheck1 = objConn.Execute(strSql) If Not rsCheck1.Eof Then If rsCheck1(0) > 0 Then strSql = "SELECT COUNT(pl_scripturl) FROM " & strInstance & "PageLog " &_ "WHERE pl_scripturl <> ''" Set rsCheck2 = objConn.Execute(strSql) If Not rsCheck2.Eof Then If rsCheck2(0) = 0 Then sngVersion = 0.993 Else sngVersion = 1.2 End If End If Else sngVersion = 1.3 End If End If End Select objConn.Close Set objConn = Nothing DetectVersion = sngVersion End Function Sub UpgradeDB() On Error Resume Next Dim rsUpgrade, strSql, objConn Dim blnResult, objError, strConn, strError ' CREATE DATABASE CONNECTION strConn = CreateDatabaseConnection (strDatabaseType, strDatabaseLocation, strDatabaseName, _ strDatabaseUsername, strDatabasePassword) Set rsUpgrade = Server.CreateObject("ADODB.Recordset") sngVersion = DetectVersion("SCHEMA") If sngVersion < 1.2 Then ' ADD pl_scripturl FIELD If strDatabaseType = "MSSQL" Then strSql = "ALTER TABLE [DBO].[" & strInstance & "PAGELOG] ADD [pl_scripturl] [varchar] (255) NULL" Else strSql = "ALTER TABLE " & strInstance & "PAGELOG ADD COLUMN pl_scripturl text(255)" End If rsUpgrade.Open strSql, strConn strError = strError & CheckForErrors(rsUpgrade.ActiveConnection) ' REMOVE pl_referrerdomain FIELD If strDatabaseType = "MSSQL" Then strSql = "ALTER TABLE [DBO].[" & strInstance & "PAGELOG] DROP COLUMN [pl_referrerdomain]" Else strSql = "ALTER TABLE " & strInstance & "PAGELOG DROP COLUMN pl_referrerdomain" End If rsUpgrade.Open strSql, strConn strError = strError & CheckForErrors(rsUpgrade.ActiveConnection) ' ADD pl_referrerhost FIELD If strDatabaseType = "MSSQL" Then strSql = "ALTER TABLE [DBO].[" & strInstance & "PAGELOG] ADD [pl_referrerhost] [varchar] (150) NULL" Else strSql = "ALTER TABLE " & strInstance & "PAGELOG ADD COLUMN pl_referrerhost text(150)" End If rsUpgrade.Open strSql, strConn strError = strError & CheckForErrors(rsUpgrade.ActiveConnection) ' ADD pl_referrerdomain FIELD If strDatabaseType = "MSSQL" Then strSql = "ALTER TABLE [DBO].[" & strInstance & "PAGELOG] ADD [pl_referrerdomain] [varchar] (100) NULL" Else strSql = "ALTER TABLE " & strInstance & "PAGELOG ADD COLUMN pl_referrerdomain text(100)" End If rsUpgrade.Open strSql, strConn strError = strError & CheckForErrors(rsUpgrade.ActiveConnection) ' ADD pl_referrerextension FIELD If strDatabaseType = "MSSQL" Then strSql = "ALTER TABLE [DBO].[" & strInstance & "PAGELOG] ADD [pl_referrerextension] [varchar] (10) NULL" Else strSql = "ALTER TABLE " & strInstance & "PAGELOG ADD COLUMN pl_referrerextension text(10)" End If rsUpgrade.Open strSql, strConn strError = strError & CheckForErrors(rsUpgrade.ActiveConnection) End If If sngVersion < 1.3 Then ' DROP LANGUAGE ACTUAL FIELD If strDatabaseType = "MSSQL" Then strSql = "ALTER TABLE [DBO].[" & strInstance & "PAGELOG] DROP COLUMN [pl_languageactual]" Else strSql = "ALTER TABLE " & strInstance & "PAGELOG DROP COLUMN pl_languageactual" End If rsUpgrade.Open strSql, strConn strError = strError & CheckForErrors(rsUpgrade.ActiveConnection) End If If Len(strError) = 0 Then Response.Write "
Database schema upgrade is complete.
" Else Response.Write "Database upgrade failed.
" Response.Write "Log:
" & strError End If rsUpgrade.Close Set rsUpgrade = Nothing objConn.Close Set objConn = Nothing End Sub Sub UpgradeData() Dim rsUpgrade, rsUpgrade2, rsUpgrade3, rsUpgrade4 Dim strSql, objConn, strScriptUrl, objUpgrade, intLoop Dim blnResult, objError, strConn, strError, strLanguage Dim strReferrer, strDomain, strHost, strExtension, strUrl, strSite, arySiteAliases ' CREATE DATABASE CONNECTION strConn = CreateDatabaseConnection (strDatabaseType, strDatabaseLocation, strDatabaseName, _ strDatabaseUsername, strDatabasePassword) Set objConn = Server.CreateObject("ADODB.Connection") objConn.Mode = 3 '3 = adModeReadWrite objConn.CommandTimeout = 600 objConn.ConnectionTimeout = 30 objConn.Open strConn sngVersion = DetectVersion("DATA") If sngVersion = 0.993 Then ' UPGRADE pl_SCRIPTURL FIELD strSql = "SELECT DISTINCT pl_scriptname, pl_querystring FROM " & strInstance & "PageLog " &_ "WHERE (pl_scripturl = '' OR pl_scripturl IS NULL)" Set rsUpgrade = objConn.Execute(strSql) Do While Not rsUpgrade.Eof If rsUpgrade(1) <> "" Then If Len(rsUpgrade(1)) > 1 Then If LCase(Mid(rsUpgrade(1), 1, 2)) <> "r=" Then strScriptUrl = rsUpgrade(0) & "?" & rsUpgrade(1) Else strScriptUrl = rsUpgrade(0) End If Else strScriptUrl = rsUpgrade(0) & "?" & rsUpgrade(1) End If Else strScriptUrl = rsUpgrade(0) End If strSql = "UPDATE " & strInstance & "PageLog SET pl_scripturl = " & FormatDatabaseString(strScriptUrl, 255) & " " &_ "WHERE pl_scriptname = " & FormatDatabaseString(rsUpgrade(0), 255) & " " &_ "AND pl_querystring = " & FormatDatabaseString(rsUpgrade(1), 255) objConn.Execute(strSql) rsUpgrade.Movenext Loop rsUpgrade.Close Set rsUpgrade = Nothing ' UPGRADE pl_referrerurl (IF NESSASARY) strSql = "SELECT DISTINCT pl_referrer FROM " & strInstance & "PageLog " &_ "WHERE pl_referrer <> '' " &_ "AND (pl_referrerurl = '' OR pl_referrerurl IS NULL)" Set rsUpgrade2 = objConn.Execute(strSql) ' INSTANTIATE OBJECT FROM CLASS.ASP FILE Set objUpgrade = New clsMetaTraffic Do While Not rsUpgrade2.Eof strReferrer = rsUpgrade2(0) ' SET SOME PROPERTIES strUrl = objUpgrade.ExtractReferrerUrl(strReferrer) ' UPDATE DATA strSql = "UPDATE " & strInstance & "PageLog " &_ "SET pl_referrerurl = " & FormatDatabaseString(strUrl, 255) & " " &_ "WHERE pl_referrer = " & FormatDatabaseString(strReferrer, 255) objConn.Execute(strSql) rsUpgrade2.Movenext Loop rsUpgrade2.Close Set rsUpgrade2 = Nothing ' UPGRADE REFERRER HOST, DOMAIN, EXTENSION DATA strSql = "SELECT DISTINCT pl_referrer FROM " & strInstance & "PageLog " &_ "WHERE pl_referrer <> '' " &_ "AND (pl_referrerhost = '' OR pl_referrerhost IS NULL)" Set rsUpgrade3 = objConn.Execute(strSql) Do While Not rsUpgrade3.Eof strReferrer = rsUpgrade3(0) ' SET SOME PROPERTIES strDomain = objUpgrade.ExtractReferrerDomain(strReferrer) strHost = objUpgrade.ExtractReferrerHost(strReferrer) strExtension = objUpgrade.ExtractReferrerExtension(strReferrer) ' UPDATE DATA strSql = "UPDATE " & strInstance & "PageLog " &_ "SET pl_referrerdomain = " & FormatDatabaseString(strDomain, 100) & ", " &_ "pl_referrerhost = " & FormatDatabaseString(strHost, 150) & ", " &_ "pl_referrerextension = " & FormatDatabaseString(strExtension, 10) & " " &_ "WHERE pl_referrer = " & FormatDatabaseString(strReferrer, 255) objConn.Execute(strSql) rsUpgrade3.Movenext Loop rsUpgrade3.Close Set rsUpgrade3 = Nothing Set objUpgrade = Nothing End If If sngVersion = 1.2 Then ' FIX LANGUAGE FIELD strSql = "SELECT DISTINCT pl_language FROM " & strInstance & "PageLog " &_ "WHERE pl_language LIKE '%,%'" Set rsUpgrade4 = objConn.Execute(strSql) Do While Not rsUpgrade4.Eof strLanguage = Trim(Left(rsUpgrade4(0), InStr(rsUpgrade4(0), ",")-1)) strSql = "UPDATE " & strInstance & "PageLog SET pl_language = " & FormatDatabaseString(strLanguage, 255) & " " &_ "WHERE pl_language = " & FormatDatabaseString(rsUpgrade4(0), 255) objConn.Execute(strSql) rsUpgrade4.Movenext Loop rsUpgrade4.Close Set rsUpgrade4 = Nothing ' FORMAT SITE ALIASES If Len(strSiteAliases) > 0 Then ' 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) ' NOW UPDATE DB strSql = "UPDATE " & strInstance & "PageLog SET pl_referrerdomain = '', " &_ "pl_referrerurl = '', pl_referrerextension = '' " &_ "WHERE pl_referrerhost IN (" & strSiteAliases & ")" objConn.Execute(strSql) End If ' FIX POTENTIAL NULL ISSUE strSql = "UPDATE PageLog SET pl_referrerhost='', pl_referrerdomain='', pl_referrerextension='' " &_ "WHERE pl_referrer = ''" objConn.Execute(strSql) End If objConn.Close Set objConn = Nothing Response.Write "Data upgrade is complete.
" If strDatabaseType = "MSACCESS" Then Response.Write "You should go to MetaTraffic setup and use the compact / repair utility to " &_ "optimize your database now.
" End If End Sub Function CheckForErrors(objConn) Dim objError, strError If objConn.Errors.Count > 0 Then For Each objError in objConn.Errors If objError.Number <> 0 Then strError = "Error #: | " & objError.Number & " |
Native Error: | " & objError.NativeError & " |
Source: | " & objError.Source & " |
Description: | " & objError.Description & " |
Upgrade MetaTraffic
Please make sure you read the ReadMe before upgrading and you have backed up your database. Delete this file from your web server when you have completed the upgrade.
<% Select Case strAction Case "UPGRADE" ' UPGRADE DATABASE ' --UDPATE DATAbASE STRUCTURE-- Response.Write ""
Response.Write " Upgrading Table Structure... " Call UpgradeDB() Response.Write "" Response.Write " |
"
Response.Write " Updating data...this may take a while. " Call UpgradeData() Response.Write "" Response.Write " |
Step 1: Upgrade Database Schema | " .Write "Step 2: Update Database Data | " .Write "
This adds several fields to the MetaTraffic database. " .Write "If you are running SQL Server, you must have a user with DBO " .Write "permissions on the database. This is usually the SA account. " .Write " | "
.Write "This populates the data in the newly created fields from " .Write "Step 1. This can take a while depending on the size of your database. " .Write " | "
.Write "
" .Write " | " .Write " |