Cool Visual Basic
 
Main
Frequently Asked Questions
VB Helpdesk
Message Boards
Library
Downloads
View Guestbook
Add to Guestbook
Product Reviews
Bookstore
Links
Newsgroups
Vendors
Affiliates
Cooltech.org

Reinventing the Wheel


The 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.)

Implementation

FindWindowByTitle, FindWindowByClass, FindChildByTitle, FindChildByClass

If 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.
BOOL EnumWindows( 
	WNDENUMPROC lpEnumFunc, // pointer to callback function 
	LPARAM lParam 		// application-defined value 
); "
Yikes.

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 Long
For 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 MyEnumFunc
We 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 Function
Easy, 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, SetWindowText

Even 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

vbSendCharNum

We'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


Copyright 2000, David J Berube<Form1@aol.com>. All Rights Reserved.