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

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:
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:
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:
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:
Now, let us create a test script that will make use of the form, see below for a sample code:
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:
Enjoy!
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:

'------------------------------------------------------------------------------
' 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 + 4
Now, 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 Sub
Notes: 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

Saturday, October 11, 2008

Change TestPartner script automatically

This is an ugly hack. Please be careful with this code as it is using an undocumented feature. Code below will allow you to modify a test script using VBA. Test script is an asset within TestPartner application, so if you are not using TP this may not apply to you.

'------------------------------------------------------------------------------
' Develop by    : Techno.Scavenger
' Licensed to   : Mankind
' Date          : 11Oct2008 @ 6:55 PM + 8 GMT (Saturday @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()
TestAdd
End Sub
Sub TestAdd()
Dim t As New TPApp
Dim pCount As Integer
Dim p As Integer
Dim sCount As Integer
Dim sName As String
Dim tp As TestPartner.TPProject
Dim ts As TestPartner.TPScript
Dim tsx As TestPartner.TPScriptEx

t.Login "admin", "admin", "TestPartner_SQL", 1
t.Show
pCount = t.Projects.Count
For p = 1 To pCount
If t.Projects.Item(p).Name = "Common" Then
Debug.Print t.Projects.Item(p).Name
Set tp = t.Projects.Item(p)
Dim iSCount As Integer
iSCount = tp.Scripts.Count
Dim iSIdx As Integer
For iSIdx = 1 To iSCount
Set tsx = tp.Scripts.Item(iSIdx)

Set ts = tp.Scripts.Item(iSIdx)
If ts.Name = "TestExecOther" Then

tsx.OpenToLine 2
Sleep 1, tpPauseSeconds
SendKeys "^a", True
Sleep 1, tpPauseSeconds
SendKeys "{BACKSPACE}", True
Sleep 1, tpPauseSeconds
SendKeys "~", True
SendKeys "Sub Main", True
SendKeys "~", True
SendKeys "Msgbox ""Hello 6""", True
SendKeys "~", True
SendKeys "^S", True
Set tsx = Nothing
SendKeys "%FC", True
SendKeys "~", True
End If
Next
End If
Next
t.Logout
Sleep 5, tpPauseSeconds
Set t = New TestPartner.TPApp
t.Login "admin", "admin", "TestPartner_SQL", 1
t.Show
pCount = t.Projects.Count
For p = 1 To pCount
If t.Projects.Item(p).Name = "Common" Then
Set tp = t.Projects.Item(p)
iSCount = tp.Scripts.Count

For iSIdx = 1 To iSCount
Set ts = tp.Scripts.Item(iSIdx)
Debug.Print ts.Name
If ts.Name = "TestExecOther" Then
ts.Execute -1, -1
Do While t.PlaybackInProgress
Sleep 1
Loop
t.Logout
End If
Next

End If
Next
End Sub


~ts

Wednesday, October 01, 2008

Minimal Debian Etch install with X on VirtualBox host

This to document minimal installation of Debian 4.0 (Etch) on VirtualBox host.

Download latest Debian Etch, I am using debian-40r3-i386-netinst.iso. During the package installation, deselect all. This should give you a minimal Debian installation. During installation, you say "No" during selecting the mirror. We will update /etc/app/sources.list after the installation anyway. Reboot virtual machine after installation.

Add the following lines to your /etc/apt/sources.list, I am using nano to edit sources.list file. Since I am near Hongkong, I selected the mirror sites as shown below, change this as you see fit:
hostname:/# nano -w /etc/apt/sources.list

Additional entries into /etc/apt/sources.list
#more entries from here of course from /etc/apt/sources.list
deb http://ftp.hk.debian.org/debian etch main contrib non-free
deb-src http://ftp.hk.debian.org/debian etch main contrib non-free

Then do:
hostname:/# aptitude update hostname:/# aptitude upgrade

The above command should bring your fresh installation of Debian up to date with security patches and upgrade whatever is currently installed in your system. More likely than not, it will install new linux image so you need to reboot after the upgrade.
Now let us install xorg, base gnome and gdm:
hostname:/# aptitude install xorg gnome-core gdm gdm-themes

Reboot machine after the above command, we should now have a graphical login using GDM.
Now let us install some utility commands, less:
hostname:/# aptitude install less

