VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 3  'UsesTransaction
END
Attribute VB_Name = "Application"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

' TODO
' Change these to fit your environment.
' --> Obviously in the real world these would be pulled from the COM+ constructor string or something similar
Const USERID = "sa"
Const PASSWORD = "sa"
Const INITCATALOG = "Pubs"
Const DATASOURCE = "HELLFIRE"
Const WORKSTATIONID = "HELLFIRE"
Const APPNAME = "SampleMTSDLL"

Private Function ConnectionString(ApplicationName As String) As String
    ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                       "User ID=" & USERID & ";" & _
                       "Password=" & PASSWORD & ";" & _
                       "Initial Catalog=" & INITCATALOG & ";" & _
                       "Data Source=" & DATASOURCE & ";" & _
                       "Use Procedure for Prepare=1;" & _
                       "Auto Translate=True;Packet Size=4096;" & _
                       "Workstation ID=" & WORKSTATIONID & ";" & _
                       "Application Name=" & ApplicationName
End Function

Private Sub VerifySP()
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strSQL As String
   
    On Error GoTo ErrorHandler
   
    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    conn.Open ConnectionString(APPNAME)
 
    '  Create Stored Procedure for Audit Deletes if it does not exist
    strSQL = "select * from sysobjects where id = object_id('SQLLogTestApp')"
    rs.Open strSQL, conn
    If rs.BOF And rs.EOF Then
        strSQL = " "
        strSQL = strSQL & "Create Procedure SQLLogTestApp" & vbCrLf
        strSQL = strSQL & " " & vbCrLf
        strSQL = strSQL & "As" & vbCrLf
        strSQL = strSQL & " " & vbCrLf
        strSQL = strSQL & "INSERT authors" & vbCrLf
        strSQL = strSQL & "VALUES(" & vbCrLf
        strSQL = strSQL & "'999-99-9999'," & vbCrLf
        strSQL = strSQL & "'Test'," & vbCrLf
        strSQL = strSQL & "'SQLLog'," & vbCrLf
        strSQL = strSQL & "'123 456-7890'," & vbCrLf
        strSQL = strSQL & "'123 Main St.'," & vbCrLf
        strSQL = strSQL & "'Disneyland'," & vbCrLf
        strSQL = strSQL & "'CA'," & vbCrLf
        strSQL = strSQL & "'90000'," & vbCrLf
        strSQL = strSQL & "1" & vbCrLf
        strSQL = strSQL & ")" & vbCrLf
        strSQL = strSQL & " " & vbCrLf
        strSQL = strSQL & "UPDATE authors" & vbCrLf
        strSQL = strSQL & "SET phone = '800 555-1212'" & vbCrLf
        strSQL = strSQL & "WHERE au_id = '999-99-9999'" & vbCrLf
        strSQL = strSQL & " " & vbCrLf
        strSQL = strSQL & "DELETE authors" & vbCrLf
        strSQL = strSQL & "WHERE au_id = '999-99-9999'" & vbCrLf
 
        conn.Execute strSQL
    End If
    rs.Close

    Set rs = Nothing
    Set conn = Nothing
    
    Exit Sub
    
ErrorHandler:
    Err.Raise Err.Number, Err.souce & ":SampleMTSDLL.VerifySP", Err.Description, Err.HelpFile, Err.HelpContext
End Sub

Public Function CallSP() As ADODB.Recordset
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim conn As ADODB.Connection
    Dim obj As ObjectContext
    Dim strAppName As String
    
    On Error GoTo ErrorHandler
    
    ' since this is a test, this just makes sure that the test SP exists
    Call VerifySP
    
    Set cmd = New ADODB.Command
    Set conn = New ADODB.Connection
    
    Set obj = GetObjectContext()
    
    ' if we are in MTS/COM+, get the *real* user
    If Not (obj Is Nothing) Then
        strAppName = APPNAME & " <<" & obj.Security.GetDirectCallerName & ">>"
    Else
        strAppName = APPNAME & " <<" & UCase$(Environ("USERDOMAIN")) & "\" & UCase$(Environ("USERNAME")) & ">>"
    End If
    
    conn.ConnectionString = ConnectionString(strAppName)
    
    Set rs = New ADODB.Recordset
    
    conn.Open
    
    Set CallSP = conn.Execute("SQLLogTestApp")
    
    If Not (obj Is Nothing) Then
        obj.SetComplete
    End If
    
    Exit Function
    
ErrorHandler:
    ' NOTE: The Err.Raise will fail in COM+ 1.0.  This is documented in the MS KB.
    ' I stongly recommend applying the hotfix or Win2k SP1.
    obj.SetAbort
    Err.Raise Err.Number, Err.souce & ":CallSP", Err.Description, Err.HelpFile, Err.HelpContext
End Function


