Automating QTP Test Automation Home Automation Articles Downloads QTP Gotchas Links Books Contact About Site Map
Automate - Web - Generate DP V1.5If you find an error, or have a suggestion for improvement, Email me and I'll fix it. A simple example to start with. This code generates DP code for web pages that you can then cut and paste wherever you want into your scripts.
Duplicate names are detected and an index reference added. WARNING - Some web pages, especially those with a large number of controls or weblist entries take a LONG time to extract. You just save this code into a .qfl file, add it to your project and then 'Call GenDpV15' to run it.
It will ask you various questions and then generate a new .qfl file containing the DP 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.3 - Image link handling added 'V1.4 - Ini file processing added to remember user parameters 'V1.5 - Radio button handling added '=========================================== Public Sub GenDpV15 Dim sIni, sApp, sPage, sKey, sFile, sUrl, sPrompt sIni = "c:\Intellipro.ini" Call zQTP_MinimizeWindow Call SplashOpen(3) sApp = GetApp(sIni) sPage = GetPage(sIni, sApp) sKey = "App_" & sApp & "_" & sPage sFile = GetFile(sIni, sApp, sPage, sKey) sUrl = GetUrl(sIni, sKey) Call GetConf(sApp, sPage, sFile) Call zBro_Maximise Call GenOutput(sApp,sPage,sURL,sFile) Call zFile_OpenWithNotepad(sFile) Call SplashClose End Sub '======================================= Public Sub GenDpDirected(sFile,sUrl) 'Usage: 'Call GenDpDirected("C:\Program Files\HP\QuickTest Professional\Tests\GooglePage.qfl","www.google.com") Call zQTP_MinimizeWindow Call SplashOpen(3) Call zBro_CloseAll Call zBro_Open(sUrl) Call GenOutput("App","Directed",sURL,sFile) Call zBro_Close Call zFile_OpenWithNotepad(sFile) Call SplashClose End Sub '======================================= Public Sub GenDpNow(sFile) 'Usage: 'Call GenDpNow("C:\Program Files\HP\QuickTest Professional\Tests\_Test01.qfl") Dim sUrl Call zQTP_MinimizeWindow Call SplashOpen(3) sUrl = zBro_GetUrl Call GenOutput("App","Now",sURL,sFile) Call zFile_OpenWithNotepad(sFile) Call SplashClose End Sub '======================================= Private Function GetApp(sIniFile) Dim sApp sApp = GetIniCombo(sIniFile, "Enter App Name (3 - 4 characters are best)", "Apps", "App") GetApp = sApp End Function '======================================= Private Function GetPage(sIniFile, sApp) Dim sPage sPage = GetIniCombo(sIniFile, "Enter Page Name (3 - 4 characters are best)", "Page_" & sApp, "Page") GetPage = sPage End Function '======================================= Private Function [GetFile](sIniFile, sApp, sPage, sKey) Dim sFileName sFileName = "C:\Program Files\HP\QuickTest Professional\Tests\" & sApp & "_" & sPage & ".qfl" sFileName = zGen_GetIni(sIniFile, sKey, "File", sFileName) 'Get user to confirm file name sFileName = Inputbox ("Confirm generated file name:", "User Input Required", sFileName) If sFileName = "" Then Call ExitTest() End If 'Save the filename Call zGen_SetIni(sIniFile, sKey, "File", sFileName) GetFile = sFileName End Function '======================================= Private Function GetUrl(sIniFile, sKey) Dim iReply, sUrl 'Are we there yet? iReply = MsgBox ("Is the browser already open at the required page?", vbYesNo+vbQuestion+vbDefaultButton2, "User Input Required") If iReply = vbNo Then 'Get a default for the URL of the page required sUrl = zGen_GetIni(sIniFile, sKey, "Url", "www.google.com") 'Let the user change the value sUrl = Inputbox ("Enter the URL of the page required:", "User Input Required", sUrl) If sUrl = "" Then Call ExitTest() End If 'Close any open browsers Call zBro_CloseAll 'Open a browser and navigate to the required page Call zBro_Open(sUrl) Else 'We're already there - get the URL sUrl = zBro_GetUrl End If Call zGen_SetIni(sIniFile, sKey, "Url", sUrl) GetUrl = sUrl End Function '======================================= Private Sub GetConf(sApp, sPage, sFile) Dim sPrompt sPrompt = "App:" & sApp & VbCrLf & "Page:" & sPage & VbCrLf & "File:" & sFile & VbCrLf & "Generate code?" If MsgBox (sPrompt, vbOKCancel+vbDefaultButton1, "User Input Required") = vbCancel Then Call ExitTest() End If End Sub '======================================= Private Sub GenOutput(sApp,sPage,sURL,sFileName) Dim oFso, oFile Const ForWriting = 2, TristateTrue = -1 'Open the file (unicode) Set oFso = CreateObject("Scripting.FileSystemObject") Set oFile = oFso.OpenTextFile(sFileName, ForWriting, True, TristateTrue) 'Header oFile.WriteLine("Option Explicit") oFile.WriteLine("'--------------") oFile.WriteLine("") oFile.WriteLine("'Web Functions") oFile.WriteLine("") oFile.WriteLine("'For App: " & sApp) oFile.WriteLine("") oFile.WriteLine("'For Page: " & sPage) oFile.WriteLine("") oFile.WriteLine("'For URL: " & sURL) oFile.WriteLine("") oFile.WriteLine("'Generated by Intellipro DP code generator V1.5") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"=")) oFile.WriteLine("") oFile.WriteLine("Sub " & sApp & "Web_" & sPage & "_RefAllElements") 'Body oFile.WriteLine("") oFile.WriteLine(vbTab & "'Buttons:") Call ScanForButtons(oFile) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Text Boxes:") Call ScanForEdits(oFile) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Lists:") Call ScanForLists(oFile) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Checkboxes:") Call ScanForCheckboxes(oFile) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Radio Buttons:") Call ScanForRadios(oFile) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Links:") Call ScanForLinks(oFile) oFile.WriteLine("") oFile.WriteLine(vbTab & "'Images:") Call ScanForImages(oFile) 'Footer oFile.WriteLine("") oFile.WriteLine("End Sub") oFile.WriteLine("") oFile.WriteLine("'" & String(40,"#")) oFile.Close End Sub '======================================= Private Sub ScanForButtons(oFile) Call zGen_PopupMsg("Scanning for Buttons", 1) Dim oDesc, oColl, iCount, iIndex, asObj(999,2) 'Get the buttons Set oDesc = Description.Create oDesc("micclass").Value = "WebButton" Set oColl = Browser("micclass:=Browser").Page("micclass:=Page").ChildObjects(oDesc) iCount = oColl.Count If iCount = 0 Then oFile.WriteLine(vbTab & vbTab & "'None Found") Else 'Load Array For iIndex = 0 to iCount -1 asObj(iIndex,0) = oColl(iIndex).GetROProperty("name") Next Call FlagDuplicateNames(iCount,asObj) 'Process Each Button Call zGen_PopupMsg("Processing Buttons", 1) For iIndex = 0 to iCount -1 Call ProcessButton(oFile, asObj(iIndex,0), asObj(iIndex,1), asObj(iIndex,2)) Next End If End Sub '======================================== Private Sub ProcessButton(oFile, sName, iIndex, bDup) oFile.WriteLine(vbTab & "Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").WebButton(" & GenDpName(sName, iIndex, bDup) & ").Click" ) End Sub '======================================== Private Sub ScanForEdits(oFile) Call zGen_PopupMsg("Scanning for Edits", 1) Dim oDesc, oColl, iCount, iIndex, asObj(999,2) 'Get the Edits Set oDesc = Description.Create oDesc("micclass").Value = "WebEdit" Set oColl = Browser("micclass:=Browser").Page("micclass:=Page").ChildObjects(oDesc) iCount = oColl.Count If iCount = 0 Then oFile.WriteLine(vbTab & vbTab & "'None Found") Else 'Load Array For iIndex = 0 to iCount -1 asObj(iIndex,0) = oColl(iIndex).GetROProperty("name") Next Call FlagDuplicateNames(iCount,asObj) 'Process Each Edit Call zGen_PopupMsg("Processing Edits", 1) For iIndex = 0 to iCount -1 Call ProcessEdit(oFile, asObj(iIndex,0), asObj(iIndex,1), asObj(iIndex,2)) Next End If End Sub '======================================== Private Sub ProcessEdit(oFile, sName, iIndex, bDup) oFile.WriteLine(vbTab & "Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").WebEdit(" & GenDpName(sName, iIndex, bDup) & ").Set " & Chr(34) & "Xxx" & Chr(34)) End Sub '======================================== Private Sub ScanForLists(oFile) Call zGen_PopupMsg("Scanning for Lists", 1) Dim oDesc, oColl, iCount, iIndex, asObj(999,2) 'Get Lists Set oDesc = Description.Create oDesc("micclass").Value = "WebList" Set oColl = Browser("micclass:=Browser").Page("micclass:=Page").ChildObjects(oDesc) iCount = oColl.Count If iCount = 0 Then oFile.WriteLine(vbTab & vbTab & "'None Found") Else 'Load Array For iIndex = 0 to iCount -1 asObj(iIndex,0) = oColl(iIndex).GetROProperty("name") Next Call FlagDuplicateNames(iCount,asObj) 'Process each list Call zGen_PopupMsg("Processing Lists", 1) For iIndex = 0 to iCount -1 Call ProcessList(oFile, asObj(iIndex,0), asObj(iIndex,1), asObj(iIndex,2) ) Next End If End Sub '======================================== Private Sub ProcessList(oFile, sName, iIndex, bDup) Dim oList, iItemCount, iItemIndex, sValue, asValue(1000) Set oList = Description.Create oList("Class Name").value = "WebList" oList("name").value= zStr_MakeRegexSafe(sName) If bDup Then oList("index").value= cStr(iIndex) End If iItemCount = Browser("micclass:=Browser").Page("micclass:=Page").WebList(oList).GetROProperty("Items Count") 'Processing weblists can be slow If iItemCount > 10 Then Call zGen_PopupMsg("Phew! This list is hard work...(" & sName & ")", 1) End If For iItemIndex = 1 to iItemCount 'This is slow - display progress If (iItemCount > 50) And (iItemCount > 1) And ((iItemCount-iItemIndex) < 8) Then Call zGen_PopupMsg("Nearly there...(only " & cStr(iItemCount-iItemIndex) & " to go)", 1) ElseIf (iItemIndex/10) = Int(iItemIndex/10) Then Call zGen_PopupMsg("I'm getting there, pant..." & vbcrlf & space(10) & "(" & cStr(iItemIndex) & " of " & cStr(iItemCount) & ")", 1) End If asValue(iItemIndex) = Browser("micclass:=Browser").Page("micclass:=Page").WebList(oList).GetItem(iItemIndex) Next oFile.WriteLine(vbTab & "Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").WebList(" & GenDpName(sName, iIndex, bDup) & ").Select " & Chr(34) & asValue(1) & Chr(34)) If iItemCount > 1 Then For iItemIndex = 2 to iItemCount oFile.WriteLine(vbTab & "'Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").WebList(" & GenDpName(sName, iIndex, bDup) & ").Select " & Chr(34) & asValue(iItemIndex) & Chr(34)) Next End If oFile.WriteLine "" End Sub '======================================== Private Sub ScanForCheckboxes(oFile) Call zGen_PopupMsg("Scanning for Checkboxes", 1) 'Checkboxes need special processing... 'Sometimes value is used instead of name Dim oDesc, oColl, iCount, iIndex, asObj(999,4) 'Get Objects Set oDesc = Description.Create oDesc("micclass").Value = "WebCheckBox" Set oColl = Browser("micclass:=Browser").Page("micclass:=Page").ChildObjects(oDesc) iCount = oColl.Count If iCount = 0 Then oFile.WriteLine(vbTab & vbTab & "'None Found") Else 'Load Array For iIndex = 0 to iCount -1 asObj(iIndex,0) = oColl(iIndex).GetROProperty("name") asObj(iIndex,3) = oColl(iIndex).GetROProperty("value") Next Call FlagDuplicateNames(iCount,asObj) Call CheckboxArrayProc(iCount,asObj) 'Process Each CheckBox Call zGen_PopupMsg("Processing Checkboxes", 1) For iIndex = 0 to iCount -1 Call ProcessCheckbox(oFile, asObj(iIndex,0), asObj(iIndex,1), asObj(iIndex,2), asObj(iIndex,3), asObj(iIndex,4)) Next End If End Sub '======================================== Private Sub ProcessCheckbox(oFile, sName, iIndex, bDup, sValue, bUseValue) If bUseValue Then oFile.WriteLine(vbTab & "Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").WebCheckBox(" & GenDpNameX(sValue, iIndex, bDup) & ").Set " & Chr(34) & "ON" & Chr(34) ) oFile.WriteLine(vbTab & "'Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").WebCheckBox(" & GenDpNameX(sValue, iIndex, bDup) & ").Set " & Chr(34) & "OFF" & Chr(34) ) Else oFile.WriteLine(vbTab & "Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").WebCheckBox(" & GenDpName(sName, iIndex, bDup) & ").Set " & Chr(34) & "ON" & Chr(34) ) oFile.WriteLine(vbTab & "'Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").WebCheckBox(" & GenDpName(sName, iIndex, bDup) & ").Set " & Chr(34) & "OFF" & Chr(34) ) End If oFile.WriteLine("") End Sub '======================================== Private Sub ScanForImages(oFile) Call zGen_PopupMsg("Scanning for Images", 1) Dim oDesc, oColl, iCount, iIndex, asObj(999,4) 'Get the links Set oDesc = Description.Create oDesc("micclass").Value = "Image" oDesc("image type").value = "Image Link" 'Only process images with links Set oColl = Browser("micclass:=Browser").Page("micclass:=Page").ChildObjects(oDesc) iCount = oColl.Count If iCount = 0 Then oFile.WriteLine(vbTab & vbTab & "'None Found") Else 'Load Array For iIndex = 0 to iCount -1 asObj(iIndex,0) = oColl(iIndex).GetROProperty("name") asObj(iIndex,3) = oColl(iIndex).GetROProperty("href") 'where the image links to asObj(iIndex,4) = oColl(iIndex).GetROProperty("file name") 'the filename Next Call FlagDuplicateNames(iCount,asObj) 'Process Each Link Call zGen_PopupMsg("Processing Images", 1) For iIndex = 0 to iCount -1 Call ProcessImage(oFile, asObj(iIndex,0), asObj(iIndex,1), asObj(iIndex,2), asObj(iIndex,3), asObj(iIndex,4)) Next End If End Sub '======================================== Private Sub ProcessImage(oFile, sName, iIndex, bDup, sHref, sSource) 'It is useful to see where clicking on the image goes and the filename of the image used oFile.WriteLine(vbTab & "'Link: " & Left(sHref & Space(50),50) & " Image: " & sSource) oFile.WriteLine(vbTab & "Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").Image(" & GenDpName(sName, iIndex, bDup) & ").Click" ) oFile.WriteLine("") End Sub '======================================== Private Sub ScanForLinks(oFile) Call zGen_PopupMsg("Scanning for Links", 1) Dim oDesc, oColl, iCount, iIndex, asObj(999,2) 'Get the links Set oDesc = Description.Create oDesc("micclass").Value = "Link" Set oColl = Browser("micclass:=Browser").Page("micclass:=Page").ChildObjects(oDesc) iCount = oColl.Count If iCount = 0 Then oFile.WriteLine(vbTab & vbTab & "'None Found") Else If iCount > 100 Then Call zGen_PopupMsg("Arghhhhh!, so many links, so little time...(" & cStr(iCount) & ")", 1) End If 'Load Array For iIndex = 0 to iCount -1 asObj(iIndex,0) = oColl(iIndex).GetROProperty("name") Next Call FlagDuplicateNames(iCount,asObj) 'Process Each Link Call zGen_PopupMsg("Processing Links", 1) For iIndex = 0 to iCount -1 Call ProcessLink(oFile, asObj(iIndex,0), asObj(iIndex,1), asObj(iIndex,2)) Next End If End Sub '======================================== Private Sub ProcessLink(oFile, sName, iIndex, bDup) oFile.WriteLine(vbTab & "Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").Link(" & GenDpName(sName, iIndex, bDup) & ").Click" ) End Sub '======================================== Private Sub zBro_CloseAll Dim oBrowserDesc, oBrowsers, iBrowserCount, iBrowserIndex Set oBrowserDesc = Description.Create oBrowserDesc("micclass").Value = "Browser" Set oBrowsers = Desktop.ChildObjects(oBrowserDesc) iBrowserCount = oBrowsers.Count If iBrowserCount > 0 Then Call zGen_PopupMsg("What are all these browsers doing open?", 1) For iBrowserIndex = 0 To iBrowserCount - 1 oBrowsers(iBrowserIndex).Close Next Call zGen_PopupMsg("That's better", 1) End If Set oBrowsers = Nothing Set oBrowserDesc = Nothing End Sub '======================================== Private Sub zBro_Open(sUrl) SystemUtil.Run "iexplore", sURL Browser("micclass:=Browser").Page("micclass:=Page").Sync End Sub '======================================== Private Sub zBro_Close Browser("micclass:=Browser").Close End Sub '======================================== Private Function zBro_GetUrl zBro_GetUrl = Browser("micclass:=Browser").Page("micclass:=Page").GetRoProperty("URL") End Function '======================================== Private Sub zBro_Maximise Dim hWnd Call zGen_PopupMsg("Ok, now let me see...", 2) hWnd = Browser("micclass:=Browser").GetROProperty("hwnd") Window("hwnd:=" & hWnd).Maximize Call zGen_PopupMsg("That's better", 1) End Sub '======================================== 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 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 Sub zQTP_MinimizeWindow Dim oApp Call zGen_PopupMsg("I'm going to hide while I'm doing this...", 2) Set oApp = GetObject("","QuickTest.Application") oApp.WindowState = "Minimized" Set oApp = Nothing End Sub '======================================== Private Sub zFile_OpenWithNotepad(sFile) SystemUtil.Run "C:\WINDOWS\system32\notepad.exe", sFile End Sub '======================================== Private Sub CheckboxArrayProc(iCount,asObj) Dim iIndex1, iIndex2 'Initialise For iIndex1 = 0 to iCount -1 If asObj(iIndex1,0) = "" Then 'Blank Name detected asObj(iIndex1,4) = True 'Set flag to use Value instead Else asObj(iIndex1,4) = False End If Next 'Scan For iIndex1 = 0 to iCount -2 If asObj(iIndex1,4) Then 'Using Value not name For iIndex2 = iIndex1+1 to iCount -1 If asObj(iIndex1,3) = asObj(iIndex2,3) Then 'Compare Values not Names 'Duplicate value detected 'Set flags asObj(iIndex1,2) = True asObj(iIndex2,2) = True 'Dynamically assign the index values asObj(iIndex2,1) = asObj(iIndex1,1) + 1 End If Next End If Next End Sub '======================================== Private Sub FlagDuplicateNames(iCount,asObj) 'Detect Duplicate Names in objects Dim iIndex1, iIndex2 'Initialise For iIndex1 = 0 to iCount -1 asObj(iIndex1,1) = 0 asObj(iIndex1,2) = False Next 'Scan For iIndex1 = 0 to iCount -2 For iIndex2 = iIndex1+1 to iCount -1 If asObj(iIndex1,0) = asObj(iIndex2,0) Then 'Duplicate name detected 'Set flags asObj(iIndex1,2) = True asObj(iIndex2,2) = True 'Dynamically assign the index values asObj(iIndex2,1) = asObj(iIndex1,1) + 1 End If Next Next End Sub '======================================== Private Function GenDpNameX(sValue, iIndex, bDup) If bDup Then GenDpNameX = Chr(34) & "value:=" & zStr_MakeRegexSafe(sValue) & Chr(34) & "," & Chr(34) & "index:=" & cStr(iIndex) & Chr(34) Else GenDpNameX = Chr(34) & "value:=" & zStr_MakeRegexSafe(sValue) & Chr(34) End If End Function '======================================== Private Function GenDpName(sName, iIndex, bDup) If bDup Then GenDpName = Chr(34) & "name:=" & zStr_MakeRegexSafe(sName) & Chr(34) & "," & Chr(34) & "index:=" & cStr(iIndex) & Chr(34) Else GenDpName = Chr(34) & "name:=" & zStr_MakeRegexSafe(sName) & Chr(34) End If End Function '======================================== Private Function zStr_MakeRegexSafe(sInput) 'DP handles regular expressions 'So "$" is handled as 'Matches the end of input' 'These have to be 'escaped' by prefixing them with a backward slash (\) 'So change all occurences of '$' to "\$" etc. 'Characters to process are: '$, (, ), *, +, ., [, ?, ^, {, | Dim sOutput sOutput = sInput sOutput = Replace(sOutput, "$", "\$") sOutput = Replace(sOutput, "(", "\(") sOutput = Replace(sOutput, ")", "\)") sOutput = Replace(sOutput, "*", "\*") sOutput = Replace(sOutput, "+", "\+") sOutput = Replace(sOutput, ".", "\.") sOutput = Replace(sOutput, "[", "\[") sOutput = Replace(sOutput, "?", "\?") sOutput = Replace(sOutput, "^", "\^") sOutput = Replace(sOutput, "{", "\{") sOutput = Replace(sOutput, "|", "\|") zStr_MakeRegexSafe = sOutput End Function '======================================== Private Function GetIniCombo(sIniFile, sTitle, sSection, sKey) Dim iCount, sValue, sReply, oFrm, oBtn, oCbo, x, y, posn, iLoop, asList(100), iReply Dim sGenKey, sGenData 'Get the last general reference if any sValue = zGen_GetIni(sIniFile, sSection, sKey, sKey) 'Get the count iCount = cInt(zGen_GetIni(sIniFile, sSection, sKey & "Count" , "0")) If iCount = 0 Then 'A new case, use an input box sReply = Inputbox (sTitle, "User Input Required", sValue) If sReply = "" Then 'User Abort... Call ExitTest() End If 'Start populating the list Call zGen_SetIni(sIniFile, sSection, sKey & "Count", "01") Call zGen_SetIni(sIniFile, sSection, sKey & "01", sReply) Else 'Set up a screen with a combobox Set oFrm = DotNetFactory.CreateInstance("System.Windows.Forms.Form", "System.Windows.Forms") Set oBtn = DotNetFactory.CreateInstance("System.Windows.Forms.Button", "System.Windows.Forms") Set oCbo = DotNetFactory.CreateInstance("System.Windows.Forms.ComboBox", "System.Windows.Forms") x = 10 y = 10 Set posn = DotNetFactory.CreateInstance("System.Drawing.Point", "System.Drawing", x, y) 'Populate the array and combo For iLoop = 1 to iCount sGenKey = sKey & Right("00" & cStr(iLoop),2) sGenData = zGen_GetIni(sIniFile, sSection, sGenKey , "Gen") asList(iLoop) = sGenData oCbo.Items.Add sGenData If sGenData = sValue Then 'Set the default value to the value the user chose last time oCbo.Text = sGenData End If Next oCbo.Location = posn posn.X = 60 posn.Y = 30 oBtn.Text = "OK" posn.Y = CInt(oCbo.Height) + 20 oBtn.Location = posn oFrm.AcceptButton = oBtn oFrm.CancelButton = oBtn oFrm.Controls.Add(oBtn) oFrm.Controls.Add(oCbo) oFrm.Width = 500 oFrm.Text = sTitle oFrm.Topmost = True oFrm.ShowDialog sReply = oCbo.Text If sReply = "" Then 'User Abort... Call ExitTest() End If 'Has the user chosen from the list or entered a new value? 'Scan the array iReply = 0 For iLoop = 1 to iCount If sReply = asList(iLoop) Then iReply = iLoop Exit For End If Next If iReply = 0 Then 'User has entered a new value, add it to the list Call zGen_SetIni(sIniFile, sSection, sKey & "Count", cStr(iCount+1)) Call zGen_SetIni(sIniFile, sSection, sKey & Right("00" & cStr(iCount+1),2),sReply) 'Else 'User has chosen an existing value - no action required End If End If 'Save the value for future defaults Call zGen_SetIni(sIniFile, sSection, sKey, sReply) 'Return the value GetIniCombo = sReply End Function '======================================== Private Sub ScanForRadios(oFile) Call zGen_PopupMsg("Scanning for Radio Buttons", 1) Dim sHtml, iButtonCount, iGroupCount, oDesc, oColl, iGroupIndex, asObj(999,2), sName, iIndex, bDup, aButtonData 'Any buttons at all? sHtml = zHtm_Get If InStr(sHtml," type=radio ") = 0 Then oFile.WriteLine(vbTab & vbTab & "'None Found") Exit Sub End If 'How many? iButtonCount = zStr_Count(sHtml, " type=radio ") oFile.WriteLine(vbTab & vbTab & "'" & cStr(iButtonCount) & " Found...") 'Get the groups Set oDesc = Description.Create oDesc("micclass").Value = "WebRadioGroup" Set oColl = Browser("micclass:=Browser").Page("micclass:=Page").ChildObjects(oDesc) iGroupCount = oColl.Count oFile.WriteLine(vbTab & vbTab& vbTab & "'In " & cStr(iGroupCount) & " Group(s)...") 'Load Group Array For iGroupIndex = 0 to iGroupCount -1 asObj(iGroupIndex,0) = oColl(iGroupIndex).GetROProperty("name") Next Call FlagDuplicateNames(iGroupCount,asObj) 'Load data from html aButtonData = LoadRadioData(sHtml,iButtonCount) 'Process Each Group Call zGen_PopupMsg("Processing Radio Buttons", 1) For iGroupIndex = 0 to iGroupCount -1 Call ProcessRadio(oFile,asObj(iGroupIndex,0),asObj(iGroupIndex,1),asObj(iGroupIndex,2), aButtonData) Next End Sub '======================================== Private Sub ProcessRadio(oFile, sGroupName, iIndex, bDup, aButtonData) Dim iButtonIndex, iButtonMax, sBase, sButtonName, sButtonValue, bButtonProc, sLine sBase = vbTab & "Browser(" & Chr(34) & "micclass:=Browser" & Chr(34) & ").Page(" & Chr(34) & "micclass:=Page" & Chr(34) & ").WebRadioGroup(" oFile.WriteLine("") oFile.WriteLine(vbTab & "'For Button Group : " & sGroupName) oFile.WriteLine("") 'Process all the buttons in the group iButtonMax = Ubound(aButtonData) For iButtonIndex = 1 To iButtonMax sButtonName = aButtonData(iButtonIndex,0) sButtonValue = aButtonData(iButtonIndex,1) bButtonProc = aButtonData(iButtonIndex,2) If Not bButtonProc Then 'No, We haven't processed this button yet If sButtonName = sGroupName Then 'Yes, it's in the right group aButtonData(iButtonIndex,2) = True 'don't process it again sLine = sBase & GenDpName(sGroupName, iIndex, bDup) & ").Select " & Chr(34) & sButtonValue & Chr(34) oFile.WriteLine(sLine) End If End If Next End Sub '======================================== Private Function LoadRadioData(sHtml,iButtonCount) Dim aData, sTemp, iButtonIndex, sCtrl, sName, sValue ReDim aData(iButtonCount,2) sTemp = sHtml For iButtonIndex = 1 To iButtonCount sCtrl = ExtractRadioControl(sTemp) sName = ExtractRadioName(sCtrl) sValue = ExtractRadioValue(sCtrl) aData(iButtonIndex,0) = sName aData(iButtonIndex,1) = sValue aData(iButtonIndex,2) = False Next LoadRadioData = aData End Function '======================================== Function ExtractRadioControl(sInput) Dim sTemp, iPosn, iLeft, iRight, sCtrl, sLeft, sRight sTemp = sInput iPosn = InStr(sTemp," type=radio ") iLeft = CrawlLeft(sTemp,iPosn,"<") iRight = CrawlRight(sTemp,iPosn,">") sCtrl = Mid(sTemp,iLeft,iRight-iLeft) 'Remove control from string so we don't pick it up next time sLeft = Left(sTemp,iLeft-1) sRight = Mid(sTemp,iRight+1) sInput = sLeft & sRight ExtractRadioControl = sCtrl End Function '======================================== Private Function zHtm_Get zHtm_Get = Browser("micclass:=Browser").object.document.documentElement.outerHTML 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 CrawlLeft(sTarget,iStart,sSrch) Dim iMax, iLoop, iSrchLen, sChunk CrawlLeft = 0 iSrchLen = Len(sSrch) 'iMax = Len(sTarget) - iStart For iLoop = iStart To 1 Step -1 sChunk = Mid(sTarget,iLoop,iSrchLen) If sChunk = sSrch Then CrawlLeft = iLoop Exit For End If Next End Function '======================================== Private Function CrawlRight(sTarget,iStart,sSrch) Dim iMax, iLoop, iSrchLen, sChunk CrawlRight = 0 iSrchLen = Len(sSrch) iMax = Len(sTarget) For iLoop = iStart To iMax sChunk = Mid(sTarget,iLoop,iSrchLen) If sChunk = sSrch Then CrawlRight = iLoop Exit For End If Next End Function '======================================== Private Function ExtractRadioValue(sCtrl) 'Assumes the value cannot contain a space character Dim sNoName, iPosn, sTemp ExtractRadioValue = "" sNoName = " value=" & Chr(34) & Chr(34) & " " If InStr(sCtrl,sNoName) > 0 Then ExtractRadioValue = "#0" Else iPosn = InStr(sCtrl," value=") If iPosn > 0 Then sTemp = Mid(sCtrl,iPosn+7) iPosn = InStr(sTemp," ") If iPosn > 0 Then ExtractRadioValue = Left(sTemp,iPosn-1) End If End If End If End Function '======================================== Private Function ExtractRadioName(sCtrl) 'Assumes name is always at end of control Dim iPosn ExtractRadioName = "" iPosn = InStr(sCtrl," name=") If iPosn > 0 Then ExtractRadioName = Mid(sCtrl,iPosn+6) End If End Function '======================================== Private Sub SplashOpen(iDelay) Dim sHtml sHtml = "<html><head></head><body>" sHtml = sHtml & "Welcome to:<br><br>" sHtml = sHtml & "<h2><strong>Gen DP V1.5 by Intellipro</strong></h2>" sHtml = sHtml & "For more useful things like this, go to:<br><br>" sHtml = sHtml & " Web: <a href=" & Chr(34) & "http://www.intellipro.co.uk" & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">http://www.intellipro.co.uk</a><br><br>" sHtml = sHtml & "If you have suggestions for improvements, contact me at:<br><br>" sHtml = sHtml & " Email: <a href=" & Chr(34) & "mailto:rossw@intellipro.co.uk" & Chr(34) & ">rossw.intellipro.co.uk</a><br><br><br>" sHtml = sHtml & "Copyright © 2009 Intellipro Services Ltd. All rights reserved" sHtml = sHtml & "</body></html>" Call Splash(sHtml, iDelay, 500, 350) End Sub '======================================== Private Sub SplashClose Dim sHtml sHtml = "<html><head></head><body>" sHtml = sHtml & "Thank you for using:<br><br>" sHtml = sHtml & "<h2><strong> Gen DP V1.5 by Intellipro</strong></h2>" sHtml = sHtml & "For more useful things like this, go to:<br><br>" sHtml = sHtml & " Web: <a href=" & Chr(34) & "http://www.intellipro.co.uk" & Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">http://www.intellipro.co.uk</a><br><br>" sHtml = sHtml & "If you have suggestions for improvements, contact me at:<br><br>" sHtml = sHtml & " Email: <a href=" & Chr(34) & "mailto:rossw@intellipro.co.uk" & Chr(34) & ">rossw.intellipro.co.uk</a><br><br><br>" sHtml = sHtml & "Copyright © 2009 Intellipro Services Ltd. All rights reserved" sHtml = sHtml & "</body></html>" Call Splash(sHtml, 0, 500, 350) End Sub '======================================== Private Sub Splash(sHtml, iDelay, iWidth, iHeight) Dim oWMIService, cItems, oItem, iScrWidth, iScrHeight, oIE 'Get screen size Set oWMIService = GetObject("Winmgmts:\\.\root\cimv2") Set cItems = oWMIService.ExecQuery("Select * From Win32_DesktopMonitor where DeviceID = 'DesktopMonitor1'",,0) For Each oItem in cItems iScrWidth = oItem.ScreenWidth iScrHeight = oItem.ScreenHeight Next 'Show it Set oIE = CreateObject("InternetExplorer.Application") oIE.Navigate "about:blank" oIE.Document.body.innerHTML = sHtml oIE.Toolbar = False oIE.StatusBar = False oIE.MenuBar = False oIE.Height = iHeight oIE.Width = iWidth oIE.Top = (iScrHeight-iHeight)/2 oIE.Left = (iScrWidth-iWidth)/2 oIE.Visible = True If iDelay > 0 Then Wait iDelay oIE.Quit Set oIE = Nothing End If End Sub '========================================================================= |