トランザクション ラッパーのサンプル

制約事項: 本トピックは、Windows 環境 (ローカル開発) にのみ該当します。

次に、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.