WinBatch Tech Support Home

Database Search

If you can't find the information using the categories below, post a question over in our WinBatch Tech Support Forum.

TechHome

Tutorials
OLE TUTORIAL

Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.

WINBATCH OLE PROGRAMMING - Part 1

by Stan Littlefield

ObjectCreate() What is Out There

Important: The concepts and code presented assume a basic understanding by the reader of terms such as "automation", "COM", "ActiveX" and "Objects". Rather the aim is to provide a foundation and extensive examples to assist in answering this question: "Can I use Winbatch to accomplish a certain programming objective rather than another language such as VB, C/C++ or Java?" In practical terms the question may be re-stated: 

	Can I insert or retrieve data from Microsoft Excel?
	Can I perform database management with Winbatch?
	Can I directly interface with a browser or PDF documents?
The example code in this article is written using the most recent version (2004F, or later). The Winbatch BBS and Tech Data Base can assist with specific OLE issues (as well as programming Winbatch in general).

A specific answer to "Can I use Winbatch to accomplish…" has a minimal requirement as a single line of code: 

ObjectCreate( someObject )
Note: Winbatch allows ObjectOpen(), ObjectCreate(), ObjectGet() and GetObject() to accomplish the same goal and keep compatibility with earlier versions, but the code samples will most likely use ObjectCreate(). The someObject in this case refers to something registered on the PC your are running the script from which will accept subsequent directions from the script rather than being run separately (without the script ). If your script can execute this line of code without error, then there is a high probability your question will be answered affirmatively. 
oXL = ObjectCreate( "Excel.Application" )
although not the same as double-clicking on the Excel Icon in the program menu creates an 'instance' of Excel tied to the Winbatch variable oXL which allows the Winbatch script to perform operations with Excel as though they were being typed in directly. If the ObjectCreate() function is successful oXL will contain a Long numeric value greater than 0. If at a later point in the script the line 
	oXL = 0
appears then the object reference is destroyed or no longer valid within the script. You will see in the next section that removing the reference is not the same as removing the object.

A quick note on Object Variables: There is a style of program coding referred to as "Hungarian Notation". In its fullest form it sets formal rules for declaring variables of specific types when writing program code. The examples and variable references included here will often employ a 'modified' Hungarian notation - viz. a variable will be declared with a small-letter prefix to indicate the type of variable: 

	oVAR = type 'object'
	cVAR = type 'char or string/file names'
	nVAR = type 'numeric'
	dVAR = type 'date/timestamp'
	lVAR  = type 'logical'
	mVAR = type 'memo'
	bVAR = type 'binary/BLOB'
Exceptions will be all 'Constants' used as part of the Object Model, i.e. Excel constants start with 'xl' ADO constants with 'ad'. As the purpose of Hungarian Notation was to make another's code more understandable, I hope to do the same with modified Hungarian.

In order for ObjectCreate() to execute successfully, there must be a registry entry for Excel.Application. Of course, you probably know this if you are writing a script on your own system to manipulate Excel from within Winbatch. If you are writing a script which will be compiled and distributed, you might want to consider a handy UDF like 

#DefineFunction isInReg(cProg)
Return( RegExistKey(@RegClasses,cProg) )
#EndFunction
Then code your main script : If ! isInReg("Excel.Application") Then Goto outahere which allows exiting the script gracefully.

When "Excel.Application" is found in the registry, it is associated with a sub-key named ProgID. The ProgID is linked to a unique CLSID (Class ID, in the format of a GUID - the one for Excel is {00024500-0000-0000-C000-000000000046}). Of course, we all learn from experience that the registry can be replete with invalid keys and sub-keys, i.e. a ProgID that refers to an application that no longer exists, is corrupt, or perhaps inactive. This brings us to our main topic - what is out there? What follows is a script which will probe a PC, returning all ProgID's and CLSID's with an option to test any out as to how each would respond to ObjectCreate(). 

;Main portion of script
IntControl(73,1,0,0,0) ;set error handler
oType = 0
oObj  = 0
BoxOpen("Enumerating ActiveX ProgID's","")
;these two files are created
cFile = StrCat(dirScript(),"progids.txt")
cID =  StrCat(dirScript(),"progids.dat")

;if the .dat file already exists, go to
;the part of the script to test ObjectCreate()
If FileExist(cID)
   sProgs = FileGet(cID)
   goto check
