Automating Test Automation Home Automation Articles Downloads QTP Gotchas Links Books Contact About Site Map
Automate - Gen Err V1.0If you find an error, or have a suggestion for improvement, Email me and I'll fix it. This code adds error handling to scripts For safety it keeps the original script untouched and generates a new script with '_001' added on the end of the filename. So it's up to you to check the result is ok and rename them manually. You just save this code into a .qfl file, add it to your project and then 'Call GenErr' to run it.
It will ask you various questions and then generate a new .qfl file containing the error handling code. Download it Here (right-click and then save target as). (NOTE - you can just cut & paste from below, but the formatting will have multiple spaces instead of tabs).
'=========================================================================
Option Explicit 'V1.0 - First Version Sub GenErr Dim sIniFile, sPath, aFiles, iFileIndex, iFileCount, sFile sIniFile = "c:\Intellipro.ini" 'Hide... Call zGen_PopupMsg("I'm going to hide while I'm doing this...", 2) Call zQTP_MinimizeWindow 'What is the path to the files? sPath = zGen_GetIni(sIniFile, "GenErr", "Path", "C:\Program Files\HP\QuickTest Professional\Tests\") 'Get user to confirm the path sPath = Inputbox ("Confirm path to files:", "User Input Required", sPath) If sPath = "" Then Call ExitTest() End If 'Check the path exists If Not zFile_FolderExists(sPath) Then Msgbox sPath, vbExclamation, "Path NOT Found - Aborting:" Call ExitTest() End If 'Get the files to process aFiles = zFile_GetListFromFolder(sPath) iFileCount = UBound(aFiles) If iFileCount = 0 Then Msgbox sPath, vbExclamation, "No files found - Aborting:" Call ExitTest() Else 'Save the path for next time Call zGen_SetIni(sIniFile, "GenErr", "Path", sPath) For iFileIndex = 1 to iFileCount sFile = aFiles(iFileIndex) 'Only process .qfl files for now If Right(sFile,4) = ".qfl" Then Call zGen_PopupMsg("Processing File : " & sFile & " - " & cStr(iFileIndex) & " of " & cStr(iFileCount), 1) 'Strip away the file extension sFile = Left(sFile,Len(sFile)-4) Call ProcessFile(sPath, sFile, "qfl") Else 'Ignore other types of files for now Call zGen_PopupMsg("Ignoring File : " & sFile, 1) End If Next End If End Sub '========================= Private Sub ProcessFile(sPath,sFile, sExtn) Dim sMod, sFromFile, sToFile, oFso, oFileFrom, oFileTo, iLine, sLine Const ForReading = 1, ForWriting = 2, ForAppending = 8 Const TristateTrue = -1 sMod = "Xxx" iLine = 0 sFromFile = sPath & sFile & "." & sExtn sToFile = sPath & sFile & "_001." & sExtn Set oFso = CreateObject("Scripting.FileSystemObject") Set oFileFrom = oFso.OpenTextFile(sFromFile, ForReading, False, TristateTrue) Set oFileTo = oFso.OpenTextFile(sToFile, ForWriting, True, TristateTrue) Do Until oFileFrom.AtEndOfStream iLine = iLine + 1 sLine = oFileFrom.ReadLine sLine = ProcessLine(sFile,sMod,iLine,sLine) oFileTo.WriteLine sLine Loop oFileFrom.Close oFileTo.Close Set oFileFrom = Nothing Set oFileTo = Nothing Set oFso = Nothing End Sub '========================= Private Function ProcessLine(sApp,sMod,iLine,sLine) Dim sTemp, iLen, iTabCount, iVisibleLength, iPaddingRequired, iPaddingTabs, sPadding, sPaddingTabs Dim iCharIndex, iCharCount, iSpaceCount, sChar, iChar, iTabsRequired, iPaddingRemainder Dim iTotalTabs, sTotalTabs, sCode, sSuffix 'Set the return value ProcessLine = sLine 'Detect blank lines If sLine = "" Then Exit Function End If If sLine ="Option Explicit" Then Exit Function End If 'Detect blank lines - Replace all tabs with spaces, then trim sTemp = Trim(Replace(sLine,vbtab,"")) If sTemp = "" Then 'Reset the return value to make blank lines REALLY blank ProcessLine = "" Exit Function End If 'Ignore comment lines - leave as-is (including incorrect tabs/spacing if any) If Left(sTemp,1) = "'" Then Exit Function End If 'Ignore lines that end with the continuation character '_' If Right(sTemp,1) = "_" Then Exit Function End If 'Ignore start/end subs and functions - make check case insensitive 'Functions If UCase(Left(sTemp,9)) = "FUNCTION " Then sMod = ExtractMod(Mid(sTemp,10)) ProcessLine = "Function " & Mid(sTemp,10) Exit Function ElseIf UCase(Left(sTemp,17)) = "PRIVATE FUNCTION " Then sMod = ExtractMod(Mid(sTemp,18)) ProcessLine = "Private Function " & Mid(sTemp,18) Exit Function ElseIf UCase(Left(sTemp,16)) = "PUBLIC FUNCTION " Then sMod = ExtractMod(Mid(sTemp,17)) ProcessLine = "Public Function " & Mid(sTemp,17) Exit Function ElseIf UCase(Left(sTemp,24)) = "PUBLIC DEFAULT FUNCTION " Then sMod = ExtractMod(Mid(sTemp,25)) ProcessLine = "Public Default Function " & Mid(sTemp,25) Exit Function ElseIf UCase(Left(sTemp,13)) = "EXIT FUNCTION" Then 'Correct indenting matters - leave for now Exit Function ElseIf UCase(Left(sTemp,12)) = "END FUNCTION" Then sMod = "###" ProcessLine = "End Function" Exit Function End If 'Subs If UCase(Left(sTemp,4)) = "SUB " Then sMod = ExtractMod(Mid(sTemp,5)) ProcessLine = "Sub " & Mid(sTemp,5) Exit Function ElseIf UCase(Left(sTemp,12)) = "PRIVATE SUB " Then sMod = ExtractMod(Mid(sTemp,13)) ProcessLine = "Private Sub " & Mid(sTemp,13) Exit Function ElseIf UCase(Left(sTemp,11)) = "PUBLIC SUB " Then sMod = ExtractMod(Mid(sTemp,12)) ProcessLine = "Public Sub " & Mid(sTemp,12) Exit Function ElseIf UCase(Left(sTemp,19)) = "PUBLIC DEFAULT SUB " Then sMod = ExtractMod(Mid(sTemp,20)) ProcessLine = "Public Default Sub " & Mid(sTemp,20) Exit Function ElseIf UCase(Left(sTemp,8)) = "EXIT SUB" Then 'Correct indenting matters - leave for now Exit Function ElseIf UCase(Left(sTemp,7)) = "END SUB" Then sMod = "###" ProcessLine = "End Sub" Exit Function End If 'If, Else, ElseIf, Endif If UCase(Left(sTemp,3)) = "IF " Then Exit Function ElseIf UCase(Left(sTemp,4)) = "ELSE" Then Exit Function ElseIf UCase(Left(sTemp,7)) = "ELSEIF " Then Exit Function ElseIf UCase(Left(sTemp,6)) = "END IF" Then Exit Function End If 'For, Next, Exit For If UCase(Left(sTemp,4)) = "FOR " Then Exit Function ElseIf UCase(Left(sTemp,4)) = "NEXT" Then Exit Function ElseIf UCase(Left(sTemp,8)) = "EXIT FOR" Then Exit Function End If 'While, Wend If UCase(Left(sTemp,6)) = "WHILE " Then Exit Function ElseIf UCase(Left(sTemp,4)) = "WEND" Then Exit Function End If 'Do, Loop, Exit Do If UCase(Left(sTemp,2)) = "DO" Then Exit Function ElseIf UCase(Left(sTemp,4)) = "LOOP" Then Exit Function ElseIf UCase(Left(sTemp,7)) = "EXIT DO" Then Exit Function End If 'Select Case ? 'Withs ? 'If we get to here: 'Line not blank or spaces or tabs 'Line not comment or spaces/tabs followed by comment 'Line not start/end/exit of function or sub 'Line not continued on next line 'Line not loops or branches 'Process leading spaces and tabs 'Split away the leading chunk mixture of spaces and tabs (can be ANY combination) iLen = Len(sLine) iCharCount = 0 iSpaceCount = 0 iTabCount = 0 For iCharIndex = 1 to iLen iCharCount = iCharCount + 1 'Look for spaces, tabs and anything else sChar = Mid(sLine,iCharIndex,1) iChar = Asc(sChar) If iChar = 32 Then 'Space iSpaceCount = iSpaceCount + 1 ElseIf iChar = 9 Then 'Tab iTabCount = iTabCount + 1 Else 'Not space or tab so exit loop Exit For End If Next 'Extract the code from the string sCode = Mid(sLine,iCharCount) 'Work out what needs to go on the front 'Ignore funny numbers of spaces because they are incorrect anyway 'For every 4 spaces substitute a tab iTabsRequired = Int(iSpaceCount/4) 'Caclulate total number of tabs iTotalTabs = iTabCount + iTabsRequired 'Make a string with that many tabs sTotalTabs = String(iTotalTabs, 9) 'Reconstruct the line - tabs plus code sTemp = sTotalTabs & sCode 'Now remove any trailing spaces and tabs - QTP seems to accumulate these sTemp = BackNibble(sTemp) 'Now calculate how long the line APPEARS to be 'Recount the tabs - there might be some buried in the code line iTabCount = zStr_Count(sTemp, vbTab) iLen = Len(sTemp) 'The total visible length is the total number of chars plus an extra 3 chars for each tab iVisibleLength = iLen + ( 3 * iTabCount ) 'Only process lines with less that 130 characters If iVisibleLength < 130 Then iPaddingRequired = 130 - iVisibleLength iPaddingTabs = Int(iPaddingRequired / 4) sPaddingTabs = String(iPaddingTabs, 9) iPaddingRemainder = iPaddingRequired - (iPaddingTabs * 4) sPadding = Space(iPaddingRemainder) & sPaddingTabs sSuffix = " :If Err <> 0 Then Call zErr(" & Chr(34) & sApp & Chr(34) & "," & Chr(34) & sMod & Chr(34) & "," & cStr(iLine) & ",Err)" 'Assemble the final line and return it from the function ProcessLine = sTemp & sPadding & sSuffix End If End Function '========================= Private Function ExtractMod(sInput) 'Extract the function/sub name from the string Dim sTemp, iPosn 'Remove any leading spaces and add a bracket onto the end so there is ALWAYS one to find sTemp = Trim(sInput) & "(" 'Look for an opening blacket to terminate the function name iPosn = inStr(sTemp,"(") 'Trim away any spaces, brackets and parameters sTemp = Trim(Left(sTemp,iPosn-1)) 'Return the name ExtractMod = sTemp End Function '========================= Private Function BackNibble(sInput) Dim sTemp, iLen, iPos, sChar, iChar sTemp = sInput BackNibble = sTemp iLen = Len(sTemp) For iPos = iLen to 1 step -1 sChar = Mid(sTemp,iPos,1) iChar = Asc(sChar) If iChar = 32 Then sTemp = Left(sTemp,iPos-1) ElseIf iChar = 9 Then sTemp = Left(sTemp,iPos-1) Else 'Not space or tab -> exit! BackNibble = sTemp Exit Function End If Next End Function '========================= Private Function zStr_Count(sInput, sSrch) Dim iCount, sTemp iCount = 0 sTemp = sInput While inStr(sTemp,sSrch) > 0 iCount = iCount + 1 sTemp = Replace(sTemp, sSrch, "", 1, 1) Wend zStr_Count = iCount End Function '======================================== Private Function zFile_Exists(sFileName) Dim oFso Set oFso = CreateObject("Scripting.FileSystemObject") If oFso.FileExists(sFileName) Then zFile_Exists = True Else zFile_Exists = False End If Set oFso = Nothing End Function '======================================== Private Sub zGen_PopupMsg(sMsg, iDelay) Dim oShell If iDelay = 0 Then Msgbox sMsg Else Set oShell = CreateObject("Wscript.Shell") oShell.Popup sMsg, iDelay, "" Set oShell = Nothing End If End Sub '======================================== Private Sub zQTP_MinimizeWindow Dim oApp Set oApp = GetObject("","QuickTest.Application") oApp.WindowState = "Minimized" Set oApp = Nothing End Sub '======================================== Private Function zGen_GetIni(sIniFile, sSection, sKey, sDefault) Dim iRet, sReturnString Extern.Declare micLong, "GetPrivateProfileString", "kernel32.dll", "GetPrivateProfileStringA", micString, micString, micString, micString + micByRef, micDWord, micString iRet = Extern.GetPrivateProfileString( sSection, sKey, sDefault, sReturnString, 256, sIniFile ) If iRet > 0 Then zGen_GetIni = sReturnString Else zGen_GetIni = sDefault End If End Function '======================================== Private Sub zGen_SetIni(sIniFile, sSection, sKey, sValue) Dim iRet Extern.Declare micLong, "WritePrivateProfileString", "kernel32.dll", "WritePrivateProfileStringA", micString, micString, micString, micString iRet = Extern.WritePrivateProfileString( sSection, sKey, sValue, sIniFile ) End Sub '======================================== Private Function zFile_FolderExists(sFolder) 'This function checks to see if a folder exists 'Usage: 'If zFile_FolderExists(sFolder) Then 'Xxxxx 'End If Dim oFso Set oFso = CreateObject("Scripting.FileSystemObject") If oFso.FolderExists(sFolder) Then zFile_FolderExists = True Else zFile_FolderExists = False End If Set oFso = Nothing End Function '======================================== Private Function zFile_GetListFromFolder(sFolder) 'This function returns an array with the names of all the files in a folder 'Usage: 'aFiles = zFile_GetListFromFolder(sFolder) 'NOTE the array starts from 1 because zero is used to indicate an empty folder 'The zeroth entry also holds the reason the folder is empty Dim oFso, oFolder, cFiles, oFile, aFiles(), iFile iFile = 0 ReDim aFiles(0) Set oFso = CreateObject("Scripting.FileSystemObject") If oFso.FolderExists(sFolder) Then Set oFolder = oFso.GetFolder(sFolder) Set cFiles = oFolder.Files If cFiles.Count > 0 Then For Each oFile In cFiles iFile = iFile + 1 ReDim Preserve aFiles(iFile) aFiles(iFile) = oFile.Name Next Else aFiles(0) = "No Files in Folder" End If Else aFiles(0) = "Folder does not exist" End If zFile_GetListFromFolder = aFiles End Function '========================================================================= |