|
Reinventing the WheelThe phrase "Master32.bas" is a commonly used module that allows indivuals to manipulate other programs, such as America Online or Notepad. However, Master32 has quite a few problems; they prevent using Master32 in a decent program. Re-writing Master32 is a challenge for hardcore VB'ers; if you don't qualify, turn back now or face the consequences. (Note: To avoid conflicting with Master32, all custom versions will be prefixed with VB for general function or E for Enumeration function.)ImplementationFindWindowByTitle, FindWindowByClass, FindChildByTitle, FindChildByClassIf you dig deep into Master32's implementation of FindWindow* and FindChild*, you'll see it uses GetWindow at it's "heart". Let's see what the API reference has to say about GetWindow: "This function (EnumWindows) is more reliable than calling the GetWindow function in a loop. An application that calls GetWindow to perform this task risks being caught in an infinite loop or referencing a handle to a window that has been destroyed." Instead of GetWindow, we can make use something safer, namely EnumWindows. In order to understand how to do it, let's check the API reference for stuff on EnumWindows. We see the following information: "The EnumWindows function enumerates all top-level windows on the screen by passing the handle of each window, in turn, to an application-defined callback function. EnumWindows continues until the last top-level window is enumerated or the callback function returns FALSE.Yikes.BOOL EnumWindows( WNDENUMPROC lpEnumFunc, // pointer to callback function LPARAM lParam // application-defined value); "
Any C++ programmers reading this will comprehend this right away, but "normal" VB programmers need a bit of coaxing. That translates to this: Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, lParam As Long) As LongFor those of you who are Hungarian-impaired, that translates to this pseudo-code: ... (ByVal Long Pointer to a Enum Function, Long Parameter) ...We can get the Enum Function Pointer by doing this: AddressOf MyEnumFuncWe can implement EFindWindowByTitle like this: ... Dim gHW As Integer Dim s As String Dim sNum As Integer ... Function EFindWindowByTitle(chldtxt As String) s = chldtxt EnumWindows AddressOf EnumWindowProc, 0 EFindWindowByTitle = gHW gHW = 0 End Function ... Function EnumWindowProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim x As String x = String(256, " ") GetWindowText hWnd, x, 256 If InStr(x, Chr$(0)) Then x = Left(x, InStr(x, Chr$(0))) If LCase(x) Like LCase(s) Then gHW = hWnd: EnumWindowProc = False: Exit _ Function EnumWindowProc = True Exit Function End FunctionEasy, huh?
These functions are better then Master32 in terms of speed, functionality, and stability. You'll notice that we use "like" instead of "=". As a result, we can use Pattern Matching. EFindChildByTitle is very similar. You can almost write them identically. Full listings are at the end of this article.GetWindowText, SetWindowTextEven the most fundamental functions, GetWindowText and SetWindowText, still need wrappers. Hence, we'll write VBSetWindowText and VBGetWindowText. Let's take a peek at the code, shall we? Function vbGetWindowText(ahWnd As Long) As String Dim c As Integer Dim t As String If ahWnd = 0 Then Exit Function t = String(256, " ") ' c = SendMessageByStr(ahWnd, WM_GETTEXT, 256, t) c = SendMessage(ahWnd, 14, 0&, 0&) SendMessageByStr ahWnd, 13, c + 1, t If InStr(t, Chr$(0)) Then t = Left(t, InStr(t, Chr$(0)) - 1) End If If t = "" Then c = GetWindowText(ahWnd, t, 256) 'GetWindowText ahWnd, c, 256 ' Old Code 'Debug.Print c vbGetWindowText = t End Function Function vbSetWindowText(ahWnd As Long, strSetText As String) As Integer Dim t As String Dim c As String vbSetWindowText = SendMessageByStr(ahWnd, WM_SETTEXT, 0, strSetText) End Function vbSendCharNumWe're going to write one final function, vbSendCharNum. It works like SendKeys, only with individual keystrokes. Here goes: Function vbSendCharNum(Window As Long, Chars As Long) As Long Dim i As Long i = 0 vbSendCharNum = SendMessageVal(Window, WM_CHAR, Chars, i) End Function Listings:
Option Explicit Dim gHW As Integer Dim s As String Dim sNum As Integer Declare Function EnumChildWindows Lib "user32" _ (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, _ lParam As Long) As Long Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _ (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _ (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _ (ByVal hWnd As Long, ByVal lpString As String) As Long Declare Function SendMessageByStr& Lib "user32" Alias "SendMessageA"_ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal _ lParam As String) Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long Public Const WM_GETTEXT = &HD Public Const WM_SETTEXT = &HC Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Static q As Integer Dim x As String x = vbGetWindowText(hWnd) If lParam = 0 Then 'Debug.Print lparam If LCase(x) Like LCase(s) And q = sNum Then q = q + 1 If (q = sNum) Then gHW = hWnd EnumChildProc = False q = 0 Exit Function Else EnumChildProc = True Exit Function End If Else EnumChildProc = True Exit Function End If Else If (LCase(x) Like LCase(s)) And _ (GetParent(hWnd) _ = lParam) Then gHW = hWnd EnumChildProc = False q = 0 Exit Function Else EnumChildProc = True Exit Function End If End If End Function Function EnumChildProcC _ (ByVal hWnd As Long, _ ByVal lParam As Long) As Long Static q As Integer Dim x As String x = vbGetWindowClass(hWnd) If lParam = 0 Then 'Debug.Print lparam If LCase(x) Like LCase(s) Then q = q + 1 If q = sNum Then q = 0 gHW = hWnd EnumChildProcC = False Exit Function Else EnumChildProcC = True Exit Function End If Else EnumChildProcC = True Exit Function End If Else If (LCase(x) Like LCase(s)) And (GetParent(hWnd) = lParam) Then q = q + 1 If (q = sNum) Then gHW = hWnd EnumChildProcC = False q = 0 Exit Function Else EnumChildProcC = True Exit Function End If Else EnumChildProcC = True Exit Function End If End If End Function Function EnumWindowProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim x As String x = vbGetWindowText(hWnd) If LCase(x) Like LCase(s) Then gHW = hWnd: EnumWindowProc = False: Exit _ Function EnumWindowProc = True Exit Function End Function Function EFindChildByTitle(ByVal hWnd As Long, _ ByVal chldtxt As String, _ Optional parentHwnd = 0, Optional num As Integer = 1) If Right(chldtxt, 1) <> "*" Then chldtxt = chldtxt & "*" sNum = num If parentHwnd = 0 Then s = chldtxt EnumChildWindows hWnd, AddressOf EnumChildProc, 0 EFindChildByTitle = gHW s = 0 gHW = 0 Else s = chldtxt EnumChildWindows hWnd, AddressOf EnumChildProc, parentHwnd EFindChildByTitle = gHW s = 0 gHW = 0 End If End Function Function EFindChildByClass(ByVal hWnd As Long, _ ByVal chldtxt As String, Optional parentHwnd = 0, _ Optional num As Integer = 1) sNum = num 'If Not (Right(chldtxt, 1) = "*") Then chldtxt = chldtxt & "*" If parentHwnd = 0 Then s = chldtxt EnumChildWindows hWnd, AddressOf EnumChildProcC, 0 EFindChildByClass = gHW s = 0 gHW = 0 Else s = chldtxt EnumChildWindows hWnd, AddressOf EnumChildProcC, parentHwnd EFindChildByClass = gHW s = 0 gHW = 0 End If End Function Function EFindWindowByTitle(chldtxt As String) s = chldtxt EnumWindows AddressOf EnumWindowProc, 0 EFindWindowByTitle = gHW gHW = 0 End Function Function vbGetWindowClass(ahWnd As Long) As String Dim Ret As String Dim i As Long If ahWnd = 0 Then Exit Function Ret = String$(80, 0) i = GetClassName(ahWnd, Ret, 80) vbGetWindowClass = Left$(Ret, i) End Function Function vbGetWindowText(ahWnd As Long) As String Dim c As Integer Dim t As String If ahWnd = 0 Then Exit Function t = String(256, " ") ' c = SendMessageByStr(ahWnd, WM_GETTEXT, 256, t) c = SendMessage(ahWnd, 14, 0&, 0&) SendMessageByStr ahWnd, 13, c + 1, t If InStr(t, Chr$(0)) Then t = Left(t, InStr(t, Chr$(0)) - 1) End If If t = "" Then c = GetWindowText(ahWnd, t, 256) 'GetWindowText ahWnd, c, 256 ' Old Code 'Debug.Print c vbGetWindowText = t End Function Function vbSetWindowText(ahWnd As Long, _ strSetText As String) As Integer Dim t As String Dim c As String vbSetWindowText = SendMessageByStr(ahWnd, _ WM_SETTEXT, 0, strSetText) End Function Function vbSendCharNum(Window As Long, _ Chars As Long) As Long Dim i As Long i = 0 vbSendCharNum = SendMessageVal(Window, _ WM_CHAR, Chars, i) End Function |