Endif
cStr = ""
hKey = RegOpenKey(@REGCLASSES, "CLSID")
sCLSIDList = RegQueryKeys(hKey)
RegCloseKey(hKey)
iCount = ItemCount(sCLSIDList,@TAB)
sProgs = ""
For i=1 To iCount
   sCLSID = ItemExtract(i,sCLSIDList,@TAB)
   sProgID = udfProgIDFromsCLSID (sCLSID)
   If (sProgID == "") Then Continue
   BoxText(sProgID)
   sProgs = StrCat(sProgs,sProgID,@TAB)
   cStr = StrCat(cStr,sProgID,",",sCLSID,@CRLF)
Next
FilePut(cFile,cStr)
FilePut(cID,sProgs)
BoxShut()

:check
cWsc = StrCat(dirScript(),"tn.wsc")
If ! FileExist(cWsc)
   CrTn(cWsc)
Endif
oWsc = StrCat("script:",cWsc)
oType = ObjectGet(oWsc) 

While 1
   sProg = AskItemList("Test TypeName For Selected Object", sProgs, @TAB, @sorted, @single)
   Message("Object Type",gtype(sProg))
EndWhile

:end
oType=0
Exit
The full script, including error-handling is included in the source code section. One of the files written out is merely a Tab-delimited list of the ProgID's which is displayed with an AskItemList()

From the above list. It looks as though Microsoft Access and Adobe Acrobat (full version) are both present on the computer and ready to be manipulated by a Winbatch Script. An interesting facet of Microsoft Objects is that they tend to be 'dummied down' - ObjectOpen("Access.Application") will work the same as ObjectOpen("Access.Application.10"). Were you to highlight Access.Application.10 and click Ok, you would see

The TypeName for the value returned by ObjectCreate() is derived from a special function call to an external (W)indows (S)cripting (C)omponent [.wsc] file. That file is created with 

#DefineFunction CrTn(cWsc)
IntControl(73,1,0,0,0)
If FileExist(cWsc) Then Return(0)
var = StrCat('<?xml version="1.0"?>',@CRLF,"<component>",@CRLF,'<?component error="true" debug="true"?>',@CRLF)
var = StrCat(var,'<registration',@CRLF,'description="Tn"',@CRLF,'progid="Tn.WSC"',@CRLF,'version="1.00"',@CRLF)
var = StrCat(var,'	classid="{9a3ef45a-5375-4e14-833f-a8793ab9e519}"',@CRLF,'>',@CRLF,'</registration>',@CRLF)
var = StrCat(var,'<public>',@CRLF,'<method name="GetTn">',@CRLF,'<PARAMETER name="var"/>',@CRLF,'</method>',@CRLF,'</public>',@CRLF)
var = StrCat(var,'<implements type="Behavior" id="Behavior"/>',@CRLF)
var = StrCat(var,'<script language="VBScript">',@CRLF,'<![CDATA[',@CRLF,'function GetTn(var)',@CRLF,'	GetTn = TypeName(var)',@CRLF,'end function',@CRLF)
var = StrCat(var,']]>',@CRLF,'</script>',@CRLF,'</component>',@CRLF)
FilePut(cWsc,var)
:WBERRORHANDLER
IntControl(73,1,0,0,0)
ErrorProcessing(1,1,0)
Exit
#EndFunction
Essentially, a .wsc file acts like a compiled component and supports both VBScript and Jscript. Using ObjectGet() rather than ObjectCreate() allows you to call all of the functions in the file without having to register it. Since the .wsc is a file that can be created with any editor (Notepad, or Winbatch Studio) it offers enormous extensibility to your OLE scripts on occasions when there are not comparable Winbatch functions. As of 2004 Winbatch has two functions 
ObjectType( [variable_name] )   - used for data types, and

VarType( [variable_Name] ).
VarType( oXL ) would return a numeric value indicating that oXL was a COM/OLE Object, but that may not be as descriptive as you need when handling errors. For example, assuming you had an Excel file with 7 worksheets and two charts as separate 'tabs'. In your code you want to loop through all worksheet objects and print everything but the charts - however, all sheet objects would return the same VarType, but the TypeNames() would be "WORKSHEET" or "CHART" respectively. The section on MDAC will provide another interesting use for the TypeName.

If you do not wish the TypeName() functionality, comment this part of the main script 

cWsc = StrCat(dirScript(),"tn.wsc")
If ! FileExist(cWsc)
   CrTn(cWsc)
Endif
oWsc = StrCat("script:",cWsc)
oType = ObjectGet(oWsc)

and eliminate calls to this UDS

