Article ID: 191235
Article Last Modified on 7/15/2004
186342 : How To Create a Simple 3-Tier App Using VB, MTS, and SQL Server
Option Explicit
Public Function GetSPM(ByVal szGroup As String, _
ByVal szProperty As String) _
As String
On Error GoTo ErrHandler
Dim ctxObject As ObjectContext
Dim spmMgr As SharedPropertyGroupManager
Dim spmGroup As SharedPropertyGroup
Dim spmProp As SharedProperty
Dim bGroupExists As Boolean
Dim bPropExists As Boolean
Set ctxObject = GetObjectContext()
Set spmMgr = CreateObject _
("MTxSpm.SharedPropertyGroupManager.1")
'OPTIONS
'-------------------------------------------------
'LockSetGet (0) = Locks the particular property
' while it is being set
'LockMethod (1) = Locks all of the properties
' in the property group
' until the method is complete
'
'Standard (0) = Destroys property when all
' clients have released there reference
'Process (1) = The property group is not destroyed
' until the process in which it lives
' is terminated.
'
'NOTE: If debugging these from within the VB 5.0 IDE
'then you will need to use LockSetGet. LockMethod
'requires that the object have an ObjectContext
'-------------------------------------------------
'Set spmGroup = spmMgr.CreatePropertyGroup _
(Trim(szGroup), LockSetGet, Process, bGroupExists)
Set spmGroup = spmMgr.CreatePropertyGroup _
(Trim(szGroup), LockMethod, Process, bGroupExists)
Set spmProp = spmGroup.CreateProperty _
(Trim(szProperty), bPropExists)
If bPropExists = False Then
GetSPM = "Property Does Not Exist"
Else
GetSPM = spmProp.Value
End If
ctxObject.SetComplete
Exit Function
ErrHandler:
If Not ctxObject Is Nothing Then
ctxObject.SetAbort
End If
GetSPM = "Error Occurred"
Err.Raise Err.Number, "", Err.Description, ""
Exit Function
End Function
Public Sub SetSPM(ByVal szGroup As String, _
ByVal szProperty As String, _
ByVal szValue As String)
On Error GoTo ErrHandler
Dim ctxObject As ObjectContext
Dim spmMgr As SharedPropertyGroupManager
Dim spmGroup As SharedPropertyGroup
Dim spmProp As SharedProperty
Dim groupExists As Boolean
Dim propExists As Boolean
Set ctxObject = GetObjectContext()
'Create an instance of the SPM. Retrieve the
'group and property and then set the value
'-------------------------------------------------
Set spmMgr = CreateObject _
("MTxSpm.SharedPropertyGroupManager.1")
Set spmGroup = spmMgr.CreatePropertyGroup _
(Trim(szGroup), LockSetGet, Process, groupExists)
'Set spmGroup = spmMgr.CreatePropertyGroup _
(Trim(szGroup), LockMethod, Process, groupExists)
Set spmProp = spmGroup.CreateProperty _
(Trim(szProperty), propExists)
spmProp.Value = szValue
ctxObject.SetComplete
Exit Sub
ErrHandler:
If Not ctxObject Is Nothing Then
ctxObject.SetAbort
End If
Err.Raise Err.Number, "", Err.Description, ""
Exit Sub
End Sub
Private Sub Command1_Click()
Dim obj As Object
Dim szGroup As String
Dim szProperty As String
Dim szValue As String
szValue = Trim(Text1.Text)
szGroup = "TestGroup"
szProperty = "TestProperty"
Set obj = CreateObject("SPMSample.Class1")
obj.SetSPM szGroup, szProperty, szValue
Set obj = Nothing
End Sub
Private Sub Command2_Click()
Dim obj As Object
Dim szGroup As String
Dim szProperty As String
Dim szValue As String
szValue = Trim(Text1.Text)
szGroup = "TestGroup"
szProperty = "TestProperty"
Set obj = CreateObject("SPMSample.Class1")
Label1.Caption = obj.GetSPM(szGroup, szProperty)
Set obj = Nothing
End Sub
Private Sub Form_Load()
Command1.Caption = "Set SPM Value"
Command2.Caption = "Retrieve SPM Value"
End Sub
186342 : How To Create a Simple 3-Tier App Using VB, MTS, and SQL Server
Additional query words: SPM kbMTS kbVBp500 kbVBp600 kbdse kbDSupport kbVBp kbActiveX
Keywords: kbhowto KB191235