'=======================================================
' File name: WFSupport.inc
'$Include 'winapi.inc'
Declare Function VirtualAllocEx Lib "kernel32" Alias "VirtualAllocEx"
(hProcess As Long, lpAddress As Any, dwSize As Long, flAllocationType As
Long, flProtect As Long) As Long
Declare Function VirtualFreeEx Lib "kernel32" Alias "VirtualFreeEx"
(hProcess As Long, lpAddress As Any, dwSize As Long, dwFreeType As Long)
As Long
Declare Function WriteProcessMemoryEx Lib "kernel32" Alias
"WriteProcessMemory" (hProcess As Long, lpBaseAddress As Any, lpBuffer As
Long, nSize As Long, lpNumberOfBytesWritten As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any,
pSrc As Any, ByteLen As Long)
Declare Sub CopyMemoryA Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As
Any, lpvSource As Any, cbCopy As Long)
Declare Function WideCharToMultiByte Lib "kernel32" Alias
"WideCharToMultiByte" (CodePage As Long, dwFlags As Long, lpWideCharStr As
String, cchWideChar As Long, lpMultiByteStr As String, cchMultiByte As
Long, lpDefaultChar As String, lpUsedDefaultChar As Long) As Long
'============NT Shared memory constant======================
Const PROCESS_VM_OPERATION = &H8
Const PROCESS_VM_READ = &H10
Const PROCESS_VM_WRITE = &H20
Const PROCESS_ALL_ACCESS = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Function FindWindowsFormsControlRecursive(startWnd As Long, controlName As String) as Long
Dim childWnd As Long
Dim tmpWnd As Long
Dim retVal As Long
' Start with the first child.
childWnd = GetWindow(startWnd, GW_CHILD)
While childWnd <> 0 And retVal = 0
' Compare the WindowsFormsID and see if this is the control
' we are after.
If GetWindowsFormsID(childWnd) <> controlName Then
tmpWnd = childWnd
' Do depth-first recursion on the children.
retVal = FindWindowsFormsControlRecursive(tmpWnd, controlName)
childWnd = GetWindow(childWnd, GW_HWNDNEXT)
Else
' Found it.
retVal = childWnd
Exit While
End if
Wend
FindWindowsFormsControlRecursive = retVal
End Function
Function FindWindowsFormsControl(startWnd As Long, controlName As String, timeout% = 50) as Long
Dim retVal As Long
Dim tmpWnd As Long
Dim originalTimeout as Integer
If timeout = -1 Then
' Why does Visual Test not have a
' GetDefaultWaitTimeout method?
originalTimeout = SetDefaultWaitTimeout(5)
timeout = originalTimeout
' Reset the timeout.
SetDefaultWaitTimeout(originalTimeout)
End If
While retVal = 0 And timeout > 0
retVal = FindWindowsFormsControlRecursive(startWnd, controlName)
' If we did not find it, sleep and try again.
If retVal = 0 Then
Sleep 1
timeout = timeout - 1
End if
Wend
If retVal = 0 Then
' Need to search one more time (this covers the case where
' timeout is 0).
retVal = FindWindowsFormsControlRecursive(startWnd, controlName)
End If
FindWindowsFormsControl = retVal
End function
Function ByteArrayToString(bytes As String, length As Long) As String
Dim retVal as String
If IsWin9x() Then
retVal = Left(bytes, Instr(1, bytes, Chr(0)) - 1)
Else
retVal = String$(length + 1, Chr(0))
WideCharToMultiByte(CP_ACP, 0, bytes, -1, retVal, length + 1, null, null)
End If
ByteArrayToString = retVal
End Function
'''-----------------------------------------------------------------------------
''' <summary>
''' Determine if we are on a Win9x machine or not
''' </summary>
''' <returns>True if this is a flavor of Win9x</returns>
'''-----------------------------------------------------------------------------
Function IsWin9x() as Bool
Dim osVerInfo as OSVERSIONINFO
osVerInfo.dwOSVersionInfoSize = 128 + 4 * 5
GetVersionEx(osVerInfo)
IsWin9x = osVerInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS
End Function
'''-----------------------------------------------------------------------------
''' <summary>
''' This method extracts the Windows Forms Name property from the given HWND.
''' </summary>
''' <param name="wnd">target window</param>
''' <returns>The name of control as a string.</returns>
'''-----------------------------------------------------------------------------
Function GetWindowsFormsID(wnd As Long) As String
Dim PID As Long 'pid of the process that contains the control
Dim msg as Long
' Define the buffer that will eventually contain the desired
' component's name.
Dim bytearray as String * 65535
' Allocate space in the target process for the buffer as shared
' memory.
Dim bufferMem As Long
' Base address of the allocated region for the buffer.
Dim size As Long
' The amount of memory to be allocated.
Dim written As Long
' Number of bytes written to memory.
Dim retLength As Long
Dim retVal As Long
Dim errNum As Integer
Dim errDescription As String
size = 65536 'Len(bytearray)
' Creating and reading from a shared memory region is done
' differently in Win9x than in newer Oss.
Dim processHandle As Long
Dim fileHandle As Long
msg = RegisterWindowMessage("WM_GETCONTROLNAME")
If Not IsWin9x() Then
On Local Error Goto Error_Handler_NT
GetWindowThreadProcessId(wnd, VarPtr(PID))
processHandle = OpenProcess(PROCESS_VM_OPERATION Or
PROCESS_VM_READ Or PROCESS_VM_WRITE, 0, PID)
If processHandle = 0 Then
Error Err, "OpenProcess API Failed"
End If
bufferMem = VirtualAllocEx(processHandle, 0, size,
MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
If bufferMem = 0 Then
Error Err, "VirtualAllocEx API Failed"
End If
' Send message to the control's HWND for getting the
' Specified control name.
retLength = SendMessage(wnd, msg, size, bufferMem)
' Now read the component's name from the shared memory location.
retVal = ReadProcessMemory(processHandle, bufferMem, bytearray, size, VarPtr(written))
If retVal = 0 Then
Error Err, "ReadProcessMemory API Failed"
End If
Error_Handler_NT:
errNum = Err
errDescription = Error$
' Free the memory that was allocated.
retVal = VirtualFreeEx(processHandle, bufferMem, 0, MEM_RELEASE)
If retVal = 0 Then
Error Err, "VirtualFreeEx API Failed"
End If
CloseHandle(processHandle)
If errNum <> 0 Then
On Local Error Goto 0
Error errNum, errDescription
End If
On Local Error Goto 0
Else
On Local Error Goto Error_Handler_9x
fileHandle = CreateFileMapping(INVALID_HANDLE_VALUE, null,
PAGE_READWRITE, 0, size, null)
If fileHandle = 0 Then
Error Err, "CreateFileMapping API Failed"
End If
bufferMem = MapViewOfFile(fileHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0)
If bufferMem = 0 Then
Error Err, "MapViewOfFile API Failed"
End If
CopyMemory(bufferMem, bytearray, size)
' Send message to the treeview control's HWND for
' getting the specified control's name.
retLength = SendMessage(wnd, msg, size, bufferMem)
' Read the control's name from the specific shared memory
' for the buffer.
CopyMemoryA(bytearray, bufferMem, 1024)
Error_Handler_9x:
errNum = Err
errDescription = Error$
' Unmap and close the file.
UnmapViewOfFile(bufferMem)
CloseHandle(fileHandle)
If errNum <> 0 Then
On Local Error Goto 0
Error errNum, errDescription
End If
On Local Error Goto 0
End If
' Get the string value for the Control name.
GetWindowsFormsID = ByteArrayToString(bytearray, retLength)
End Function
Sub FindControlAndClassName(startWnd As Long, controlName As String,
controlWnd As Long, className As String, timeout% = 1)
Dim controlHandle As Long
Dim info As INFO
controlHandle = FindWindowsFormsControl(startWnd, controlName, timeout)
WGetInfo controlHandle, info
className = info.Class
controlWnd = controlHandle
End Function
'''-----------------------------------------------------------------------------
''' <name> WFndWF*</name>
''' <summary>
''' These are the functions you use to find the HWnds of Windows Forms controls.
''' </summary>
''' <param name="startWnd">window handle of where you want to start your search
''' NOTE: this window is not included in the search, only the descendants </param>
''' <param name="controlName">This is the WindowsFormsID of the control.
''' Use the Windows Forms Spy tool to get the ID. Note that this is also
''' the "Name" property of the Windows Forms control in code.</param>
''' <returns>The window handle of the control</returns>
'''-----------------------------------------------------------------------------
Function WFndWFCheck(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WCheckSetClass(className)
WFndWFCheck = controlWnd
End Function
Function WFndWFCombo(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WComboSetClass(className)
WFndWFCombo = controlWnd
End Function
Function WFndWFButton(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WButtonSetClass(className)
WFndWFButton = controlWnd
End Function
Function WFndWFEdit(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WEditSetClass(className)
WFndWFEdit = controlWnd
End Function
Function WFndWFHeader(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WHeaderSetClass(className)
WFndWFHeader = controlWnd
End Function
Function WFndWFList(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WListSetClass(className)
WFndWFList = controlWnd
End Function
Function WFndWFView(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WViewSetClass(className)
WFndWFView = controlWnd
End Function
Function WFndWFMonthCal(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WMonthCalSetClass(className)
WFndWFMonthCal = controlWnd
End Function
Function WFndWFOption(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WOptionSetClass(className)
WFndWFOption = controlWnd
End Function
Function WFndWFPicker(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WPickerSetClass(className)
WFndWFPicker = controlWnd
End Function
Function WFndWFProgress(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WProgressSetClass(className)
WFndWFProgress = controlWnd
End Function
Function WFndWFScroll(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WScrollSetClass(className)
WFndWFScroll = controlWnd
End Function
Function WFndWFSlider(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WSliderSetClass(className)
WFndWFSlider = controlWnd
End Function
Function WFndWFSpin(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WSpinSetClass(className)
WFndWFSpin = controlWnd
End Function
Function WFndWFStatic(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WStaticSetClass(className)
WFndWFStatic = controlWnd
End Function
Function WFndWFStatus(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WStatusSetClass(className)
WFndWFStatus = controlWnd
End Function
Function WFndWFTab(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WTabSetClass(className)
WFndWFTab = controlWnd
End Function
Function WFndWFToolbar(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WToolbarSetClass(className)
WFndWFToolbar = controlWnd
End Function
Function WFndWFTips(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WTipsSetClass(className)
WFndWFTips = controlWnd
End Function
Function WFndWFTree(startWnd As Long, controlName As String, timeout% = -1) As Long
Dim controlWnd as Long
Dim className As String
FindControlAndClassName(startWnd, controlName, controlWnd, className, timeout)
WTreeSetClass(className)
WFndWFTree = controlWnd
End Function
'''-----------------------------------------------------------------------------
''' <summary>
''' Windows Forms replacement for WCheckState function
''' </summary>
''' <param name="controlHwnd">The HWnd of this control in traditional
Visual Test representation (e.g. "=1234")</param>
''' <returns>CHECKED, UNCHECKED, or GRAYED</returns>
'''-----------------------------------------------------------------------------
Function WFCheckState(controlHwnd As String, timeout% = -1) as Integer
Dim state as String
state = AAGetState(controlHWnd, timeout)
If Instr(state,"checked") > 0 Then
WFCheckState = CHECKED
ElseIf Instr(state, "mixed") > 0 Then
WFCheckState = GRAYED
Else
WFCheckState = UNCHECKED
End If
End Function
'''-----------------------------------------------------------------------------
''' <summary>
''' Windows Forms replacement for WOptionState function
''' </summary>
''' <param name="controlHwnd">The HWnd of this control in traditional
Visual Test representation (e.g. "=1234")</param>
''' <returns>CHECKED or UNCHECKED</returns>
'''-----------------------------------------------------------------------------
Function WFOptionState(controlHwnd As String, timeout% = -1) as Integer
Dim state as String
state = AAGetState(controlHWnd, timeout)
If Instr(state,"checked") > 0 Then
WFOptionState = CHECKED
Else
WFOptionState = UNCHECKED
End If
End Function