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

' ========================================
' TransDemo (Transaktion Demonstration unter MTS oder COM+)
' Autor: Holger Schwichtenberg (hs@it-visions.de)
' Teil 1: COM-InProc-Server
' Version: 1.0
' Stand: 17.12.1999
' ========================================

Const connString = "Driver={SQL Server};" & _
"Server=uranus;" & _
"Database=x;" & _
"Uid=x;" & _
"Pwd=x;"

Dim rs As Recordset
Dim com As Command

Public Sub DoComplete()
Dim objContext As ObjectContext
Set objContext = GetObjectContext()
objContext.SetComplete
End Sub

Public Sub DoAbort()
Dim objContext As ObjectContext
Set objContext = GetObjectContext()
objContext.SetAbort
End Sub
Public Sub doclean()
' 1. Aktion: Tabelle löschen
com.ActiveConnection = connString
com.CommandText = "delete from Bestellungen"
com.Execute

End Sub
Public Sub dosomething()
Dim sql As String
nochmal:
On Error GoTo fehler:
' 2. Aktion: etwas einfügen
sql = "SELECT * FROM Bestellungen "
rs.Open sql, connString, adOpenDynamic, adLockOptimistic
rs.AddNew
rs("KundenID") = Int(Rnd() * 2000)
rs("PID") = Int(Rnd() * 50)
rs("Menge") = Int(Rnd() * 10)
rs.Update
rs.Close
Exit Sub
fehler:
rs.Close
GoTo nochmal
End Sub

Public Function Liste() As Recordset
Dim sql As String
sql = "SELECT * FROM Bestellungen "
rs.Open sql, connString, adOpenDynamic, adLockReadOnly
Set Liste = rs
End Function

Private Sub Class_Initialize()
Set rs = CreateObject("ADODB.RecordSet")
Set com = CreateObject("ADODB.Command")
End Sub