home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / vbasic / Data / Utility / sqllog.exe / %MAINDIR% / Sample / Application.cls next >
Encoding:
Visual Basic class definition  |  2002-01-21  |  4.5 KB  |  137 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 3  'UsesTransaction
  8. END
  9. Attribute VB_Name = "Application"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15.  
  16. ' TODO
  17. ' Change these to fit your environment.
  18. ' --> Obviously in the real world these would be pulled from the COM+ constructor string or something similar
  19. Const USERID = "sa"
  20. Const PASSWORD = "sa"
  21. Const INITCATALOG = "Pubs"
  22. Const DATASOURCE = "HELLFIRE"
  23. Const WORKSTATIONID = "HELLFIRE"
  24. Const APPNAME = "SampleMTSDLL"
  25.  
  26. Private Function ConnectionString(ApplicationName As String) As String
  27.     ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
  28.                        "User ID=" & USERID & ";" & _
  29.                        "Password=" & PASSWORD & ";" & _
  30.                        "Initial Catalog=" & INITCATALOG & ";" & _
  31.                        "Data Source=" & DATASOURCE & ";" & _
  32.                        "Use Procedure for Prepare=1;" & _
  33.                        "Auto Translate=True;Packet Size=4096;" & _
  34.                        "Workstation ID=" & WORKSTATIONID & ";" & _
  35.                        "Application Name=" & ApplicationName
  36. End Function
  37.  
  38. Private Sub VerifySP()
  39.     Dim conn As ADODB.Connection
  40.     Dim rs As ADODB.Recordset
  41.     Dim strSQL As String
  42.    
  43.     On Error GoTo ErrorHandler
  44.    
  45.     Set conn = New ADODB.Connection
  46.     Set rs = New ADODB.Recordset
  47.     conn.Open ConnectionString(APPNAME)
  48.  
  49.     '  Create Stored Procedure for Audit Deletes if it does not exist
  50.     strSQL = "select * from sysobjects where id = object_id('SQLLogTestApp')"
  51.     rs.Open strSQL, conn
  52.     If rs.BOF And rs.EOF Then
  53.         strSQL = " "
  54.         strSQL = strSQL & "Create Procedure SQLLogTestApp" & vbCrLf
  55.         strSQL = strSQL & " " & vbCrLf
  56.         strSQL = strSQL & "As" & vbCrLf
  57.         strSQL = strSQL & " " & vbCrLf
  58.         strSQL = strSQL & "INSERT authors" & vbCrLf
  59.         strSQL = strSQL & "VALUES(" & vbCrLf
  60.         strSQL = strSQL & "'999-99-9999'," & vbCrLf
  61.         strSQL = strSQL & "'Test'," & vbCrLf
  62.         strSQL = strSQL & "'SQLLog'," & vbCrLf
  63.         strSQL = strSQL & "'123 456-7890'," & vbCrLf
  64.         strSQL = strSQL & "'123 Main St.'," & vbCrLf
  65.         strSQL = strSQL & "'Disneyland'," & vbCrLf
  66.         strSQL = strSQL & "'CA'," & vbCrLf
  67.         strSQL = strSQL & "'90000'," & vbCrLf
  68.         strSQL = strSQL & "1" & vbCrLf
  69.         strSQL = strSQL & ")" & vbCrLf
  70.         strSQL = strSQL & " " & vbCrLf
  71.         strSQL = strSQL & "UPDATE authors" & vbCrLf
  72.         strSQL = strSQL & "SET phone = '800 555-1212'" & vbCrLf
  73.         strSQL = strSQL & "WHERE au_id = '999-99-9999'" & vbCrLf
  74.         strSQL = strSQL & " " & vbCrLf
  75.         strSQL = strSQL & "DELETE authors" & vbCrLf
  76.         strSQL = strSQL & "WHERE au_id = '999-99-9999'" & vbCrLf
  77.  
  78.         conn.Execute strSQL
  79.     End If
  80.     rs.Close
  81.  
  82.     Set rs = Nothing
  83.     Set conn = Nothing
  84.     
  85.     Exit Sub
  86.     
  87. ErrorHandler:
  88.     Err.Raise Err.Number, Err.souce & ":SampleMTSDLL.VerifySP", Err.Description, Err.HelpFile, Err.HelpContext
  89. End Sub
  90.  
  91. Public Function CallSP() As ADODB.Recordset
  92.     Dim cmd As ADODB.Command
  93.     Dim rs As ADODB.Recordset
  94.     Dim conn As ADODB.Connection
  95.     Dim obj As ObjectContext
  96.     Dim strAppName As String
  97.     
  98.     On Error GoTo ErrorHandler
  99.     
  100.     ' since this is a test, this just makes sure that the test SP exists
  101.     Call VerifySP
  102.     
  103.     Set cmd = New ADODB.Command
  104.     Set conn = New ADODB.Connection
  105.     
  106.     Set obj = GetObjectContext()
  107.     
  108.     ' if we are in MTS/COM+, get the *real* user
  109.     If Not (obj Is Nothing) Then
  110.         strAppName = APPNAME & " <<" & obj.Security.GetDirectCallerName & ">>"
  111.     Else
  112.         strAppName = APPNAME & " <<" & UCase$(Environ("USERDOMAIN")) & "\" & UCase$(Environ("USERNAME")) & ">>"
  113.     End If
  114.     
  115.     conn.ConnectionString = ConnectionString(strAppName)
  116.     
  117.     Set rs = New ADODB.Recordset
  118.     
  119.     conn.Open
  120.     
  121.     Set CallSP = conn.Execute("SQLLogTestApp")
  122.     
  123.     If Not (obj Is Nothing) Then
  124.         obj.SetComplete
  125.     End If
  126.     
  127.     Exit Function
  128.     
  129. ErrorHandler:
  130.     ' NOTE: The Err.Raise will fail in COM+ 1.0.  This is documented in the MS KB.
  131.     ' I stongly recommend applying the hotfix or Win2k SP1.
  132.     obj.SetAbort
  133.     Err.Raise Err.Number, Err.souce & ":CallSP", Err.Description, Err.HelpFile, Err.HelpContext
  134. End Function
  135.  
  136.  
  137.