INFO: Establishing a Relationship with the Referrer Class (312507)


The information in this article applies to:

  • Microsoft Commerce Server 4.0
  • Microsoft Commerce Server 2002
  • Microsoft Commerce Server 2000
This article was previously published under Q312507

SUMMARY

This article provides a code sample which sets up a relationship between the Request class and the Referrer class, which causes each referrer to be logged per request.

By default, the Referrer class in the schema is not used. To use it, you have to establish a relationship with Referrer and another class.

You can also set up a relationship between the Visit class and the Referrer class so that the referrer is only recorded from the time at which the visit starts. By doing this, you catch most of the external referrers; however, you would still miss some if someone leaves the site and then quickly returns.

MORE INFORMATION

Sample Code

Option Explicit
On Error Resume Next

Const sSQL_SERVER_NAME = "MySQLServer"
Const sDB_NAME = "MyDatabase"
Const sUSER_ID = "sa"
Const sPWD = ""

Call Main

'//-----------------------------------------------------------------------------
'//  Description: Main
'//-----------------------------------------------------------------------------
Sub Main()
    On Error Resume Next

    Call AddMyRel
    
End Sub

Sub AddMyRel()

    On Error Resume Next
    WScript.echo "Adding Reldef between Request and Referrer"
    Call AddRel(sSQL_SERVER_NAME, "Request", "Referrer", 194)

End Sub

Function AddRel(sSqlServerName, sChildClass, sParentClass, sRelType)
    On Error Resume Next

    Dim rec
    Dim cn
    Dim cmdChange
    Dim strURL
    
    '// Set AddColToTable to the default value
    AddRel = False

    Set rec = CreateObject("ADODB.Record")
    Set cn = CreateObject("ADODB.Connection.2.5")
    Set cmdChange = CreateObject("ADODB.Command.2.5")
    If 0 <> Err.Number Then
        MsgBox "[AddColToTable] An error occured while creating objects: " & Err.Number & " " & Err.Description
        Exit Function
    End If

    ' ----------------------------------
    ' Initial Bind
    ' ----------------------------------
    strURL = "URL=MSCOP://INPROCCONNECT/SERVER=" & sSqlServerName & ":DATABASE=" & sDB_NAME & ":USER=" & sUSER_ID & ":PASSWORD=" & sPWD & ":CATALOG=dwschema:fastload=true:"
    cn.Open strURL
    If 0 <> Err.Number Then
        MsgBox "[AddColToTable] cn.Open: " & Err.Number & " " & Err.Description
        Exit Function
    Else
        ' ----------------------------------
        ' Turn on Schema Change Mode
        ' ----------------------------------
        Set cmdChange.ActiveConnection = cn
        cmdChange.CommandText = "schemamode=1"
        cmdChange.Execute
        
        ' ----------------------------------
        ' Add a new MEMBER
        ' ----------------------------------
        Dim sText
        sText = "Relation/Rel" & CStr(sChildClass) & CStr(sParentClass)
        rec.Open sText, cn, 2, 8192
        
        rec("ParentClassName") = sParentClass
        rec("ParentClasskey") = sParentClass & "Key"
        rec("ChildClassName") = sChildClass
        rec("RelType") = sRelType
        rec("__Commit") = 1
        rec.Fields.Update
        rec.Close
    
        cmdChange.CommandText = "CommitSchema"
        cmdChange.Execute
        cmdChange.CommandText = "schemamode=0"  'change non-updatable mode
        cmdChange.Execute
        If 0 <> Err.Number Then
            MsgBox "[AddRel] Execute commitschema: " & Err.Number & " " & Err.Description
            Exit Function
        End If
    End If

    cn.Close
    Set cn = Nothing 'flush for fastload
    Set rec = Nothing
    Set cmdChange = Nothing

    '// Adding a column to the table is successful
    AddRel = True
End Function

'//-----------------------------------------------------------------------------
'//  Purpose: Add a column (generic query string name) in the 'UriQuery' table.
'//           The routine also add relationship for the new column in
'//           'SVQStringName' and 'LinkSVQStringName'.
'//  Inputs:  sTable -> Name of the table in the data warehouse.
'//           sColumnName -> Name of the column to add.
'//           sColDataType -> Type of the column.
'//           iIsMultiVal -> Field is single (=0) or multi-value (=1).
'//  Returns: True -> If adding the column to the table is successful.
'//           False -> Otherwise (default).
'//-----------------------------------------------------------------------------
Function AddColToTable(sSqlServerName, sTableName, sColumnName, sColDataType, iIsMultiVal)
    On Error Resume Next

    Dim rec
    Dim cn
    Dim cmdChange
    Dim strURL
    
    '// Set AddColToTable to the default value
    AddColToTable = False

    Set rec = CreateObject("ADODB.Record")
    Set cn = CreateObject("ADODB.Connection.2.5")
    Set cmdChange = CreateObject("ADODB.Command.2.5")
    If 0 <> Err.Number Then
        MsgBox "[AddColToTable] An error occured while creating objects: " & Err.Number & " " & Err.Description
        Exit Function
    End If

    ' ----------------------------------
    ' Initial Bind
    ' ----------------------------------
    strURL = "URL=MSCOP://INPROCCONNECT/SERVER=" & sSqlServerName & ":DATABASE=" & sDB_NAME & ":USER=" & sUSER_ID & ":PASSWORD=" & sPWD & ":CATALOG=dwschema:fastload=true:"
    cn.Open strURL
    If 0 <> Err.Number Then
        MsgBox "[AddColToTable] cn.Open: " & Err.Number & " " & Err.Description
        Exit Function
    Else
        ' ----------------------------------
        ' Turn on Schema Change Mode
        ' ----------------------------------
        Set cmdChange.ActiveConnection = cn
        cmdChange.CommandText = "schemamode=1"
        cmdChange.Execute
        
        ' ----------------------------------
        ' Add a new MEMBER
        ' ----------------------------------
        Dim sText
        sText = "MEMBER/UriQuery/" & CStr(sColumnName)
        rec.Open sText, cn, 2, 8192
        
        rec("ClassDefName") = CStr(sTableName)
        rec("MemberDefName") = CStr(sColumnName)
        rec("TypeName") = CStr(sColDataType)
        rec("IsMultiValued") = CInt(iIsMultiVal)
        rec("GenerateColumnDef") = 1
        rec("IsIdentityMember") = 0
        rec("IsPrimaryKey") = 0
        rec("IsJoinKey") = 0
        rec("IsUniqueKey") = 0
        rec("__Commit") = 1
        rec.Fields.Update
        rec.Close
    
        cmdChange.CommandText = "CommitSchema"
        cmdChange.Execute
        cmdChange.CommandText = "schemamode=0"  'change non-updatable mode
        cmdChange.Execute
        If 0 <> Err.Number Then
            MsgBox "[AddColToTable] Execute commitschema: " & Err.Number & " " & Err.Description
            Exit Function
        End If
    End If

    cn.Close
    Set cn = Nothing 'flush for fastload
    Set rec = Nothing
    Set cmdChange = Nothing

    '// Adding a column to the table is successful
    AddColToTable = True
End Function
Modification Type:MajorLast Reviewed:10/22/2002
Keywords:kbinfo KB312507
©2002 Microsoft Corporation. All rights reserved.