home *** CD-ROM | disk | FTP | other *** search
Visual Basic class definition | 2002-01-21 | 4.5 KB | 137 lines |
- 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
-
-
-