If you are trying to access a project in SourceForge using an SVN client and you see something like "Could not open requested SVN filesystem" then it is possible that the project's SVN access is not enabled. See this link on how to enable SVN. Note that you need to have admin privileges to a particular project to enable SVN.
~TS
Sunday, November 02, 2008
Enable SVN access to Sourceforge project
SVN repository is not enabled by default when creating a project in SourceForge. To enable SVN is easy. Go to the summary page, see below for sample screen shot, then hover to Admin tab.
You should see the screen below, then just enable "The following box should be checked to enable Subversion" and Update and off you go.
Enjoy!
TS
Enjoy!
TS
Sourceforge links of interest
Some useful links for SourceForge users.
Quickstart Guide to Subversion on SourceForge
Recommended Software Configuration - this includes how to configure SVN clients, cvs and many more.
~TS
Quickstart Guide to Subversion on SourceForge
Recommended Software Configuration - this includes how to configure SVN clients, cvs and many more.
~TS
Thursday, October 30, 2008
Changing Eclipse text editor font
Working long hours tinkering with code can greatly strain your eyes. I think this is the reason why most programmers are so picky with the font they are using. I spend quite a lot of time looking for the best font (my personal best). Proggy fonts are quite good, so is Envy Code R.
But for quite sometime, I believe more than a year, I developed love and hate relationship with Consolas. This font is optimized for Microsoft ClearType. The problem is not all of the machines I used are upgraded to RDP 6.x clients. Older remote desktop clients does not support ClearType, so I have to use non-cleartype friendly fonts. Courier New is good candidate but most of the time I settle with Proggy fonts.
Anyway, to use Consolas in Eclipse 3.4.1 (Ganymede) is easy and oh note that this font is designed for VS2005 and VS2008. Just hit on Windows | Prerences | General | Appearance | Colors and Fonts | Basic | Text Font. See below for screen shot where to access this option.
Step 1: Window | Preferences.
Step 2: Select Text Font under "Basic" root node.
Step 3: Select the desired font. In this case, I'm gonna use Consolas.
Enjoy!
TS
But for quite sometime, I believe more than a year, I developed love and hate relationship with Consolas. This font is optimized for Microsoft ClearType. The problem is not all of the machines I used are upgraded to RDP 6.x clients. Older remote desktop clients does not support ClearType, so I have to use non-cleartype friendly fonts. Courier New is good candidate but most of the time I settle with Proggy fonts.
Anyway, to use Consolas in Eclipse 3.4.1 (Ganymede) is easy and oh note that this font is designed for VS2005 and VS2008. Just hit on Windows | Prerences | General | Appearance | Colors and Fonts | Basic | Text Font. See below for screen shot where to access this option.
Step 1: Window | Preferences.
Step 2: Select Text Font under "Basic" root node.
Step 3: Select the desired font. In this case, I'm gonna use Consolas.
Enjoy!
TS
Monday, October 27, 2008
TestPartner .Net Fusion
Yesterday, I came across a Microsoft website discussing .Net and Visual Basic 6.0 integration, they dubbed this as VB Fusion. Skimming through the documentation, I came to realize that most of these stuff can be used in TestPartner.
That is where my journey into the world of .Net with TestPartner, which I dubbed as TestPartner .Net Fusion, comes alive. I am planning on making this as a series of blogs discussing the ins and outs of integrating .Net functionality into TestPartner 6.1.x.
For this blog post will try to get our hands wet into the world of .Net integration using System assembly. In fact, what we will do is re-implement what's being dicussed in this site into TestPartner. In a nutshell, we want to display an image downloaded automatically from Space Science and Engineering Center, University of Wisconsin-Madison. We'll grab the latest photo from the east coast of the United States using the System assembly.
So let us create a new form in Common project in TestPartner, call this frmTest. Default form properties should be fine. Drop couple of controls, let's put in command button and image control. Add a code behind form for the command button. It should look like this:
It should point to C:\WINDOWS\Microsoft.NET\Framework\v2.0.50727\system.tlb. It is possible that System.dll is not registered as COM object. So to fix this run:
Now, we are getting real close. Before creating our test script, check that your form looks somewhat what is shown below:
Now, let us create a test script that will make use of the form, see below for a sample code:
Enjoy!
TS
That is where my journey into the world of .Net with TestPartner, which I dubbed as TestPartner .Net Fusion, comes alive. I am planning on making this as a series of blogs discussing the ins and outs of integrating .Net functionality into TestPartner 6.1.x.
For this blog post will try to get our hands wet into the world of .Net integration using System assembly. In fact, what we will do is re-implement what's being dicussed in this site into TestPartner. In a nutshell, we want to display an image downloaded automatically from Space Science and Engineering Center, University of Wisconsin-Madison. We'll grab the latest photo from the east coast of the United States using the System assembly.
So let us create a new form in Common project in TestPartner, call this frmTest. Default form properties should be fine. Drop couple of controls, let's put in command button and image control. Add a code behind form for the command button. It should look like this:
Private Sub CommandButton1_Click()
Dim webDownload As System.WebClient
Set webDownload = New System.WebClient
webDownload.downloadFile _
"http://www.ssec.wisc.edu/data/east/latest_eastir.gif", _
"D:" & "\latest_westir.jpg"
Set Image1.Picture = LoadPicture("D:\latest_westir.jpg")
frmTest.ScrollHeight = Image1.Height + Image1.Top
frmTest.ScrollWidth = Image1.Width + Image1.Left
End Sub
For this to work, we need to set a reference to System.tlb. See below:
C:\>regasm "C:\WINDOWS\Microsoft.NET\Framework\v2.0.50727\system.dll"
Now, we are getting real close. Before creating our test script, check that your form looks somewhat what is shown below:
Option Explicit
Sub Main()
Include "Common.frmTest"
frmTest.Show
End Sub
Hit on run and viola! You should have the latest weather update from the east coast of the United States. Here is how mine looks:
TS
Sunday, October 26, 2008
Controlling Popup menu using Accessibility API
In my previous post I discussed about using Accessibility API to control Windows Start Menu. For this blogpost exercise we will control a popup menu using AA.
For those who are familiar with VBA, they would know outright that class modules cannot use AddressOf operator within the class definition. In the spirit of Object Oriented programming, it would have been better to use solely class module for this but due to AddressOf requirements that it should be in a module then we will try to mix and match using both Class module and a module. The code is not a elegant as I hope it would be but this is the way VBA was designed.
Now let us get our hands dirty, first we will create a class module named CPopupMenuController. This is a very simple class module, in the initialization section we set a hook to receive focus events coming from the system and remove the hook once the object is destroyed. See below for the code:
MPopupMenuController does the workhorse for this implementation, basically it houses the function when we set a hook to focus events. The module is also responsible for sending key sequences. See below for the code, save this as MPopupMenuController:
Notice that we use custom error constant to raise an error to the system. The constants are defined in a module named CustomErrorConstants, see below for the code.
Now the fun part, how to use? See below for a sample code.
Note that the above code is geared towards TestPartner 6.1.x. It is a functional test automation and a VBA host. This should work with minor modification to any VBA hosts like Excel, MSAcess ..etc.
Enjoy!
TS
For those who are familiar with VBA, they would know outright that class modules cannot use AddressOf operator within the class definition. In the spirit of Object Oriented programming, it would have been better to use solely class module for this but due to AddressOf requirements that it should be in a module then we will try to mix and match using both Class module and a module. The code is not a elegant as I hope it would be but this is the way VBA was designed.
Now let us get our hands dirty, first we will create a class module named CPopupMenuController. This is a very simple class module, in the initialization section we set a hook to receive focus events coming from the system and remove the hook once the object is destroyed. See below for the code:
'------------------------------------------------------------------------------ ' Developed by : Techno.Scavenger ' Licensed to : Mankind ' Date : 26Oct2008 @ 3:06 PM + 8 GMT (Sunday @home) ' Warranty ' THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL ' “Techno.Scavenger” OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY CLAIM, ' DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR ' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE ' USE OR OTHER DEALINGS IN THE SOFTWARE. ' Note: ' You can do whatever with this code '------------------------------------------------------------------------------ 'References: 'http://msdn.microsoft.com/en-us/library/ms697639(VS.85).aspx 'http://www.microsoft.com/downloads/details.aspx?familyid=3755582A-A707-460A-BF21-1373316E13F0&displaylang=en 'http://support.microsoft.com/kb/315519 'http://blogs.msdn.com/oldnewthing/archive/2004/04/23/118893.aspx 'http://www.eggheadcafe.com/software/aspnet/32676356/toolbarwindow32-button-in.aspx 'http://msdn.microsoft.com/en-us/library/ms696152(VS.85).aspx 'http://msdn.microsoft.com/en-us/library/ms971323.aspx 'Caret Tracking 'http://www.geocities.com/krishnapg/EventTracking.html '------------------------------------------------------- 'Visual Basic Related 'http://www.brainbell.com/tutors/Visual_Basic/Retrieving_Accessibility_Information.htm 'sample code with hooks to AA 'http://www.eggheadcafe.com/software/aspnet/31694003/please-help-ie-window-do.aspx 'http://www.jsware.net/jsware/vbcode.php5#acc 'Notes: 'Seems like in VB, there is no need to call VariantClear for variants defined as [out] in API. Option Explicit 'references 'Accessibility - oleacc.dll Private Declare Function AccessibleObjectFromEvent Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByVal dwChildId As Long, ppacc As IAccessible, pvarChild As Variant) As Long Private Declare Sub OutputDebugString Lib "kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As String) Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long Private Declare Function UnhookWinEvent Lib "user32.dll" (ByVal lHandle As Long) As Long 'event constants Private Const EVENT_OBJECT_CREATE = &H8000& ' // hwnd + ID + idChild is created item Private Const EVENT_OBJECT_DESTROY = &H8001& '// hwnd + ID + idChild is destroyed item Private Const EVENT_OBJECT_SHOW = &H8002& '// hwnd + ID + idChild is shown item Private Const EVENT_OBJECT_HIDE = &H8003& '// hwnd + ID + idChild is hidden item Private Const EVENT_OBJECT_FOCUS = &H8005& '// hwnd + ID + idChild is focused item Private Const EVENT_OBJECT_LOCATIONCHANGE = &H800B& '// hwnd + ID + idChild is moved/sized item Private Const WINEVENT_OUTOFCONTEXT = &H0& '// Events are ASYNC Private Const WINEVENT_SKIPOWNPROCESS = &H2& '// Don't call back for events on installer's process 'class private stuff Private m_hHook As Long Private m_sMenuPath As String Private Sub Class_Initialize() Include "Common.MPopupMenuController" m_hHook = SetWinEventHook(EVENT_OBJECT_FOCUS, EVENT_OBJECT_FOCUS, 0&, AddressOf MPopupMenuController.WinEventFunc, 0, 0, WINEVENT_SKIPOWNPROCESS) End Sub Private Sub Class_Terminate() Dim lRet As Long If m_hHook <> 0 Then lRet = UnhookWinEvent(m_hHook) End If End Sub Public Sub SelectMenu(sMenuPath As String) MPopupMenuController.SelectMenu sMenuPath End Sub
MPopupMenuController does the workhorse for this implementation, basically it houses the function when we set a hook to focus events. The module is also responsible for sending key sequences. See below for the code, save this as MPopupMenuController:
'------------------------------------------------------------------------------
' Developed by : Techno.Scavenger
' Licensed to : Mankind
' Date : 26Oct2008 @ 3:06 PM + 8 GMT (Sunday @home)
' Warranty
' THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
' “Techno.Scavenger” OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY CLAIM,
' DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE
' USE OR OTHER DEALINGS IN THE SOFTWARE.
' Note:
' You can do whatever with this code
'------------------------------------------------------------------------------
'references
'Accessibility - oleacc.dll
Option Explicit
Private Declare Function AccessibleObjectFromEvent Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByVal dwChildId As Long, ppacc As IAccessible, pvarChild As Variant) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub OutputDebugString Lib "kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As String)
Private Declare Sub SleepEx Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
'key constants
Private Const KEYEVENTF_KEYUP = 2
Private Const vbKeyControl = 17
Private Const vbKeyEscape = 27
'event constants
Private Const EVENT_OBJECT_CREATE = &H8000& '// hwnd + ID + idChild is created item
Private Const EVENT_OBJECT_DESTROY = &H8001& '// hwnd + ID + idChild is destroyed item
Private Const EVENT_OBJECT_SHOW = &H8002& '// hwnd + ID + idChild is shown item
Private Const EVENT_OBJECT_HIDE = &H8003& '// hwnd + ID + idChild is hidden item
Private Const EVENT_OBJECT_FOCUS = &H8005& '// hwnd + ID + idChild is focused item
Private Const EVENT_OBJECT_LOCATIONCHANGE = &H800B& '// hwnd + ID + idChild is moved/sized item
'private data
Private m_sMenuPath As String
Private m_sActiveItem As String
Public Function WinEventFunc(ByVal hHook As Long, ByVal lEvent As Long, ByVal hwnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
Dim ObA As IAccessible
Dim lRet As Long
Dim v As Variant
Dim s As String, s1 As String, sName As String
Dim sTmp As String
On Error Resume Next
sTmp = "TS"
Select Case lEvent
'Case EVENT_OBJECT_CREATE, EVENT_OBJECT_DESTROY, EVENT_OBJECT_SHOW, EVENT_OBJECT_HIDE, EVENT_OBJECT_FOCUS, EVENT_OBJECT_LOCATIONCHANGE
Case EVENT_OBJECT_FOCUS
lRet = AccessibleObjectFromEvent(hwnd, idObject, idChild, ObA, v)
If lRet = 0 Then
sTmp = sTmp & ":Name:<" & ObA.accName(v)
sTmp = sTmp & ">:Description:< " & ObA.accDescription(v)
sTmp = sTmp & ">:Role<: " & ObA.accRole(v)
sTmp = sTmp & ">:State<: " & ObA.accState(v)
sTmp = sTmp & ">:menu<: " & m_sMenuPath
m_sActiveItem = ObA.accName(v)
End If
OutputDebugString sTmp
End Select
WinEventFunc = 0
End Function
Public Sub SelectMenu(sMenuPath As String)
m_sMenuPath = sMenuPath
PopupMenuEx sMenuPath
End Sub
Private Sub PopupMenuEx(sMenuPath As String)
Const MAX_LOOPS = 50
Dim vMenu As Variant
Dim iDx As Integer
Dim sMenuBookMark As String
Dim iTerminateCounter
vMenu = Split(sMenuPath, "~")
Call keybd_event(vbKeyControl, 0, 0, 0)
Call keybd_event(vbKeyEscape, 0, 0, 0)
' Release the two keys
Call keybd_event(vbKeyControl, 0, KEYEVENTF_KEYUP, 0)
Call keybd_event(vbKeyEscape, 0, KEYEVENTF_KEYUP, 0)
SleepEx 1000
For iDx = 0 To UBound(vMenu)
Do While m_sActiveItem <> vMenu(iDx)
OutputDebugString "TS: Sending DOWN key"
SendKeys "{DOWN}", True
SleepEx 1000
'set book on first loop thru menu indexes
If sMenuBookMark = "" Then
sMenuBookMark = m_sActiveItem
Else
'if we are here, then this must have been after one round
'we have come full circle, need to raise an error
If m_sActiveItem = sMenuBookMark Then
OutputDebugString "TS: We have come full circle, raising an error"
Include "Common.CustomErrorConstants"
Err.Raise CustomErrorConstants.vbErrMenuNotFound, "MPopupMenuController", "Menu was not found"
End If
End If
'another check if we have gone wild
iTerminateCounter = iTerminateCounter + 1
If iTerminateCounter >= MAX_LOOPS Then
OutputDebugString "TS:Max loops detected, raising an error"
Err.Raise CustomErrorConstants.vbErrMenuNotFound, "MPopupMenuController", "Menu was not found"
End If
Loop
'clear bookmark
sMenuBookMark = ""
'reset terminate marker
iTerminateCounter = 0
'move to next menu
OutputDebugString "TS:Sending RIGHT key"
SendKeys "{RIGHT}", True
Next
'assume we found the item, then hit on enter key
If vMenu(UBound(vMenu)) = m_sActiveItem Then
OutputDebugString "TS: We are about to run " & m_sActiveItem
SendKeys "~", True
Else
MsgBox "nah, not found"
End If
End Sub
Notice that we use custom error constant to raise an error to the system. The constants are defined in a module named CustomErrorConstants, see below for the code.
'------------------------------------------------------------------------------ ' Developed by : Techno.Scavenger ' Licensed to : Mankind ' Date : 26Oct2008 @ 1:39 AM + 8 GMT (Sunday @home) ' Warranty ' THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL ' “Techno.Scavenger” OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY CLAIM, ' DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR ' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE ' USE OR OTHER DEALINGS IN THE SOFTWARE. ' Note: ' You can do whatever with this code '------------------------------------------------------------------------------ Option Explicit 'Menu not found Public Const vbErrMenuNotFound = vbObjectError + 4
Now the fun part, how to use? See below for a sample code.
'------------------------------------------------------------------------------
' Developed by : Techno.Scavenger
' Licensed to : Mankind
' Date : 26Oct2008 @ 3:06 PM + 8 GMT (Sunday @home)
' Warranty
' THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
' “Techno.Scavenger” OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY CLAIM,
' DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE
' USE OR OTHER DEALINGS IN THE SOFTWARE.
' Note:
' You can do whatever with this code
'------------------------------------------------------------------------------
Option Explicit
Sub Main()
Window("Application=EXPLORER.EXE Caption=NewFolder").Attach
ListView("Index=1").Click 16, 295, tpMouseRight
Include "Common.CPopupMenuController"
Dim sm As CPopupMenuController
Set sm = New CPopupMenuController
sm.SelectMenu "New~Folder"
Set sm = Nothing
End Sub
Note that the above code is geared towards TestPartner 6.1.x. It is a functional test automation and a VBA host. This should work with minor modification to any VBA hosts like Excel, MSAcess ..etc.
Enjoy!
TS
Saturday, October 25, 2008
Start Menu handler using Accessibility API
The code below demonstrates how to run an application from Start menu using accessibility API in TestPartner making use of VBA.
For this exercise, we will use Test Script, Class Module and Module. The original intent was to have the functionality built into class module and instantiate it in Test Script. But AddressOf operator does not work inside a class module in VBA hence using Module.
Anyway, first let us define the class module. For this exercise name it CStartMenuController. See below for the code (save this as CStartMenuController):
'------------------------------------------------------------------------------
' Develop by : Techno.Scavenger
' Licensed to : Mankind
' Date : 26Oct2008 @ 1:39 AM + 8 GMT (Sunday @home)
' Warranty
' THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
' “Techno.Scavenger” OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY CLAIM,
' DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE
' USE OR OTHER DEALINGS IN THE SOFTWARE.
' Note:
' You can do whatever with this code
'------------------------------------------------------------------------------
'References:
'http://msdn.microsoft.com/en-us/library/ms697639(VS.85).aspx
'http://www.microsoft.com/downloads/details.aspx?familyid=3755582A-A707-460A-BF21-1373316E13F0&displaylang=en
'http://support.microsoft.com/kb/315519
'http://blogs.msdn.com/oldnewthing/archive/2004/04/23/118893.aspx
'http://www.eggheadcafe.com/software/aspnet/32676356/toolbarwindow32-button-in.aspx
'http://msdn.microsoft.com/en-us/library/ms696152(VS.85).aspx
'http://msdn.microsoft.com/en-us/library/ms971323.aspx
'Caret Tracking
'http://www.geocities.com/krishnapg/EventTracking.html
'-------------------------------------------------------
'Visual Basic Related
'http://www.brainbell.com/tutors/Visual_Basic/Retrieving_Accessibility_Information.htm
'sample code with hooks to AA
'http://www.eggheadcafe.com/software/aspnet/31694003/please-help-ie-window-do.aspx
'http://www.jsware.net/jsware/vbcode.php5#acc
'Notes:
'Seems like in VB, there is no need to call VariantClear for variants defined as [out] in API.
Option Explicit
'references
'Accessibility - oleacc.dll
Private Declare Function AccessibleObjectFromEvent Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByVal dwChildId As Long, ppacc As IAccessible, pvarChild As Variant) As Long
Private Declare Sub OutputDebugString Lib "kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As String)
Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function UnhookWinEvent Lib "user32.dll" (ByVal lHandle As Long) As Long
'event constants
Private Const EVENT_OBJECT_CREATE = &H8000& ' // hwnd + ID + idChild is created item
Private Const EVENT_OBJECT_DESTROY = &H8001& '// hwnd + ID + idChild is destroyed item
Private Const EVENT_OBJECT_SHOW = &H8002& '// hwnd + ID + idChild is shown item
Private Const EVENT_OBJECT_HIDE = &H8003& '// hwnd + ID + idChild is hidden item
Private Const EVENT_OBJECT_FOCUS = &H8005& '// hwnd + ID + idChild is focused item
Private Const EVENT_OBJECT_LOCATIONCHANGE = &H800B& '// hwnd + ID + idChild is moved/sized item
Private Const WINEVENT_OUTOFCONTEXT = &H0& '// Events are ASYNC
Private Const WINEVENT_SKIPOWNPROCESS = &H2& '// Don't call back for events on installer's process
'class private stuff
Private m_hHook As Long
Private m_sMenuPath As String
Private Sub Class_Initialize()
Include "Common.MStartMenuController"
m_hHook = SetWinEventHook(EVENT_OBJECT_FOCUS, EVENT_OBJECT_FOCUS, 0&, AddressOf MStartMenuController.WinEventFunc, 0, 0, WINEVENT_SKIPOWNPROCESS)
End Sub
Private Sub Class_Terminate()
Dim lRet As Long
If m_hHook <> 0 Then
lRet = UnhookWinEvent(m_hHook)
End If
End Sub
Public Sub SelectMenu(sMenuPath As String)
MStartMenuController.SelectMenu sMenuPath
End Sub
As mentioned above, we need a module to house the function we supply to SetWinEventHook. And this is also where most of the action happens. See below for the code, save this as MStartMenuController:
'------------------------------------------------------------------------------
' Develop by : Techno.Scavenger
' Licensed to : Mankind
' Date : 26Oct2008 @ 1:39 AM + 8 GMT (Sunday @home)
' Warranty
' THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
' “Techno.Scavenger” OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY CLAIM,
' DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE
' USE OR OTHER DEALINGS IN THE SOFTWARE.
' Note:
' You can do whatever with this code
'------------------------------------------------------------------------------
'references
'Accessibility - oleacc.dll
Option Explicit
Private Declare Function AccessibleObjectFromEvent Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByVal dwChildId As Long, ppacc As IAccessible, pvarChild As Variant) As Long
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub OutputDebugString Lib "kernel32" Alias "OutputDebugStringA" (ByVal lpOutputString As String)
Private Declare Sub SleepEx Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
'key constants
Private Const KEYEVENTF_KEYUP = 2
Private Const vbKeyControl = 17
Private Const vbKeyEscape = 27
'event constants
Private Const EVENT_OBJECT_CREATE = &H8000& '// hwnd + ID + idChild is created item
Private Const EVENT_OBJECT_DESTROY = &H8001& '// hwnd + ID + idChild is destroyed item
Private Const EVENT_OBJECT_SHOW = &H8002& '// hwnd + ID + idChild is shown item
Private Const EVENT_OBJECT_HIDE = &H8003& '// hwnd + ID + idChild is hidden item
Private Const EVENT_OBJECT_FOCUS = &H8005& '// hwnd + ID + idChild is focused item
Private Const EVENT_OBJECT_LOCATIONCHANGE = &H800B& '// hwnd + ID + idChild is moved/sized item
'private data
Private m_sMenuPath As String
Private m_sActiveItem As String
Public Function WinEventFunc(ByVal hHook As Long, ByVal lEvent As Long, ByVal hwnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
Dim ObA As IAccessible
Dim lRet As Long
Dim v As Variant
Dim s As String, s1 As String, sName As String
Dim sTmp As String
On Error Resume Next
sTmp = "YH"
Select Case lEvent
'Case EVENT_OBJECT_CREATE, EVENT_OBJECT_DESTROY, EVENT_OBJECT_SHOW, EVENT_OBJECT_HIDE, EVENT_OBJECT_FOCUS, EVENT_OBJECT_LOCATIONCHANGE
Case EVENT_OBJECT_FOCUS
lRet = AccessibleObjectFromEvent(hwnd, idObject, idChild, ObA, v)
If lRet = 0 Then
sTmp = sTmp & ":Name:<" & ObA.accName(v) sTmp = sTmp & ">:Description:< " & ObA.accDescription(v) sTmp = sTmp & ">:Role<: " & ObA.accRole(v) sTmp = sTmp & ">:State<: " & ObA.accState(v) sTmp = sTmp & ">:menu<: " & m_sMenuPath m_sActiveItem = ObA.accName(v) End If OutputDebugString sTmp End Select WinEventFunc = 0 End Function Public Function SetMenuPath(sMenuPath As String) As Boolean m_sMenuPath = sMenuPath End Function Public Sub SelectMenu(sMenuPath As String) m_sMenuPath = sMenuPath StartMenuEx sMenuPath End Sub Private Sub StartMenuEx(sMenuPath As String) Const MAX_LOOPS = 50 Dim vMenu As Variant Dim iDx As Integer Dim sMenuBookMark As String Dim iTerminateCounter vMenu = Split(sMenuPath, "~") Call keybd_event(vbKeyControl, 0, 0, 0) Call keybd_event(vbKeyEscape, 0, 0, 0) ' Release the two keys Call keybd_event(vbKeyControl, 0, KEYEVENTF_KEYUP, 0) Call keybd_event(vbKeyEscape, 0, KEYEVENTF_KEYUP, 0) SleepEx 1000 For iDx = 0 To UBound(vMenu) Do While m_sActiveItem <> vMenu(iDx)
OutputDebugString "YH: Sending DOWN key"
SendKeys "{DOWN}", True
SleepEx 1000
'set book on first loop thru menu indexes
If sMenuBookMark = "" Then
sMenuBookMark = m_sActiveItem
Else
'if we are here, then this must have been after one round
'we have come full circle, need to raise an error
If m_sActiveItem = sMenuBookMark Then
OutputDebugString "YH: We have come full circle, raising an error"
Include "Common.CustomErrorConstants"
Err.Raise CustomErrorConstants.vbErrMenuNotFound, "MStartMenuController", "Menu was not found"
End If
End If
'another check if we have gone wild
iTerminateCounter = iTerminateCounter + 1
If iTerminateCounter >= MAX_LOOPS Then
OutputDebugString "YH:Max loops detected, raising an error"
Err.Raise CustomErrorConstants.vbErrMenuNotFound, "MStartMenuController", "Menu was not found"
End If
Loop
'clear bookmark
sMenuBookMark = ""
'reset terminate marker
iTerminateCounter = 0
'move to next menu
OutputDebugString "YH:Sending RIGHT key"
SendKeys "{RIGHT}", True
Next
'assume we found the item, then hit on enter key
If vMenu(UBound(vMenu)) = m_sActiveItem Then
OutputDebugString "YH: We are about to run " & m_sActiveItem
SendKeys "~", True
Else
MsgBox "nah, not found"
End If
End Sub
To make the code a little modular, we have separated custom error constants for use when raising our custom Error. See below for constant definitions and save this as CustomErrorConstants.
'------------------------------------------------------------------------------ ' Developed by : Techno.Scavenger ' Licensed to : Mankind ' Date : 26Oct2008 @ 1:39 AM + 8 GMT (Sunday @home) ' Warranty ' THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL ' “Techno.Scavenger” OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY CLAIM, ' DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR ' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE ' USE OR OTHER DEALINGS IN THE SOFTWARE. ' Note: ' You can do whatever with this code '------------------------------------------------------------------------------ Option Explicit 'Menu not found Public Const vbErrMenuNotFound = vbObjectError + 4Now, how do we use it? We it is quite easy actually. See below for a sample code that runs HyperTerminal. Save it as scratch or whatever suites you best.
'------------------------------------------------------------------------------ ' Develop by : Techno.Scavenger ' Licensed to : Mankind ' Date : 26Oct2008 @ 1:39 AM + 8 GMT (Sunday @home) ' Warranty ' THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL ' “Techno.Scavenger” OR ANY OTHER CONTRIBUTOR BE LIABLE FOR ANY CLAIM, ' DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR ' OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE ' USE OR OTHER DEALINGS IN THE SOFTWARE. ' Note: ' You can do whatever with this code '------------------------------------------------------------------------------ Option Explicit Sub Main() Include "Common.CStartMenuController" Dim sm As CStartMenuController Set sm = New CStartMenuController sm.SelectMenu "All Programs~Accessories~Communications~HyperTerminal" Set sm = Nothing End SubNotes: This code is targeted for TestPartner 6.1.x. This should work with any VBA host but you need to adjust a few things. This is also inteneded to work only with Start Menu set to Windows XP style. It should be easy to adapt this for both classic and XP start menu. Enjoy! TS
Subscribe to:
Posts (Atom)
-
Installing MonoDevelop in OpenSUSE 12.2 from its repository was very easy. When running it for the first time though I got the message: Th... -
Tried to update my Ubuntu host today and it did pickup that new version of VirtualBox is available (4.1.8). All other packages installed pro...
-
Press Alt+F1, then type: #: reboot -p Reference(s): https://groups.google.com/forum/#!topic/android-x86/pEI7xAnOpNY