次に、OCX ウィザードで生成されたトランザクション ラッパーの例を示します。このトランザクション ラッパーは、MS SQL Server データソースを使用して次のシナリオを処理する OpenESQL ロジックを含めるために変更されています。
$set ooctrl(+p) sql(thread=isolate autocommit)
*>-----------------------------------------------------------
*> Class description
*>-----------------------------------------------------------
class-id. cblsqlwrapper
inherits from olebase.
object section.
class-control.
cblsqlwrapper is class "cblsqlwrapper"
*> OCWIZARD - start list of classes
objectcontext is class "objectcontext"
olebase is class "olebase"
oleSafeArray is class "olesafea"
oleVariant is class "olevar"
*> OCWIZARD - end list of classes
*>---USER-CODE. Add any additional class names below.
*>-----------------------------------------------------------
working-storage section. *> Definition of global data
*>-----------------------------------------------------------
*>-----------------------------------------------------------
class-object. *> Definition of class data and methods
*>-----------------------------------------------------------
object-storage section.
*> OCWIZARD - start standard class methods
*>-----------------------------------------------------------
*> Return details about the class.
*> If you have a type library, theClassId and theInterfaceId
*> here MUST match.
*> theProgId must match the registry entry for this class
*> (a zero length string implies using the class file name)
*> theClassId must match the CLSID stored in the registry.
*> theVersion is currently ignored (default 1 used).
*>-----------------------------------------------------------
method-id. queryClassInfo.
linkage section.
01 theProgId pic x(256).
01 theClassId pic x(39).
01 theInterfceId pic x(39).
01 theVersion pic x(4) comp-5.
01 theDescription pic x(256).
01 theThreadModel pic x(20).
procedure division using by reference theProgId
by reference theClassId
by reference theInterfceId
by reference theVersion
by reference theDescription
by reference theThreadModel.
move z"{3EADD92C-06C5-46F2-A2E0-7EB0794C14DF}"
to theClassId
move z"{5BF3F966-9932-4835-BFF6-2582CA2592AD}"
to theInterfceId
move z"Description for class cblsqlwrapper"
to theDescription
move z"Apartment" to theThreadModel
exit method.
end method queryClassInfo.
.
*>-----------------------------------------------------------
*> Return details about the type library - delete if unused.
*> theLocale is currently ignored (default 0 used).
*> theLibraryName is a null terminated string used for auto
*> registration, and supports the following values:
*> <no string> - Library is embedded in this binary
*> <number> - As above, with this resource number
*> <Path> - Library is at this (full path)
*> location
*>-----------------------------------------------------------
method-id. queryLibraryInfo.
linkage section.
01 theLibraryName pic x(512).
01 theMajorVersion pic x(4) comp-5.
01 theMinorVersion pic x(4) comp-5.
01 theLibraryId pic x(39).
01 theLocale pic x(4) comp-5.
procedure division using by reference theLibraryName
by reference theMajorVersion
by reference theMinorVersion
by reference theLibraryId
by reference theLocale.
move 1 to theMajorVersion
move 0 to theMinorVersion
move z"{24207F46-7136-4285-A660-4594F5EE7B87}"
to theLibraryId
exit method.
end method queryLibraryInfo.
*>-----------------------------------------------------------
*> OCWIZARD - end standard class methods
end class-object.
*>-----------------------------------------------------------
object. *> Definition of instance data and methods
*>-----------------------------------------------------------
object-storage section.
*> OCWIZARD - start standard instance methods
*> OCWIZARD - end standard instance methods
*>-----------------------------------------------------------
method-id. "RetrieveString".
working-storage section.
01 mfsqlmessagetext pic x(400).
01 ESQLAction pic x(100).
COPY DFHEIBLK.
COPY SQLCA.
*>...your transaction program name
01 transactionPgm PIC X(7) VALUE 'mytran'.
local-storage Section.
01 theContext object reference.
01 transactionStatusFlag pic 9.
88 transactionPassed value 1.
88 transactionFailed value 0.
*>---USER-CODE. Add any local storage items needed below.
01 ReturnValue pic x(4) comp-5.
88 IsNotInTransaction value 0.
01 transactionControlFlag pic 9.
88 TxnControlledByMTS value 0.
88 TxnNotControlledByMTS value 1.
linkage Section.
*>...Info passed to transaction
01 transaction-Info.
05 transaction-Info-RC pic 9.
05 transaction-Info-data pic x(100).
*>...Info returned from transaction via
01 transaction-Info-Returned pic x(100).
procedure division using by reference transaction-Info
returning transaction-Info-Returned.
*>...initialisation code
perform A-Initialise
perform B-ConnectToDB
if TxnNotControlledByMTS
perform C-SetAutoCommitOff
end-if
*>...set isolation level to override SQLServer default,
*>...serialize
perform D-ResetDefaultIsolationLevel
*>...set cursor type to overrde the OpenESQL default,
*>...dynamic+lock
perform E-ResetDefaultCursorType
*>...call the transaction
perform F-CallTransaction
*>...finalisation code - issue Commit/Rollback if not
*>...controlled by MTS/COM+
if TxnNotControlledByMTS
if transactionPassed
perform X-Commit
else
perform X-Rollback
end-if
end-if
perform Y-Disconnect
*>...Transaction Server - use setAbort if the method fails:
if theContext not = null
if transactionPassed
invoke theContext "setComplete"
else
invoke theContext "setAbort"
end-if
invoke theContext "finalize" returning theContext
end-if
exit method
.
A-Initialise.
*>...Transaction Server - get the context we are running in
invoke objectcontext "GetObjectContext"
returning theContext
*>...check if this component is enlisted in an MTS transation
if theContext = null
set TxnNotControlledByMTS to true
else
invoke theContext "IsInTransaction"
returning ReturnValue
if IsNotInTransaction
set TxnNotControlledByMTS to true
else
set TxnControlledByMTS to true
end-if
end-if
*>...initialise program variables
set transactionPassed to true
INITIALIZE DFHEIBLK
.
B-ConnectToDB.
*>...connect to data source
EXEC SQL
CONNECT TO 'SQLServer 2000' USER 'SA'
END-EXEC
if sqlcode zero
move z"connection failed " to ESQLAction
perform Z-ReportSQLErrorAndExit
end-if
.
C-SetAutoCommitOff.
EXEC SQL
SET AUTOCOMMIT OFF
END-EXEC
if sqlcode zero
move z"Set Autocommit Off failed " to ESQLAction
perform Z-ReportSQLErrorAndExit
end-if
perform X-Commit
.
D-ResetDefaultIsolationLevel.
*> the default isolation level for SQLServer is "Serialized",
*> so here we reset it to something more appropriate
EXEC SQL
SET TRANSACTION ISOLATION READ COMMITTED
END-EXEC
if sqlcode zero
move z"set transaction isoation failed "
to ESQLAction
perform Z-ReportSQLErrorAndExit
end-if
.
E-ResetDefaultCursorType.
*> the default cursor type for OpenESQL is dynamic + lock
*> the most efficient is a "client" or "firehose" cursor -
*> this is a cursor declared as forward + read only - doing
*> this here will set it as a default from now on. If
*> Forward causes a problem, change the concurrency to fast
*> forward (but note that it will then no longer be a client
*> cursor)
EXEC SQL
SET CONCURRENCY READ ONLY
END-EXEC
if sqlcode zero
move z"Set Concurrency Read Only" to ESQLAction
perform Z-ReportSQLErrorAndExit
end-if
EXEC SQL
SET SCROLLOPTION FORWARD
END-EXEC
if sqlcode zero
move z"Set Concurrancy Read Only" to ESQLAction
perform Z-ReportSQLErrorAndExit
end-if
.
F-CallTransaction.
*>...call the program to process the transaction
move 0 to transaction-Info-RC
call tranactionPgm using dfheiblk transaction-Info
*>...check if processing was okay
if transaction-Info-RC = 0
set transactionPassed to true
else
set transactionFailed to true
end-if
.
X-Commit.
EXEC SQL
COMMIT
END-EXEC
if sqlcode zero
move z"Commit failed " to ESQLAction
perform Z-ReportSQLErrorAndExit
end-if
.
X-Rollback.
EXEC SQL
ROLLBACK
END-EXEC
if sqlcode zero
move z"Rollback failed " to ESQLAction
perform Z-ReportSQLErrorAndExit
end-if
.
Y-Disconnect.
EXEC SQL
DISCONNECT CURRENT
END-EXEC
if sqlcode zero
move z"Disconnect failed " to ESQLAction
perform Z-ReportSQLErrorAndExit
end-if
.
Z-ReportSQLErrorAndExit.
move spaces to transaction-Info-Returned
string ESQLAction delimited by x"00"
"SQLSTATE = "
SQLSTATE
" "
mfsqlmessagetext
into transaction-Info-Returned
end-string
exit method
.
exit method.
end method "RetrieveString".
*>-----------------------------------------------------------
end object.
end class cblsqlwrapper.