Now install guest additions, in VirtualBox host do Devices | Install Guest Additions..... Then in Debian, do
# mount cdrom # cd /cdrom # sh VBoxLinuxAdditions-x86.run
The guest machine should now feel much faster. One thing you will notice is that GNome is only using a portion of your total screen real state. A quick search in Google points to the fact that the X server used in Debian 4.0 is a bit dated and it does not work with auto-resize. So what we will do next is to adjust xorg.conf to force X to use a much larger workspace. Since X configuration is a book in itself I will just post my configuration here, see below:
# /etc/X11/xorg.conf (xorg X Window System server configuration file) # # This file was generated by dexconf, the Debian X Configuration tool, using # values from the debconf database. # # Edit this file with caution, and see the /etc/X11/xorg.conf manual page. # (Type "man /etc/X11/xorg.conf" at the shell prompt.) # # This file is automatically updated on xserver-xorg package upgrades *only* # if it has not been modified since the last upgrade of the xserver-xorg # package. # # If you have edited this file but would like it to be automatically updated # again, run the following command: # sudo dpkg-reconfigure -phigh xserver-xorg Section "Files" FontPath "/usr/share/fonts/X11/misc" FontPath "/usr/X11R6/lib/X11/fonts/misc" FontPath "/usr/share/fonts/X11/cyrillic" FontPath "/usr/X11R6/lib/X11/fonts/cyrillic" FontPath "/usr/share/fonts/X11/100dpi/:unscaled" FontPath "/usr/X11R6/lib/X11/fonts/100dpi/:unscaled" FontPath "/usr/share/fonts/X11/75dpi/:unscaled" FontPath "/usr/X11R6/lib/X11/fonts/75dpi/:unscaled" FontPath "/usr/share/fonts/X11/Type1" FontPath "/usr/X11R6/lib/X11/fonts/Type1" FontPath "/usr/share/fonts/X11/100dpi" FontPath "/usr/X11R6/lib/X11/fonts/100dpi" FontPath "/usr/share/fonts/X11/75dpi" FontPath "/usr/X11R6/lib/X11/fonts/75dpi" # path to defoma fonts FontPath "/var/lib/defoma/x-ttcidfont-conf.d/dirs/TrueType" EndSection Section "Module" Load "i2c" Load "bitmap" Load "ddc" Load "dri" Load "extmod" Load "freetype" Load "glx" Load "int10" Load "vbe" EndSection Section "InputDevice" Identifier "Generic Keyboard" Driver "kbd" Option "CoreKeyboard" Option "XkbRules" "xorg" Option "XkbModel" "pc104" Option "XkbLayout" "us" EndSection Section "InputDevice" Identifier "Configured Mouse" Driver "vboxmouse" Option "CorePointer" Option "Device" "/dev/input/mice" Option "Protocol" "ImPS/2" Option "Emulate3Buttons" "true" EndSection Section "InputDevice" Identifier "Synaptics Touchpad" Driver "synaptics" Option "Device" "/dev/psaux" Option "Protocol" "auto-dev" Option "HorizScrollDelta" "0" EndSection Section "Device" Identifier "Generic Video Card" Driver "vboxvideo" EndSection Section "Monitor" Identifier "Generic Monitor" Option "DPMS" EndSection Section "Screen" Identifier "Default Screen" Device "Generic Video Card" Monitor "Generic Monitor" SubSection "Display" Modes "1024x680" "800x600" EndSubSection EndSection Section "ServerLayout" Identifier "Default Layout" Screen "Default Screen" InputDevice "Generic Keyboard" InputDevice "Configured Mouse" InputDevice "Synaptics Touchpad" EndSection Section "DRI" Mode 0666 EndSection

Enjoy!

~ts

Install Virtualbox in EeePc 900

Draft - draft - draft - draft

/etc/app/sources.list
deb http://update.eeepc.asus.com/p900 p900 main
deb http://update.eeepc.asus.com/p900/en p900 main

deb http://xnv4.xandros.com/xs2.0/pkg/ xs2.0-xn main non-free
deb http://xnv4.xandros.com/xs2.0/upkg-srv2 etch main contrib non-free
deb http://download.virtualbox.org/virtualbox/debian etch non-free

add public keys
wget -q http://download.virtualbox.org/virtualbox/debian/sun_vbox.asc -O- | sudo apt-key add -
sudo apt-get install xandros-archive-keyring

sudo apt-get install build-essential

download sources
http://support.asus.com/download/download.aspx

unrar x Eee_PC_900_source_code_part1.rar

dpkg --install linux-source-2.6.21.4-eeepc_17_all.deb
cd /usr/src
tar xvjf linux-source-2.6.21.4-eeepc.tar.bz2
cd linux-source-2.6.21.4-eeepc
ln /usr/src/linux-2.6.21.4 /usr/src/linux -s
cd /usr/src/linux
make oldconfig
make prepare
make all
apt-get install virtualbox

create a file, /bin/vbox/run
sudo nano /bin/vboxrun

and paste:
------------------------------
sudo /etc/init.d/vboxdrv start
sudo /etc/init.d/vboxnet start

/usr/bin/VirtualBox

sudo /etc/init.d/vboxdrv stop
sudo /etc/init.d/vboxnet stop
-----------------------------

chage file mode:
sudo chmod +x /bin/vboxrun

Copy or create asusadd:
http://forum.eeeuser.com/viewtopic.php?id=6645

For some reason the above script fails, try this:
mkdir /home/user/.AsusLauncher
then run :
sudo /bin/asusadd Work VirtualBox /bin/asusadd

sudo usermod -a -G vboxusers user
Logout to take effect