VB6 integrated environment on Error Handling Code add plug-in

Plug-in (Please download the latest version v1.0.5 ):

Http://code.google.com/p/vsaddin/downloads

 

Installation Method:
1. Click "Project-reference" in the menu and select this DLL
2. Click "external program-external program manager" in the menu and select "insert error hand" to check the two boxes in the lower right corner.
3. In this way, the "insert error hand" option will be added to the "external program" menu.

Usage:
The code editing window to be processed opens, and then click "external program-insert error hand" in the menu"

PS: The plug-in only processes the opened code editing window.

 

The main code is as follows:

'''''''''''''''''''''''''''''''''''''''' ''' <Br/>' description: VB6 ide function process error code added <br/> 'Author: sysdzw <br/>' mailbox: sysdzw@163.com QQ: 171977759 <br/> ''''''''''''''''''''''''''''''''''' ''' </P> <p> 'modify history (add a record below for code modifications and send it to the mailbox sysdzw@163.com) <br/> '-------------------------------------------------------------------------- <br/> 'date modifier version description <br/> '------ Warning <br/> '2017-12-1 sysdzw v1.0.1 initial version <br/> '2017-12-2 sysdzw v1.0.2 improved: if the user has already done error processing, it will not be processed. <br/> 'v1.0.3 added support for the property Process <br/> '2017-12-3 sysdzw v1.0.4 corrected an error when the declared parameters of the process are multiple rows. <br/> 'v1.0.5 added code window monitoring, when the code changes, it will be processed <br/> '----------------------------------------------------------------------- <br/> Option explicit <br/> Public Formdisplayed as Boolean <br/> Public vbinstance as vbide. VBE <br/> dim mcbmenucommandbar as office. commandbarcontrol <br/> Public withevents menuhandler as commandbarevents 'COMMAND Bar event handler <br/> 'strmethodname method name <br/> 'strtype, is a sub or function <br/> 'ojbcodemodel code window, used to retrieve the number of rows of the method <br/> private sub dealmethod (byval strmethodname $, byval strtype $, ojbcodemodel as codemodule) <br/> on error g Oto errhand </P> <p> dim lngfirstprocline &, lngfirstbodyline &, lngproclinescount & <br/> dim lngcurrentline & </P> <p> lngfirstprocline = ojbcodemodel. procstartline (strmethodname, vbext_pk_proc) 'indicates the first line of the entire process. For example, it is applicable to adding function annotations before the process. <br/> lngfirstbodyline = ojbcodemodel. procbodyline (strmethodname, vbext_pk_proc) 'indicates the first line of the Process Code, which is generally the Statement of the process. <br/> lngproclinescount = ojbcodemodel. proccountlines (strmethodname, vbext_pk _ Proc) 'Number of codes in the process' </P> <p> 'If the "on error goto/resume XXX" statement is not found in the entire process, add "on error goto errhand" to the next line of the Declaration", if the user has handled it, exit <br/> if not ismatchreg (ojbcodemodel. lines (lngfirstprocline, lngproclinescount), "^ *? On error (?: Goto | resume )*? '? ") Then <br/> lngcurrentline = lngfirstbodyline <br/> DO <br/> If right (ojbcodemodel. lines (lngcurrentline, 1), 1) <> "_" then' because some statements are written in multiple rows, so you need to find the row number that is not "_" on the far right <br/> ojbcodemodel. insertlines lngcurrentline + 1, vbtab & "on error goto errhand" & vbcrlf <br/> lngproclinescount = lngproclinescount + 2 <br/> exit do <br/> end if <br/> lngcurrentline = lngcurrentline + 1 <br/> loop </P> <p> 'If "errhand: "Then in Add "errhand:" to the first line of "End sub/funtion" and so on <br/> if not ismatchreg (ojbcodemodel. Lines (lngfirstprocline, lngproclinescount), "^ *? Errhand :*? '?. *? ") Then <br/> 'Find the row where "End sub/funtion" is located <br/> lngcurrentline = lngfirstprocline + lngproclinescount-1 <br/> DO <br/> If ismatchreg (ojbcodemodel. lines (lngcurrentline, 1), "^ *? End "& strtype &"*? '? ") Then' finds the row where" End sub/funtion "is located and begins to add" errhand: "and so on. <br/> ojbcodemodel. insertlines lngcurrentline, vbcrlf & vbtab & "exit" & strtype & vbcrlf & _ <br/> "errhand: "& vbcrlf & _ <br/> vbtab &" msgbox "" error number: "" & vbtab & err. number & vbcrlf & "" error Description: "" & vbtab & err. description & vbcrlf & "" error "& strtype &": "" & vbtab & "" & strmethodname & "", vbexclamation "<br/> Exi T do <br/> end if <br/> lngcurrentline = lngcurrentline-1 <br/> loop <br/> end if <br/> exit sub <br/> errhand: <br/> msgbox "error number:" & vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "dealmethod" & vbcrlf & _ <br/> "arguments:" & vbtab & "strmethodname =" & strmethodname &"; strtype = "& strtype, vbexclamat Ion <br/> end sub <br/> 'strpropertyname property name <br/> 'strtype, set to property/let/get <br/> 'ojbcodemodel code window, number of rows used to retrieve methods <br/> private sub dealproperty (byval strpropertyname $, byval strtype $, ojbcodemodel as codemodule) <br/> on error goto errhand <br/> dim strdata $, lngcurrentline & <br/> dim lngpropertyfirstline &, strpropertycode $ </P> <p> strdata = ojbcodemodel. lines (1, ojbcodemodel. countoflines) <br/> Lngpropertyfirstline = reggetstr1line (strdata, "^ (?: Public | private )? *? "& Strtype &" & strpropertyname &"/(? ") <Br/> strpropertycode = reggetstr1 (strdata," ^ (?: Public | private )? *? "& Strtype &" "& strpropertyname &" [/S] +? ^ *? End property *? '? ") </P> <p> 'if there is no" on error goto/resume XXX "statement during the entire process, add" on error goto errhand "to the next line declared ", if the user processes the data, exit <br/> if not ismatchreg (strpropertycode, "^ *? On error (?: Goto | resume )*? '? ") Then <br/> lngcurrentline = lngpropertyfirstline <br/> DO <br/> If right (ojbcodemodel. lines (lngcurrentline, 1), 1) <> "_" then' because some statements are written in multiple rows, so you need to find the row number that is not "_" on the far right <br/> ojbcodemodel. insertlines lngcurrentline + 1, vbtab & "on error goto errhand" & vbcrlf <br/> exit do <br/> end if <br/> lngcurrentline = lngcurrentline + 1 <br/> loop </P> <p> 'if no "errhand: "add" errhand: "and so on in the first line of" end property "<br/> if not Ismatchreg (strpropertycode, "^ *? Errhand :*? '?. *? ") Then <br/> 'Find the row where" end property "is located <br/> lngcurrentline = lngpropertyfirstline + 3 <br/> DO <br/> If ismatchreg (ojbcodemodel. lines (lngcurrentline, 1), "^ *? End property *? '? ") Then' finds the row where" end property "is located and begins to add" errhand: "and so on. <br/> ojbcodemodel. insertlines lngcurrentline, vbcrlf & vbtab & "Exit property" & vbcrlf & _ <br/> "errhand:" & vbcrlf & _ <br/> vbtab & "msgbox" "error number: "" & vbtab & err. number & vbcrlf & "" error Description: "" & vbtab & err. description & vbcrlf & "" error property: "" & vbtab & "" & right (strtype, 3) & "& strpropertyname &", vbexclam Ation "<br/> exit do <br/> end if <br/> lngcurrentline = lngcurrentline + 1 <br/> loop <br/> end if <br/> exit sub <br/> errhand: <br/> msgbox "error number:" & vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "dealproperty" & vbcrlf & _ <br/> "arguments:" & vbtab & "strpropertyname =" & strpropertyname &"; strtype =" & Strtype, vbexclamation <br/> end sub <br/> private sub addininstance_onbeginshutdown (custom () as variant) <br/> on error goto errhand <br/> frmwatch. tmrwatch. enabled = false <br/> unload frmwatch </P> <p> exit sub <br/> errhand: <br/> msgbox "error number:" & vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "addininstance_onbeginshutdo WN ", vbexclamation <br/> end sub <br/> 'this event fires when the menu is clicked in the IDE <br/> private sub menuhandler_click (byval commandbarcontrol as object, handled as Boolean, canceldefault as Boolean) <br/> on error goto errhand <br/> dim objcodepane as codepane </P> <p> 'frmwatch. show 1 <br/> frmwatch. tmrwatch. enabled = false <br/> for each objcodepane in vbinstance. codepanes <br/> dealcodemo Dule objcodepane. codemodule <br/> next <br/> frmwatch. tmrwatch. enabled = true <br/> exit sub <br/> errhand: <br/> msgbox "error number:" & vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "menuhandler_click", vbexclamation <br/> end sub <br/> Public sub dealcodemodule (byval ojbcodemodule as codemodule) <br/> on error goto errhand <br/>' On Error goto errhand <br/> dim strdata $, strdatanew $ <br/> dim Reg as object <br/> dim matchs as object, match as object </P> <p> dim lngpropertyfirstline &, strpropertycode $ </P> <p> set Reg = Createobject ("VBScript. regexp ") <br/> Reg. global = true <br/> Reg. ignorecase = true <br/> Reg. multiline = true <br/> Reg. pattern = "^ (?: Public | private )? *? (Sub | function | property (?: Let | set | get) +? (/W + )/(? "<Br/> 'processing when code exists <br/> If ojbcodemodule. countoflines> 0 then <br/> strdata = ojbcodemodule. lines (1, ojbcodemodule. countoflines) </P> <p> set matchs = reg. execute (strdata) <br/> for each match in matchs <br/> If instr (match. submatches (0), "property")> 0 then' dealproperty type <br/> dealproperty match. submatches (1), match. submatches (0), ojbcodemodule ', lngpropertyfirstline, strpropertycode <br/> else 'sub or function <br/> dealmethod match. submatches (1), match. submatches (0), ojbcodemodule <br/> end if <br/> next <br/> end if <br/> exit sub <br/> errhand: <br/> msgbox "error number:" & vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "dealcodemodule ", vbexclamation <br/> end sub <br/> 'timeout <br/> 'this method adds the add-in to VB <br/> 'timeout <br/> private sub addininstance_onconnection (byval application as object, byval connectmode as addindesignerobjects. ext_connectmode, byval addininst as object, custom () as variant) <br/> on error goto errhand <br/> 'Save the VB instance <br/> set vbinstance = application </P> <p> 'this is a good place to set a breakpoint and <br/> 'test various addin objects, properties and methods <br/> If connectmode = ext_cm_external then <br/> 'used by the wizard toolbar to start this wizard <br/> else <br/> set mcbmenucommandbar = addtoaddincommandbar ("insert error hand ") <br/> 'sink the event <br/> set me. menuhandler = vbinstance. events. commandbarevents (mcbmenucommandbar) <br/> end if </P> <p> If connectmode = ext_cm_afterstartup then <br/> If getsetting (App. title, "Settings", "displayonconnect", "0 ") = "1" then <br/> 'set this to display the form on connect <br/> end if </P> <p> set frmwatch. vbinstance = vbinstance <br/> set frmwatch. connect = mE <br/> load frmwatch <br/> frmwatch. tmrwatch. enabled = true </P> <p> 'msgbox vbinstance. codepanes. count <br/> exit sub <br/> errhand: <br/> msgbox "error number:" & vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "addininstance_onconnection ", vbexclamation <br/> end sub <br/> 'conditions <br/> 'this method removes the add-in from VB <br/> 'conditions <br/> private sub addininstance_ondisconnection (byval removemode as addindesignerobjects. ext_disconnectmode, custom () as variant) <br/> on error goto errhand <br/> 'delete the command bar entry <br/> mcbmenucommandbar. delete </P> <p> 'Shut down the add-in <br/> If formdisplayed then <br/> savesetting app. title, "Settings", "displayonconnect", "1" <br/> formdisplayed = false <br/> else <br/> savesetting app. title, "Settings", "displayonconnect", "0" <br/> end if <br/> exit sub <br/> errhand: <br/> msgbox "error number: "& vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "addininstance_ondisconnection", vbexclamation <br/> end sub <br/> function addtoaddincommandbar (scaption as string) as office. commandbarcontrol <br/> on error goto errhand <br/> dim cbmenucommandbar as office. commandbarcontrol 'COMMAND bar object <br/> dim cbmenu as object </P> <p> 'see if we can find the add-ins menu <br/> set cbmenu = vbinstance. commandbars ("add-ins ") <br/> If cbmenu is nothing then <br/> 'not available so we fail <br/> exit function <br/> end if </P> <p> 'add it To The command bar <br/> set cbmenucommandbar = cbmenu. controls. add (1) <br/> 'set the caption <br/> cbmenucommandbar. caption = scaption </P> <p> set addtoaddincommandbar = cbmenucommandbar <br/> exit function <br/> errhand: <br/> msgbox "error number: "& vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "addtoaddincommandbar ", vbexclamation <br/> end function <br/> 'test whether the regular expression matches. <br/> private function ismatchreg (strdata $, strpattern $) as Boolean <br/> on error goto errhand <br/> dim Reg as object </P> <p> set Reg = Createobject ("VBScript. regexp ") <br/> Reg. global = true <br/> Reg. ignorecase = true <br/> Reg. multiline = true <br/> Reg. pattern = strpattern </P> <p> ismatchreg = reg. test (strdata) <br/> exit function <br/> errhand: <br/> msgbox "error number:" & vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "ismatchreg ", vbexclamation <br/> end function </P> <p> 'to obtain the first matching item of the regular brackets. <br/> private function reggetstr1 (strdata $, strpattern $) as string <br/> on error goto errhand <br/> dim Reg as object <br/> dim matchs as object, match as object </P> <p> set Reg = Createobject ("VBScript. regexp ") <br/> Reg. global = false <br/> Reg. ignorecase = true <br/> Reg. multiline = true <br/> Reg. pattern = strpattern </P> <p> set matchs = reg. execute (strdata $) <br/> If matchs. count> = 1 then <br/> reggetstr1 = matchs (0) <br/> end if <br/> exit function <br/> errhand: <br/> msgbox "error number:" & vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "reggetstr1 ", vbexclamation <br/> end function <br/> 'obtains the row of the first matching item in the regular brackets. <br/> private function reggetstr1line (byval strdata $, strpattern $) as long <br/> on error goto errhand <br/> dim Reg as object <br/> dim matchs as object, match as object </P> <p> set Reg = Createobject ("VBScript. regexp ") <br/> Reg. global = false <br/> Reg. ignorecase = true <br/> Reg. multiline = true <br/> Reg. pattern = strpattern </P> <p> set matchs = reg. execute (strdata $) <br/> If matchs. count> = 1 then <br/> reggetstr1line = ubound (split (left (strdata, matchs (0 ). firstindex + 1), vbcrlf) + 1 <br/> end if <br/> exit function <br/> errhand: <br/> msgbox "error number: "& vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "reggetstr1line ", vbexclamation <br/> end function <br/> 'returns the regular array. <br/> private function regresult (strdata $, strpattern $) <br/> on error goto errhand <br/> dim Reg as object, S $, I % <br/> dim matchs as object, match as object </P> <p> set Reg = Createobject ("VBScript. regexp ") <br/> Reg. global = true <br/> Reg. ignorecase = true <br/> Reg. multiline = true <br/> Reg. pattern = strpattern </P> <p> set matchs = reg. execute (strdata $) <br/> for I = 0 to matchs (0 ). submatches. count-1 <br/> S = S & matchs (0 ). submatches (I) & "_ Split _" <br/> next <br/> If S <> "" Then S = left (S, Len (S)-7) <br/> regresult = Split (S, "_ Split _") <br/> exit function <br/> errhand: <br/> msgbox "error number: "& vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error function:" & vbtab & "regresult ", vbexclamation <br/> end function <br/> ''''''''''''''''''''''''''''' ''' <br/> 'function: directly write the file according to the given file name and content <br/> 'function name: writetofile <br/> 'entry parameter (as shown below): <br/> 'strfilename specifies the file name; <br/> 'strcontent indicates the string to be input to the preceding file <br/> 'iscover indicates whether to overwrite the file. The default value is overwrite. <br/> 'Return Value: true or false, if the call succeeds, the former is returned. Otherwise, the latter is returned. <br/> 'remarks: sysdzw is available from to. <br/> '''''''''''''''''''''''''''''''' ''' <br/> private function writetofile (byval strfilename $, byval strcontent $, optional iscover as Boolean = true) as Boolean <br/> on error goto errhand <br/> dim filehandl % <br/> filehandl = freefile <br/> If iscover then <br/> open strfilename for output # filehandl <br/> else <br/> open strfilename for append as # filehandl <br/> end if <br/> Print # filehandl, strcontent <br/> close # filehandl <br/> writetofile = true <br/> exit function <br/> errhand: <br/> msgbox "error number: "& vbtab & err. number & vbcrlf & "error Description:" & vbtab & err. description & vbcrlf & "error Sub:" & vbtab & "writetofile", vbexclamation <br/> end Function

 

 

 

V1.0.6 setting window preview: