用VB6创建MTS组件
2024-07-21 02:15:41
供稿：网友
'随便贴贴，学过vb的人都应该知道的，不好意思。
'**********************************************************************************************
' mts vb6 com component template - by michael gonzalez
'**********************************************************************************************
'(1) you must create a reference to the microsoft transaction server type library (mtxas.dll).
' if using windows 2000, choose the com+ services library (comsvcs.dll) instead.
'(2) set your classmodule's mtstransactionmode property to 2 - requirestransaction
' note: only use 2 - requires transaction if you plan on using the component with an msdtc-
' compliant resource manager such as msmq or sql server - otherwise, use
' 1 - no transactions
'(3) make sure your project's unattended execution property is checked
'(4) make sure your project's component version compatibility is set to binary compatibility
'**********************************************************************************************
' objectcontrol implements the interface that is used by mts when the object is
' activated and/or deactivated - this happens when you call one of the components's methods
' the objectcontrol implementation makes use of three procedures:
' 1) objectcontrol_activate
' 2) objectcontrol_canbepooled
' 3) objectcontrol_deactivate
'**********************************************************************************************
implements objectcontrol
dim objoc as objectcontext
public sub something()
'this is a user-defined procedure/method
'the objectcontext object is returned by getobjectcontext
on error goto abort
'*******************************************************
' perform whatever you want in this area
' visual basic 6 stuff goes here
' the something() procedure/method is just
' an example - you may use properties and other
' methods/procedures as well!
'*******************************************************
finished:
objoc.setcomplete
exit sub
abort:
objoc.setabort
err.raise err.number, err.source, err.description
exit sub
end sub
private sub objectcontrol_activate()
'mts invokes this procedure/method when the component/object is instantiated
set objoc = getobjectcontext()
exit sub
end sub
private function objectcontrol_canbepooled() as boolean
'this enables mts object pooling (not currently supported my mts 2.0)
objectcontrol_canbepooled = true
end function
private sub objectcontrol_deactivate()
'mts invokes this procedure/method right before the component/object is released
set objoc = nothing
exit sub
end sub