#DefineSubRoutine gtype(sProgID) 
IntControl(73,1,0,0,0)
oObj=0
oObj = ObjectCreate(sProgID)
If oObj==0 Then Return("Cannot Determine")
t = oType.GetTn(oObj)
oObj=0
Return (t)
:WBERRORHANDLER
IntControl(73,1,0,0,0)
oObj=0
Return(wberrortextstring)
#EndSubRoutine
Of course, not all attempts at ObjectCreate() will succeed, and the return value may look like

which means that for whatever reason ObjectCreate() will not work with that ProgID. [See complete script in the SourceCode below]

You are encouraged to run this script, then modify it to suit your own purposes. For example, you might want to probe multiple computers on a client site and obtain the degree of support they provide for working with Microsoft Access Tables.

In part 2, we will examine several automation and database objects through several useful scripts. As promised, a script to obtain references to valuable Winbatch archives. Note: the script is set to convert the document to PDF if it finds Acrobat installed. If you have Acrobat, but don't desire the conversion change the line lAcro=@TRUE to lAcro=@FALSE - [see SourceCode below].

And on the subject of Error Handling:
Often ObjectCreate() can reference a entity such as an ADO Connection which has it's own built in Error Object. It is possible to handle errors in these entities exclusively with Winbatch's :WBERRORHANDLER since it includes a wberroradditionalinfo constant which renders information equal to what the Object's own handler would tell you. I would recommend pre-initializing a ObjectCreate() variable to 0. [more on this in Part 3] 

oConn = 0
oConn = ObjectCreate("ADODB.Connection")
….. your main code here

:WBERRORHANDLER
; your first concern is the status of DB
If oConn = 0
   Exit
Else
; determine what you need to know about DB in order to continue or Quit
Endif
If you plan to be using Winbatch to work with databases such as Microsoft Access then you might want to look at the script Part1: Error Handling. While not a solution to database errors, it does permit you to create a realistic situation where a recoverable error might arise.

SOURCE CODE

Script to enumerate ProgIDS and CSLID's
; Winbatch - List ProgID's and CSLID 
;            and optionally test with ObjectGet
;
; Stan Littlefield
;
;////////////////////////////////////////////////
#DefineSubroutine ErrorProcessing(deleteIni,showerr,logfile)  
WbError = LastError()
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
   ; 1668 ; "Minor user-defined error"
   ; 2669 ; "Moderate user-defined error"
   ; 3670 ; "Severe user-defined error"
   WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
   WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = TimeYmdHms()
WbErrorFile = StrCat(DirWindows(0),"WWWBATCH.INI")
If deleteIni
   FileDelete(WbErrorFile)
   IniWritePvt(WbErrorDateTime,"CurrentScript",WbErrorHandlerFile      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorValue"   ,WbError                 ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorString"  ,WbErrorString           ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptLine"   ,WbErrorHandlerLine      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset    ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarInSegment" ,WbErrorInSegment,WbErrorFile)
   IniWritePvt("","","",WbErrorFile)
