Problem:
Method to trap COM Errors without the black console box popping up
Resolution:
Code/logic a registered COM Exception Handler:
The exception handler does not automatically terminate but allows users to determine the best action. In many cases this would be to terminate (ie STOP RUN). However, users can decide on the correct course of action for themselves.
An Example of this is:-
$set ooctrl( P)
program-id. ADSIDemo.
******************************************************************
*
* Author - David Sands (Micro Focus Technical Support)
*
* Date - December 2003
*
* Purpose - Show how to call WINHTTP
*
******************************************************************
special-names.
call-convention 74 is winapi. *> Litlinked apis
class-control.
*> OLE automation classes
WinHTTP is class "$OLE$WinHttp.WinHttpRequest.5.1"
OLEVariant is class "olevar"
* WinHttpRequest"
OLEDUMMY is class "$OLE$OLEDUMMY"
OleMoniker is class "olemon"
olesup is class "olesup"
exceptMgr is class "exptnmgr"
oleExceptMgr is class "oleexpt"
entrycallback is class "entrycll"
.
working-storage section.
copy "mfole.cpy".
copy "WinHTTP.cpy".
01 ws-winhttp object reference.
01 ws-booltrue object reference.
01 ws-boolfalse object reference.
01 ws-addr pointer.
01 ws-vType PIC 9(4) COMP-5.
01 ws-text pic x(1000).
01 osException object reference.
01 wsIterator object reference.
01 ws-error-flag pic x.
88 no-error-in-com value "1".
88 error-in-com value "2".
local-storage section.
linkage section.
01 lnkErrorNumber pic x(4) comp-5.
01 lnkErrorObject object reference.
01 lnkErrorText object reference.
01 lnkElement object reference.
01 lnk-variant variant.
procedure division.
start-it section.
set no-error-in-com to true
***** Set up the OLE Exception Handler
invoke entrycallback "new" using z"onOleException"
returning osException
invoke exceptmgr "register" using oleExceptMgr
osException
***** Create Boolean Variants
move VT-BOOL to ws-vType
invoke OLEVariant "newwithtype" using ws-vType
returning ws-boolfalse
invoke OLEVariant "newwithtype" using ws-vType
returning ws-booltrue
invoke ws-boolfalse "getVariantAddress" returning ws-addr
set address of lnk-variant to ws-addr
move 0 to variant-vt-bool of lnk-variant
invoke ws-booltrue "getVariantAddress" returning ws-addr
set address of lnk-variant to ws-addr
move 1 to variant-vt-bool of lnk-variant
***** Need to create the OLE Domain Object
invoke WinHTTP "new" returning ws-winhttp
if error-in-com
display "Need to Handle Error !!!"
stop run
end-if
***** Do the work
invoke ws-winhttp "Open" using z"GET"
z"http://www.microfocusXXX.com"
ws-boolfalse
if error-in-com
display "Need to Handle Error !!! - " ws-text(1:80)
stop run
end-if
invoke ws-winhttp "Send"
if error-in-com
display "Need to Handle Error !!! - " ws-text(1:80)
stop run
end-if
invoke ws-winhttp "getResponseText" returning ws-text
if error-in-com
display "Need to Handle Error !!! - " ws-text(1:80)
stop run
end-if
display "Received :-"
display ws-text
***** Cleanup
invoke ws-winhttp "finalize" returning ws-winhttp
if error-in-com
display "Need to Handle Error !!! - " ws-text(1:80)
stop run
end-if
invoke ws-booltrue "finalize" returning ws-booltrue
invoke ws-boolfalse "finalize" returning ws-boolfalse
stop run.
callback section.
entry "onOleException" using by reference lnkErrorObject
by reference lnkErrorNumber
by reference lnkErrorText.
display "OLE Exception:-"
display "The COBOL exception number was: " lnkErrorNumber
display "The exception occured on:"
invoke lnkErrorObject "display"
invoke EntryCallback "new" using z"DispError"
returning wsIterator
invoke lnkErrorText "do" using wsIterator
********* display "Terminating.."
********* stop run
set error-in-com to true
exit program.
entry "DispError" using lnkElement.
display " " with no advancing *> Indent Slightly
invoke lnkElement "display"
move spaces to ws-text
invoke lnkElement "getValue" returning ws-text
display " "
goback
#netexpress
#RMCOBOL
#ServerExpress
#COBOL
#AcuCobol