Endif  
WbErrorMsgText = StrCat(WbErrorDateTime,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Current Script: ",WbErrorHandlerFile,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error# [",WbError,"]",@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error Text: ",wberrortextstring,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Extended Information] ",wberroradditionalinfo,@CRLF,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"On Line:",@CRLF,WbErrorHandlerLine,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Offset: ",WbErrorHandlerOffset,@CRLF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "UNKNOWN"
WbErrorMsgText = StrCat(WbErrorMsgText,"Assignment/Variable: ",WbErrorHandlerAssignment,@CRLF)
If (WbErrorInSegment>"") Then WbErrorMsgText = StrCat(WbErrorMsgText,"In UDF/UDS: ",WbErrorInSegment,@CRLF)
If logfile
   cSep = StrCat(StrFill("=",50),@CRLF)
   cLogFile = StrCat(dirscript(),"log.err")
   If ! FileExist(cLogFile) Then FilePut(cLogFile,StrCat("Error Log",@CRLF,cSep))
   FilePut(cLogFile,StrCat(FileGet(cLogFile),WbErrorMsgText,cSep))
Endif
If showerr Then Message("wbErrorHandler",WbErrorMsgText)
Return(1)
#EndSubroutine

#DefineFunction CrTn(cWsc)
IntControl(73,1,0,0,0)
If FileExist(cWsc) Then Return(0)
var = StrCat('<?xml version="1.0"?>',@CRLF,"<component>",@CRLF,'<?component error="true" debug="true"?>',@CRLF)
var = StrCat(var,'<registration',@CRLF,'	description="Tn"',@CRLF,'	progid="Tn.WSC"',@CRLF,'	version="1.00"',@CRLF)
var = StrCat(var,'	classid="{9a3ef45a-5375-4e14-833f-a8793ab9e519}"',@CRLF,'>',@CRLF,'</registration>',@CRLF)
var = StrCat(var,'<public>',@CRLF,'	<method name="GetTn">',@CRLF,'		<PARAMETER name="var"/>',@CRLF,'	</method>',@CRLF,'</public>',@CRLF)
var = StrCat(var,'<implements type="Behavior" id="Behavior"/>',@CRLF)
var = StrCat(var,'<script language="VBScript">',@CRLF,'<![CDATA[',@CRLF,'function GetTn(var)',@CRLF,'	GetTn = TypeName(var)',@CRLF,'end function',@CRLF)
var = StrCat(var,']]>',@CRLF,'</script>',@CRLF,'</component>',@CRLF)
FilePut(cWsc,var)
:WBERRORHANDLER
IntControl(73,1,0,0,0)
ErrorProcessing(1,1,0)
Exit
#EndFunction


#DefineFunction udfProgIDFromsCLSID (sCLSID) ;function from Detlev
IntControl(73,1,0,0,0)
hKey = RegOpenKey(@REGCLASSES, StrCat("CLSID","\",sCLSID))
sProgID = ""
If RegExistKey(hKey,"ProgID") Then sProgID = RegQueryStr(hKey,"ProgID")
RegCloseKey(hKey)
Return (sProgID)
:WBERRORHANDLER
IntControl(73,1,0,0,0)
ErrorProcessing(0,0,1)
Return("")
#EndFunction

#DefineSubRoutine gtype(sProgID) 
IntControl(73,1,0,0,0)
oObj=0
oObj = ObjectCreate(sProgID)
If oObj==0 Then Return("Cannot Determine")
t = oType.GetTn(oObj)
oObj=0
Return (t)
:WBERRORHANDLER
IntControl(73,1,0,0,0)
oObj=0
Return(wberrortextstring)
#EndSubRoutine


;Main portion of script
IntControl(73,1,0,0,0) ;set error handler
oType = 0
oObj  = 0
BoxOpen("Enumerating ActiveX ProgID's","")
;these two files are created
cFile = StrCat(dirScript(),"progids.txt")
cID =  StrCat(dirScript(),"progids.dat")

;if the .dat file already exists, go to
;the part of the script to test ObjectCreate()
If FileExist(cID)
   sProgs = FileGet(cID)
   goto check
Endif
cStr = ""
hKey = RegOpenKey(@REGCLASSES, "CLSID")
sCLSIDList = RegQueryKeys(hKey)
RegCloseKey(hKey)
iCount = ItemCount(sCLSIDList,@TAB)
sProgs = ""
For i=1 To iCount
   sCLSID = ItemExtract(i,sCLSIDList,@TAB)
   sProgID = udfProgIDFromsCLSID (sCLSID)
   If (sProgID == "") Then Continue
   BoxText(sProgID)
   sProgs = StrCat(sProgs,sProgID,@TAB)
   cStr = StrCat(cStr,sProgID,",",sCLSID,@CRLF)
Next
FilePut(cFile,cStr)
FilePut(cID,sProgs)
BoxShut()

:check
cWsc = StrCat(dirScript(),"tn.wsc")
If ! FileExist(cWsc)
   CrTn(cWsc)
Endif
oWsc = StrCat("script:",cWsc)
oType = ObjectGet(oWsc) 

While 1
   sProg = AskItemList("Test TypeName For Selected Object", sProgs, @TAB, @sorted, @single)
   Message("Object Type",gtype(sProg))
EndWhile

:end
oType=0
Exit

:CANCEL
goto end

:WBERRORHANDLER
IntControl(73,1,0,0,0)
oType=0
BoxShut()
ErrorProcessing(1,1,1)
Exit



 
Obtain Links to Winbatch Archives
; Get Winbatch Tech Support Code as simple HTML File 
;          checks 75 known WB Tech Support pages and
;          extracts link information into an htm local file
;
;  Caution: This script runs with the Explorer Object Hidden
;           You can override this when testing by uncommenting
;           a line in the IENav() subroutine
;
; stan littlefield, April 30, 2004  [please keep this header]
;////////////////////////////////////////////////////////////////// 

#DefineSubroutine ErrorProcessing(deleteIni,showerr,logfile)  
WbError = LastError()
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
   ; 1668 ; "Minor user-defined error"
   ; 2669 ; "Moderate user-defined error"
   ; 3670 ; "Severe user-defined error"
   WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
   WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = TimeYmdHms()
WbErrorFile = StrCat(DirWindows(0),"WWWBATCH.INI")
If deleteIni
   FileDelete(WbErrorFile)
   IniWritePvt(WbErrorDateTime,"CurrentScript",WbErrorHandlerFile      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorValue"   ,WbError                 ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorString"  ,WbErrorString           ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptLine"   ,WbErrorHandlerLine      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset    ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarInSegment" ,WbErrorInSegment,WbErrorFile)
   IniWritePvt("","","",WbErrorFile)
Endif  
WbErrorMsgText = StrCat(WbErrorDateTime,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Current Script: ",WbErrorHandlerFile,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error# [",WbError,"]",@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error Text: ",wberrortextstring,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Extended Information] ",wberroradditionalinfo,@CRLF,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"On Line:",@CRLF,WbErrorHandlerLine,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Offset: ",WbErrorHandlerOffset,@CRLF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "UNKNOWN"
WbErrorMsgText = StrCat(WbErrorMsgText,"Assignment/Variable: ",WbErrorHandlerAssignment,@CRLF)
If (WbErrorInSegment>"") Then WbErrorMsgText = StrCat(WbErrorMsgText,"In UDF/UDS: ",WbErrorInSegment,@CRLF)
If logfile
   cSep = StrCat(StrFill("=",50),@CRLF)
   cLogFile = StrCat(dirscript(),"log.err")
   If ! FileExist(cLogFile) Then FilePut(cLogFile,StrCat("Error Log",@CRLF,cSep))
   FilePut(cLogFile,StrCat(FileGet(cLogFile),WbErrorMsgText,cSep))
Endif
If showerr Then Message("wbErrorHandler",WbErrorMsgText)
Return(1)
#EndSubroutine


#DefineSubroutine IENav(B,url)
B.navigate(url)
While B.ReadyState <> 4
   TimeDelay(.5)
EndWhile
; uncomment next line to watch while gathering link references
;B.visible = 1
While B.Document.ReadyState <> "complete" ; not really needed, but useful
   TimeDelay(.5)
Endwhile
Return
#EndSubroutine

#DefineFunction isInReg(cProg)
Return( RegExistKey(@RegClasses,cProg) )
#EndFunction


IntControl(73, 1, 0, 0, 0)

AddExtender("WWINT34i.DLL")
For i = 1 To 5
   If iGetConState(0) 
      break
   Else
      Display(1,"Internet","Not Sensing Active Connection")
   Endif
   TimeDelay(1)
   If i==4 Then Exit
Next
constate=iGetConState(1)

If constate & 1
   Display(2,"DIAL-UP","Data Retrieval Will Be Slow")
Else
   Display(2,"LAN","T-1,Cable Modem, or DSL")
Endif

lAcro=@TRUE
If ! isInReg("AcroExch.App")
   lAcro=@FALSE
   Message(1,"Cannot Create PDF File",StrCat("The Full Version of Adobe Acrobat",@CRLF,"does not appear to be installed.",@CRLF,"Will prepare the HTML File Only") )
Endif

;start data gathering
BoxOpen("Please Do Not Interrupt","Collecting WB Tech Support Links")
B = ObjectCreate("InternetExplorer.Application")
nErr=1
B.addressbar = 0
B.statusbar = 0
B.menubar = 0
B.toolbar = 0
B.visible = 0
cHTM = StrCat(dirget(),"wblinks.htm")
cPDF = StrCat(dirget(),"wblinks.pdf")
cOut = ""
cOut = StrCat(cOut,"<HTML>",@CRLF,"<HEAD>",@CRLF,"<TITLE>Winbatch Support Tips and Code</TITLE>",@CRLF,"</HEAD>",@CRLF,"<BODY>",@CRLF,"<BLOCKQUOTE>")
base = "http://techsupt.winbatch.com/TS/D0000010"
nTop = 75

For i = 1 To nTop
   If i<10 Then i= StrCat("0",i)
   url = StrCat(base,i,".html")
   IENav(B,url) 
   BoxText(StrCat("[Processing URL %i% of %nTop%]",@CRLF,B.Document.Title))
   cOut = StrCat(cOut,"<br><br><H2>",B.Document.Title,"</H2><br><br>",@CRLF)
   If B.Document.links.length >0 Then
      ForEach l In B.Document.links
         If StrIndex( l.href,"/TS/",0,@FWDSCAN ) Then cOut = StrCat( cOut,StrCat( '<a href="',l.href,'">',l.innerHTML,'</a><br>' ),@CRLF)   
      Next
   Endif
Next

cOut = StrCat(cOut,"</BLOCKQUOTE>",@CRLF,"</BODY>",@CRLF,"</HTML>")
FilePut(cHTM,cOut)
B.Quit()
B = 0
If ( (! FileExist(cHTM)) || (! lAcro) ) Then goto end
If FileExist(cPDF) Then FileDelete(cPDF)

AcroApp = ObjectCreate("AcroExch.App")
AvDoc = ObjectCreate("AcroExch.AVDoc")
PdDoc = ObjectCreate("AcroExch.PDDoc")
nErr =2
;open file and if successful, import data
AvDoc.Open(cHTM,"")
For i = 0 To 11
   BoxText(StrCat("Creating %cPDF%",@CRLF,"Seconds Remaining..",(120-(i*10))))
   AvDoc = AcroApp.GetActiveDoc()
   If avDoc.IsValid Then Break
   TimeDelay(10)
Next

If avDoc.IsValid
   pdDoc = avDoc.GetPDDoc
   pdDoc.SetInfo("Title", "Winbatch Articles")
   pdDoc.SetInfo("Author", "Stan Littlefield")
   pdDoc.SetInfo("Subject", "Winbatch HTML Links")
   pdDoc.SetInfo("Keywords", "Winbatch TechDatabase HTML Links")
   bOK = pdDoc.save(1 || 4 || 32, cPDF)
   If ! bOK Then Message("Error!","Unable to Save to %cPDF%")
   pdDoc.Close()
Endif

:close
AvDoc.Close(@TRUE)
AcroApp.Exit()
AvDoc = 0
PDDoc = 0
AcroApp = 0
BoxShut()
If FileExist(cPDF)
   FileDelete(cHTM)
   Display(1,"Success!","%cPDF% Created")
Endif

:end
Exit

:WBERRORHANDLER
IntControl(73,1,0,0,0)
If nErr==1
   B.Quit()
   B = 0
Endif
If nErr==2
   AvDoc = 0
   PDDoc = 0
   AcroApp = 0
Endif
ErrorProcessing(1,1,1)
Exit
;////////////////////////////////////////////////////////////////

  

 

Error Handling Example
; Winbatch - Tracking Access Data Entry Error due to constraints
;
; Stan Littlefield, June 22, 2004
;//////////////////////////////////////////////////////////////////////////

;This script requires the latest version of the Jet 4.0 Provider.
;NOTE: Jet is no longer provided with MDAC after version 2.5 but must
;      be downloaded separately.
;
;The purpose is to demonstrate an error-handling situation, not all Providers
;or database drivers will support Check Constraints.
;
;The script 1. Creates an Access Database and a table 'sample' with three
;              columns - fname,lname and age.
;           2. a 'constraint' is added to the age column so that values
;              under 31 are not accepted
;           3. two rows of valid data are entered, row 3 will
;              break the constrain and cause an error
;The :WBERRHANDLER will raise a value of nErr to 1 which will prompt the
;script to not display the 3rd row entered, and gosub a recover dialog.
;in the recover code, you are allowed to see that a Connection Error is
;not raised, as the error would be treated as a warning by Access
;
;there are 2 methods for entering data, one is directly from the 
;connection, the other from a Recordset using addnew()/update().
;Because the the mdb file is erased and re-built each time, you can use
;the script to experiment. 
;//////////////////////////////////////////////////////////////////////////

#DefineSubroutine ErrorProcessing(deleteIni,showerr,logfile)  
WbError = LastError()
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
   ; 1668 ; "Minor user-defined error"
   ; 2669 ; "Moderate user-defined error"
   ; 3670 ; "Severe user-defined error"
   WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
   WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = TimeYmdHms()
WbErrorFile = StrCat(DirWindows(0),"WWWBATCH.INI")
If deleteIni
   FileDelete(WbErrorFile)
   IniWritePvt(WbErrorDateTime,"CurrentScript",WbErrorHandlerFile      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorValue"   ,WbError                 ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorString"  ,WbErrorString           ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptLine"   ,WbErrorHandlerLine      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset    ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarInSegment" ,WbErrorInSegment,WbErrorFile)
   IniWritePvt("","","",WbErrorFile)
Endif  
WbErrorMsgText = StrCat(WbErrorDateTime,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Current Script: ",WbErrorHandlerFile,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error# [",WbError,"]",@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error Text: ",wberrortextstring,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Extended Information] ",wberroradditionalinfo,@CRLF,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"On Line:",@CRLF,WbErrorHandlerLine,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Offset: ",WbErrorHandlerOffset,@CRLF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "UNKNOWN"
WbErrorMsgText = StrCat(WbErrorMsgText,"Assignment/Variable: ",WbErrorHandlerAssignment,@CRLF)
If (WbErrorInSegment>"") Then WbErrorMsgText = StrCat(WbErrorMsgText,"In UDF/UDS: ",WbErrorInSegment,@CRLF)
If logfile
   cSep = StrCat(StrFill("=",50),@CRLF)
   cLogFile = StrCat(dirscript(),"log.err")
   If ! FileExist(cLogFile) Then FilePut(cLogFile,StrCat("Error Log",@CRLF,cSep))
   FilePut(cLogFile,StrCat(FileGet(cLogFile),WbErrorMsgText,cSep))
Endif
If showerr Then Message("wbErrorHandler",WbErrorMsgText)
Return(1)
#EndSubroutine


IntControl(73,2,0,0,0)  ;gosub error handler
nErr = 0
cat = 0
DB = 0
path = dirScript()
cMDB = StrCat(path,"Constraint.mdb")
If FileExist(cMDB) Then FileDelete(cMDB)
Conn="Provider=MicroSoft.Jet.OLEDB.4.0; Data Source=%cMDB%;"
cat = ObjectCreate("ADOX.Catalog")
cat.Create(Conn)
cat = 0
DB = ObjectCreate("ADODB.Connection")


DB.Open(Conn)
cSQL = "CREATE TABLE sample ( LName TEXT(50) NOT NULL,FName TEXT(50) NOT NULL,Age NUMBER );"

DB.Execute(cSQL)
display(1,"Table Created","sample")

; Add a Constraint, if someone inserts a value in the age column
; under 31 it will raise an error
cSQL = "ALTER TABLE sample ADD CONSTRAINT chk_Age CHECK (Age > 30);"
DB.Execute(cSQL)

;create Recordset and add columns manually
goto addwithRS

; add 3 records using the Connection Execute, the last one will
; break the constraint
cIns = "INSERT INTO sample (LName,FName,Age) Values "
cVal = "( 'Smith','Bob','40');"
DB.Execute( StrCat(cIns,cVal) )
display(1,"First Row Inserted",cVal)

cVal = "( 'Jones','Tom','55');"
DB.Execute( StrCat(cIns,cVal) )
display(1,"Second Row Inserted",cVal)

; the third value, 25 will raise an error as it violates the Check Constraint
; to avoide the error, enter a value greate than 30
cVal = "( 'Youngblood','James','25');"
DB.Execute( StrCat(cIns,cVal) )
If nErr==0 Then display(1,"Third Row Inserted",cVal)

If nErr>0 Then gosub recover        

:close
;Beore we go, let's check the constraints
;Check constraints can be examined with OpenSchema() with the Jet Provider
;below is the Schema enum, if you want to experiment
adSchemaProviderSpecific = -1
adSchemaAsserts = 0
adSchemaCatalogs = 1
adSchemaCharacterSets = 2
adSchemaCollations = 3
adSchemaColumns = 4
adSchemaCheckConstraints = 5
adSchemaConstraintColumnUsage = 6
adSchemaConstraintTableUsage = 7
adSchemaKeyColumnUsage = 8
adSchemaReferentialConstraints = 9
adSchemaTableConstraints = 10
adSchemaColumnsDomainUsage = 11
adSchemaIndexes = 12
adSchemaColumnPrivileges = 13
adSchemaTablePrivileges = 14
adSchemaUsagePrivileges = 15
adSchemaProcedures = 16
adSchemaSchemata = 17
adSchemaSQLLanguages = 18
adSchemaStatistics = 19
adSchemaTables = 20
adSchemaTranslations = 21
adSchemaProviderTypes = 22
adSchemaViews = 23
adSchemaViewColumnUsage = 24
adSchemaViewTableUsage = 25
adSchemaProcedureParameters = 26
adSchemaForeignKeys = 27
adSchemaPrimaryKeys = 28
adSchemaProcedureColumns = 29
adSchemaDBInfoKeywords = 30
adSchemaDBInfoLiterals = 31
adSchemaCubes = 32
adSchemaDimensions = 33
adSchemaHierarchies = 34
adSchemaLevels = 35
adSchemaMeasures = 36
adSchemaProperties = 37
adSchemaMembers = 38
adSchemaTrustees = 39
adSchemaFunctions = 40
adSchemaActions = 41
adSchemaCommands = 42
adSchemaSets = 43


RS = ObjectCreate("ADODB.Recordset")
RS = DB.OpenSchema(adSchemaCheckConstraints )  ; or adSchemaTableConstraints
display(3,"Constraints",RS.GetString(2,-1,",",@CRLF,"null"))
RS.Close()
RS=0

DB.Close()
DB=0
Display(2,"Database Closing",cMDB)
Exit

:WBERRORHANDLER
IntControl(73,2,0,0,0)
nErr = 1
;put extra code here
ErrorProcessing(1,1,1)
Return

:recover
gosub ConnErr
EFormat=`WWWDLGED,6.1`

ECaption=`Errors In Data Insert`
EX=048
EY=088
EWidth=154
EHeight=105
ENumControls=005
EProcedure=`DEFAULT`
EFont=`Microsoft Sans Serif|6144|70|34`
ETextColor=`255|255|0`
EBackground=`DEFAULT,0|0|255`
EConfig=0

E001=`105,041,036,012,PUSHBUTTON,DEFAULT,"OK",1,1,32,DEFAULT,DEFAULT,"0|0|255"`
E002=`011,007,084,084,GROUPBOX,DEFAULT,"Choose an Action",DEFAULT,5,DEFAULT,DEFAULT,DEFAULT,"0|0|255"`
E003=`017,023,068,012,RADIOBUTTON,nAction,"Close and Exit",1,2,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
E004=`017,045,072,012,RADIOBUTTON,nAction,"View Table",2,3,DEFAULT,DEFAULT,DEFAULT,DEFAULT`
E005=`017,067,062,012,RADIOBUTTON,nAction,"Review Data",3,4,DEFAULT,DEFAULT,DEFAULT,DEFAULT`

B=Dialog("E")

Return

:ConnErr
If DB.Errors.Count == 0 Then Return
oE = ObjectCreate("ADODB.Error")
display(1,"Connection Errors",DB.Errors.Count)
ForEach Err In DB.Errors
  str = StrCat("Error #",oE.Number,@CRLF)
  str = StrCat(str,"   ",oE.Description,@CRLF)
  str = StrCat(str,"   (Source: ",oE.Source,")",@CRLF)
  str = StrCat(str,"   (SQL State: ",oE.SQLState,")",@CRLF)
  str = StrCat(str,"   (NativeError: ",oE.NativeError,")",@CRLF)
  Message("Connection Error",str)
Next
DB.Errors.Clear()
oE=0
Return         


:addwithRS
; cursor type
adOpenForwardOnly = 0
adOpenKeyset = 1
adOpenDynamic = 2
adOpenStatic = 3
; lock type
adLockReadOnly = 1
adLockPessimistic = 2
adLockOptimistic = 3
adLockBatchOptimistic = 4

adCmdTable = 2
adStateOpen = 1

RS = ObjectCreate("ADODB.Recordset")
RS.Open("sample",DB,adOpenDynamic,adLockOptimistic,adCmdTable)
f1 = 'Smith'
f2 = 'Bob'
f3 = 40
gosub add
display(1,"Record Added For",StrCat(f2," ",f1)) 
f1 = 'Jones'
f2 = 'Tom'
f3 = 55
gosub add
display(1,"Record Added For",StrCat(f2," ",f1)) 
f1 = 'Youngblood'
f2 = 'James'
f3 = 25       ; change this value to >30 to not generate error
gosub add
If nErr==0 
   display(1,"Record Added For",StrCat(f2," ",f1))
   RS.Close()
   RS=0
   goto close
Endif

;NOTE: the command RS.Close() will generate an additional error
;      you first Cancel all operations
If RS.State == adStateOpen Then RS.Cancel()
RS=0
If nErr>0 Then gosub recover  
Goto close

:add
RS.addnew()
RS.Fields("LName").Value = f1
RS.Fields("FName").Value = f2
RS.Fields("age").Value = f3
RS.Update()
Return
 
;//////////////////////////////////////////////////////////////////////
 


Article ID:   W16294

File Created: 2019:08:14:08:51:54
Last Updated: 2019:08:14:08:51:54