Get Visual Basic 6.0 'Form' object from a known HWnd value...

Have you tried using the controls collection on the form?

If its the same app, then simply looping through the Forms collection should suffice, but I'm not aware of any relationship of window handle and form object if that handle is coming from an external app.  However, there are many API functions that work on a window based on its handle.  What exactly do you need to do once you locate this form you want to work with?

Have you tried using the Spy software that comes in the tools options with Visual Studio?

I'm familiar with looping through the Forms collection internally, I'm looking for an 'external' reference of a running (VB6) application. I already have most of what I need, but I can't seem to marry each control with it's hwnd handle...

Here's where I am now...

Method #1:
I'm enumerating using 'EnumWinProc()' and 'EnumChildProc()' which gives me class names from 'GetClassName()' and the controls' text from 'GetWindowText()'. I have the hwnd of my controls here, but I do not have the actual '.Name' of the control...

Method #2:
Now, if I pass the form's hwnd into the 'GetWindowThreadProcessId()' and hop through heap-addresses using 'ReadProcessMemory()' I can get the class name, caption text, and the actaul '.Name' values of the controls! Needless to say I was pleased! But I don't have an hwnd for the controls with this method!

The only remaining issue (for 500 points) is associating the two so that I can have the 'name' of the control AND the 'hwnd' as well. I can't find a way to directly associate the information in method #1 with the information in method #2.

I'm almost there!

Warp

>>Method #2:
Now, if I pass the form's hwnd into the 'GetWindowThreadProcessId()' and hop through heap-addresses using 'ReadProcessMemory()' I can get the class name, caption text, and the actaul '.Name' values of the controls!<<

It's strange! Actually, controls "Name" property is using in high level languages just to simplify programming. When compiled, control name go out - compiler just place each control code to predefined offsets. Try to disassembly vb executable - you won't find control's names there (not sure, probably compiling using P-code still keep names?)

I think that the internal name from for the control is not available outside the application.
This would be a very poor security feature of vb if it did allow you to see the name of the controls in the form.

All,

I was trying not to bore everyone with a long post. But since I'm being told that what I'm doing is not possible, I feel the need to prove myself. I may not be an 'expert', but I'm no liar and I'm not retarded either.

Following is the VB6 code and output for 'Method#1' and 'Method#2'. I pointed at a small (seperate AND external) compiled VB6 application I threw together to test this code. As far as 'poor-security' goes, what can I say? I didn't write the Win32 API library! To repeat myself, the following output was generated from a seperately compiled executing 'EXE'. There's more code to my application. I tried to include only lines pertaining to this issue...

==========  Method #1 ============================================================

lRet = EnumChildWindows(p_oFormInfo(iIndex).hwnd, AddressOf EnumChildProc, lParam)  ' <<< hWnd of the ref'd form >>>
.
.
.
Function EnumChildProc(ByVal lhWnd As Long, ByVal lParam As Long) As Long
  Dim RetVal As Long, iIndex As Integer
  Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
  Dim WinClass As String, WinTitle As String
  Dim lID As Long, lpRect As RECT
 
  RetVal = GetClassName(lhWnd, WinClassBuf, 255)
  WinClass = StripNulls(WinClassBuf)  ' remove extra Nulls & spaces
  RetVal = GetWindowText(lhWnd, WinTitleBuf, 255)
  WinTitle = StripNulls(WinTitleBuf)
     
  If GetWindowLong(lhWnd, GWW_ID) Then
    GetWindowRect lhWnd, lpRect
    lID = GetWindowLong(lhWnd, GWW_ID)
   
    iIndex = UBound(p_oControlInfo)
    ReDim Preserve p_oControlInfo(iIndex + 1)
    p_oControlInfo(iIndex).hwnd = lhWnd
    p_oControlInfo(iIndex).XLoc = lpRect.Left
    p_oControlInfo(iIndex).YLoc = lpRect.Top
    p_oControlInfo(iIndex).ID = lID
    p_oControlInfo(iIndex).Class = WinClass
    p_oControlInfo(iIndex).Title = WinTitle
   
    PPrint "Hwnd = " & p_oControlInfo(iIndex).hwnd & "  Class = " & p_oControlInfo(iIndex).Class & "  Title = '" & p_oControlInfo(iIndex).Title & "'  X-Loc = " & p_oControlInfo(iIndex).XLoc & "  Y-Loc = " & p_oControlInfo(iIndex).YLoc
  End If
  EnumChildProc = True
End Function
--------------------------------------------------------------------------------------------------------------------------------------

Hwnd = 3606330  Class = ThunderRT6Data  Title = 'DataNavigation'  X-Loc = 1251  Y-Loc = 482
Hwnd = 8259434  Class = ThunderRT6DriveListBox  Title = ''  X-Loc = 1251  Y-Loc = 610
Hwnd = 7604014  Class = ThunderRT6OptionButton  Title = 'Bottom Option'  X-Loc = 1251  Y-Loc = 738
Hwnd = 7014444  Class = ThunderRT6OptionButton  Title = 'Top Option'  X-Loc = 1251  Y-Loc = 714
Hwnd = 8587598  Class = ThunderRT6ListBox  Title = ''  X-Loc = 1387  Y-Loc = 682
Hwnd = 5376138  Class = ThunderRT6ComboBox  Title = ''  X-Loc = 1243  Y-Loc = 682
Hwnd = 13633778  Class = Edit  Title = ''  X-Loc = 1246  Y-Loc = 685
Hwnd = 1706164  Class = ThunderRT6CheckBox  Title = 'Right Check'  X-Loc = 1371  Y-Loc = 650
Hwnd = 10357056  Class = ThunderRT6CheckBox  Title = 'Left Check'  X-Loc = 1267  Y-Loc = 650
Hwnd = 5441768  Class = ThunderRT6Frame  Title = 'Frame1'  X-Loc = 1251  Y-Loc = 514
Hwnd = 4982842  Class = ThunderRT6CommandButton  Title = 'Frame Button'  X-Loc = 1395  Y-Loc = 562
Hwnd = 4917264  Class = ThunderRT6TextBox  Title = 'In the frame'  X-Loc = 1275  Y-Loc = 562
Hwnd = 3934264  Class = ThunderRT6OptionButton  Title = 'Option In Frame'  X-Loc = 1275  Y-Loc = 538
Hwnd = 3803230  Class = ThunderRT6CommandButton  Title = 'Open'  X-Loc = 1387  Y-Loc = 762
Hwnd = 9111828  Class = ThunderRT6CommandButton  Title = 'Exit'  X-Loc = 1243  Y-Loc = 762
Hwnd = 5572808  Class = ThunderRT6TextBox  Title = 'Johnson'  X-Loc = 1299  Y-Loc = 434
Hwnd = 6031502  Class = ThunderRT6TextBox  Title = 'Van'  X-Loc = 1299  Y-Loc = 402
Hwnd = 6883630  Class = ThunderRT6TextBox  Title = 'Daryl'  X-Loc = 1299  Y-Loc = 370

===============================================================================

==========  Method #2 ============================================================

lRet = GetWindowThreadProcessId(lhWnd, PID)  ' <<<< This is how I got the process ID I used...  >>>>
.
.
.
Sub GetVBProcessControls(oForm As clsForm, PID As Long)
    Dim hSnapshot   As Long
    Dim lRes        As Long
    Dim lRes2       As Long
    Dim tHL         As HEAPLIST32
    Dim tHE         As HEAPENTRY32
    Dim sProgID     As String
    Dim sObjName    As String
    Dim sCaption    As String

   hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPHEAPLIST, PID)
   tHL.dwSize = Len(tHL)
   lRes = Heap32ListFirst(hSnapshot, tHL)
   With tHE
       Do While lRes = 1
          .dwSize = Len(tHE)
          lRes2 = Heap32First(tHE, tHL.th32ProcessID, tHL.th32HeapID)
          Do While lRes2 = 1
             If IsValidControl(tHE.dwBlockSize) Then
                sProgID = GetControlProgID(.th32ProcessID, .dwAddress)
                If IsValidClass(sProgID) Then
                   sObjName = GetControlName(tHL.th32ProcessID, .dwAddress)
                   sCaption = GetControlCaption(tHL.th32ProcessID, .dwAddress)
                   PPrint "   " & sProgID & ":   " & sObjName & ".Caption = '" & sCaption & "' [ " & .dwBlockSize & " ]"
                   If tHE.dwBlockSize = BSIZE_VB_Form Then
                     oForm.FormName = sObjName
                     oForm.Caption = sCaption
                   End If
                End If
             End If
             If oForm.FormNameOnly = True And sProgID = "VB.Form" Then Exit Do
             lRes2 = Heap32Next(tHE)
          Loop
          If oForm.FormNameOnly = True And sProgID = "VB.Form" Then Exit Do
          lRes = Heap32ListNext(hSnapshot, tHL)
       Loop
   End With
   CloseToolhelp32Snapshot hSnapshot
End Sub

Function GetControlCaption(ByVal PID As Long, ByVal BaseAddress As Long) As String
    Dim lStrPtr As Long, lInfoPtr As Long
   Toolhelp32ReadProcessMemory PID, BaseAddress + 136, lStrPtr, 4, 0
   GetControlCaption = String$(260, 0)
   If lStrPtr <> 0 Then
      Toolhelp32ReadProcessMemory PID, lStrPtr, ByVal GetControlCaption, 260, 4
   End If
   GetControlCaption = Left$(GetControlCaption, InStr(GetControlCaption, vbNullChar) - 1)
End Function

Function GetControlName(ByVal PID As Long, ByVal BaseAddress As Long) As String
    Dim lStrPtr As Long, lInfoPtr As Long
   Toolhelp32ReadProcessMemory PID, BaseAddress + 60, lInfoPtr, 4, 0
   Toolhelp32ReadProcessMemory PID, lInfoPtr + 4, lStrPtr, 4, 0
   GetControlName = String$(260, 0)
   If lStrPtr <> 0 Then
      Toolhelp32ReadProcessMemory PID, lStrPtr, ByVal GetControlName, 260, 0
   End If
   GetControlName = Left$(GetControlName, InStr(GetControlName, vbNullChar) - 1)
End Function
--------------------------------------------------------------------------------------------------------------------------------------

   VB.Form:   frmCaptureFrom.Caption = 'Capture From' [ 408 ]
   VB.Data:   dbDataNav.Caption = 'DataNavigation' [ 304 ]
   VB.DriveListBox:   drvMyList.Caption = '' [ 240 ]
   VB.OptionButton:   Option2.Caption = 'Bottom Option' [ 232 ]
   VB.OptionButton:   Option1.Caption = 'Top Option' [ 232 ]
   VB.ListBox:   lstMyList.Caption = '' [ 248 ]
   VB.ComboBox:   cboDropDown.Caption = 'Combo1' [ 280 ]
   VB.CheckBox:   chkRight.Caption = 'Right Check' [ 232 ]
   VB.CheckBox:   chkLeft.Caption = 'Left Check' [ 232 ]
   VB.Frame:   fraFrameContainer.Caption = 'Frame1' [ 224 ]
   VB.CommandButton:   cmdFrameButton.Caption = 'Frame Button' [ 232 ]
   VB.TextBox:   txtTextInFrame.Caption = 'In the frame' [ 256 ]
   VB.OptionButton:   optInFrame.Caption = 'Option In Frame' [ 232 ]
   VB.CommandButton:   Command1.Caption = 'Open' [ 232 ]
   VB.CommandButton:   cmdExit.Caption = 'Exit' [ 232 ]
   VB.TextBox:   txtLast.Caption = 'Johnson' [ 256 ]
   VB.TextBox:   txtMiddle.Caption = 'Van' [ 256 ]
   VB.TextBox:   txtFirst.Caption = 'Daryl' [ 256 ]
   VB.Label:   lblLast.Caption = 'Last:' [ 232 ]
   VB.Label:   lblMiddle.Caption = 'Middle:' [ 232 ]
   VB.Label:   lblFirst.Caption = 'First:' [ 232 ]
===============================================================================

I welcome 'helpful' and 'constructive' comments to this issue...

Thanks!

Warp

Hey Ark,

If you are a guy... YOU ARE DA MAN!!! If you are a chick... YOU GO GIRL!!!

That one freakin' line of code is EXACTLY what needed! Works beautifully! That was the last piece to this puzzle I’ve been pulling my hair out over! As you probably noticed from my last post, I was starting to get a little frustrated. People have been telling me for a week that what YOU just did could NOT be done.

I can’t thank you enough!!! Too bad I can’t give you more than ‘500xA’ points!!

You totally ROCK!!!

Thanks!

Warp

(P.S.: If you could point me where you found this information, it would be greatly appreciated!)

Hello
To tell the truth, when I read your question, I also didn't belive this is possible. But after you show your code I realized that only one person can play with VB objects such a way - I just googled for Toolhelp32ReadProcessMemory+morcillo and found source code at http://groups.google.ru/group/microsoft.public.vb.winapi/browse_thread/thread/fa4fa7425c830b7f/3d0a387af069aed6
The rest was trivial - main code is

If sObjName = "Label1" Then
   For i = 0 To 232 Step 4
       Toolhelp32ReadProcessMemory pid, tHE.dwAddress + i, lVal, 4, 0
       Debug.Print i, lVal, Hex(lVal)
   Next i
End If

Digging around structure I found following properties (Note: offsets snown are for Labels only. Seems first 208 offsets are equal for all controls while offsets greater then 208 may differ for other controls)
0-43 - Unknown (some pointers - probably, events handlers addresses?)
44 -    Class Info (pointer to Interface)
60 -    Object Info
64 -    hWnd
68,72 - seems to be a pointers to prev/next controls in form's controls collection
92 -    Left (twips)
96 -    Top (twips)
100 -   Width (twips)
104 -   Height (twips)
108 -   Left (pixels)
112 -   Top (pixels)
116 -   Back color
120 -   Fore color
128 - Unknown
132 - Tag (LPWSTR)
136 - Caption (LPSTR)
140 - DataField (LPSTR)
144 - DataMember (LPSTR)
148 - DataSource (LPSTR)
152 - DataFormat - Pointer to StdFormatObject
156,160 - Unknown
164 - WhatThisHelpID
168 - ToolTipText (LPSTR)
172 - DragIcon (hIcon)
176 - MouseIcon (hIcon)
180 - Pointer to DDE Link Object
184-192 - unknown
196 - TabIndex
200 - Unknown
204 - MousePointer (HiWord)
208 - Index (LoWord)
'==========For Label Only======
212 - Flags (Alignment, AutoSize etc) - See code below for flag values
216 - hFont (for form - 224)
228 - Seems to be more Flags (Appearance,Enabled, Visible) - not tested yet
Here is my sample (2 modules + 1 Form):

'============ mEnumWindows.bas========
'Purpose - Enumerate ThunderRT6... windows
Option Explicit

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function EnumWindows& Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long)
Dim lb As ListBox

Function EnumWinProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
  If Left(GetWndClass(hWnd), 10) = "ThunderRT6" Then
     lb.AddItem GetWndText(hWnd)
     lb.ItemData(lb.NewIndex) = hWnd
  End If
  EnumWinProc = 1
End Function

Public Sub EnumVBWindows(lbWindows As ListBox)
  Set lb = lbWindows
  lb.Clear
  EnumWindows AddressOf EnumWinProc, 0
  Set lb = Nothing
End Sub

Private Function GetWndClass(hWnd As Long) As String
  Dim k As Long, sName As String
  sName = Space$(128)
  k = GetClassName(hWnd, sName, 128)
  If k > 0 Then sName = Left$(sName, k) Else sName = "No class"
  GetWndClass = sName
End Function

Private Function GetWndText(hWnd As Long) As String
  Dim k As Long, sName As String
  sName = Space$(128)
  k = GetWindowText(hWnd, sName, 128)
  If k > 0 Then sName = Left$(sName, k) Else sName = "No name"
  GetWndText = sName
End Function

'===============mEnumControls.bas=========
'Purpose - Enumerate controls and read their properties
Option Explicit

Const LF_FACESIZE = 32 'Font Dialog
Private Type LOGFONT 'Font Dialog
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(LF_FACESIZE) As Byte
End Type

Const TH32CS_SNAPHEAPLIST = &H1

Type HEAPLIST32
    dwSize As Long
    th32ProcessID As Long  ' owning process
    th32HeapID As Long     ' heap (in owning process's context!)
    dwFlags As Long
End Type


Type HEAPENTRY32
    dwSize As Long
    hHandle As Long        ' Handle of this heap block
    dwAddress As Long      ' Linear address of start of block
    dwBlockSize As Long    ' Size of block in bytes
    dwFlags As Long
    dwLockCount As Long
    dwResvd As Long
    th32ProcessID As Long  ' owning process
    th32HeapID As Long     ' heap block is in
End Type

Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal Flags As Long, ByVal pid As Long) As Long
Declare Function CloseToolhelp32Snapshot Lib "kernel32" Alias "CloseHandle" (ByVal Handle As Long) As Long
Declare Function Heap32ListFirst Lib "kernel32" (ByVal hSnapshot As Long, lphl As HEAPLIST32) As Long
Declare Function Heap32ListNext Lib "kernel32" (ByVal hSnapshot As Long, lphl As HEAPLIST32) As Long
Declare Function Heap32First Lib "kernel32" (lphe As HEAPENTRY32, ByVal th32ProcessID As Long, ByVal th32HeapID As Long) As Long
Declare Function Heap32Next Lib "kernel32" (lphe As HEAPENTRY32) As Long
Declare Function Toolhelp32ReadProcessMemory Lib "kernel32" (ByVal th32ProcessID As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal cbRead As Long, lpNumberOfBytesRead As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function GetObj Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)

Dim cb As ComboBox

Public Function EnumVBControls(ByVal hForm As Long, cbControls As ComboBox)
   Dim hSnapshot As Long
   Dim lRes As Long, lRes2 As Long, idx As Long
   Dim pid As Long, tid As Long
   Dim tHL As HEAPLIST32
   Dim tHE As HEAPENTRY32
   Dim lf As LOGFONT
   
   Dim sProgid As String, sObjName As String, sShortProgID As String, s As String
   
   Dim i As Long, lVal As Long, lVal1 As Long
   Dim sCaption As String
   Dim bDone As Boolean
   tid = GetWindowThreadProcessId(hForm, pid)  ' Get ProcessID
   If pid = 0 Then Exit Function
   Set cb = cbControls
   cb.Clear
   cb.Tag = pid
'   cb.Sorted = True
   
   ' Create a snapshot of the process
   hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPHEAPLIST, pid)
   tHL.dwSize = Len(tHL)
   ' Find first heap
   lRes = Heap32ListFirst(hSnapshot, tHL)
   Do While lRes = 1
      tHE.dwSize = Len(tHE)
      ' Find first heap
      lRes2 = Heap32First(tHE, tHL.th32ProcessID, tHL.th32HeapID)
      Do While lRes2 = 1
         If ValidateSize(tHE.dwBlockSize) Then
            sProgid = GetControlProgID(tHE.th32ProcessID, tHE.dwAddress)
            sShortProgID = ShortProgID(sProgid)
            If sShortProgID <> "" Then
               sObjName = GetControlName(tHL.th32ProcessID, tHE.dwAddress)
               idx = GetIndex(pid, tHE.dwAddress)
               If idx > -1 Then
                  sObjName = sObjName & "(" & idx & ")"
               End If
               cb.AddItem sObjName & "    [" & sShortProgID & "]"
               cb.ItemData(cb.NewIndex) = tHE.dwAddress
'================ For testings========================================
If sObjName = "Label1" Then
   For i = 0 To 232 Step 4
       Toolhelp32ReadProcessMemory pid, tHE.dwAddress + i, lVal, 4, 0
       Debug.Print i, lVal, Hex(lVal)
   Next i
End If
'=====================================================================
            End If
         End If
         lRes2 = Heap32Next(tHE)
      Loop
       ' Find next heap
      lRes = Heap32ListNext(hSnapshot, tHL)
   Loop
   ' Close the snapshot
   CloseToolhelp32Snapshot hSnapshot
   Set cb = Nothing
End Function

Function GetControlProgID(ByVal pid As Long, ByVal BaseAddress As Long) As String
   Dim lInfoPtr As Long
   Dim lStrPtr As Long

   ' Get pointer to class info
   Toolhelp32ReadProcessMemory pid, BaseAddress + 44, lInfoPtr, 4, 0
   ' Get pointer to sProgID string
   Toolhelp32ReadProcessMemory pid, lInfoPtr + 36, lStrPtr, 4, 0
   ' Get control ProgID
   GetControlProgID = String$(260, 0)
   If lStrPtr <> 0 Then
      Toolhelp32ReadProcessMemory pid, lStrPtr, ByVal GetControlProgID, 260, 0
   End If
   GetControlProgID = TrimNULL(GetControlProgID)
End Function

Function GetControlName(ByVal pid As Long, ByVal BaseAddress As Long) As String
   Dim lStrPtr As Long
   Dim lInfoPtr As Long
   ' Get pointer to object info
   Toolhelp32ReadProcessMemory pid, BaseAddress + 60, lInfoPtr, 4, 0
   ' Get pointer to object name
   Toolhelp32ReadProcessMemory pid, lInfoPtr + 4, lStrPtr, 4, 0
   ' Get object name
   GetControlName = String$(260, 0)
   If lStrPtr <> 0 Then
      Toolhelp32ReadProcessMemory pid, lStrPtr, ByVal GetControlName, 260, 0
   End If
   GetControlName = TrimNULL(GetControlName)
End Function

Public Function GetControlProperty(ByVal pid As Long, ByVal BaseAddress As Long, _
                                   ByVal Offset As Long, ByVal sType As String, _
                                   Optional ByVal bitNum As String, _
                                   Optional ByVal bitNames As String) As Variant
   Dim lVal As Long, lVal1 As Long, i As Long
   Dim s As String
   Dim lf As LOGFONT
   Dim varBitNums As Variant
   Dim varBitNames As Variant
   Dim abData() As Byte, abTemp() As Byte
   Dim intData As Integer
   
   If UCase(sType) = "NAME" Then
      GetControlProperty = GetControlName(pid, BaseAddress)
      Exit Function
   End If
   GetControlProperty = ""
   Toolhelp32ReadProcessMemory pid, BaseAddress + Offset, lVal, 4, 0
   Select Case UCase(sType)
      Case "DWORD":  GetControlProperty = lVal
      Case "HEX":  GetControlProperty = "&H" & Right("00000000" & Hex(lVal), 8)
      Case "LOWORD": GetControlProperty = LoWord(lVal)
      Case "HIWORD": GetControlProperty = HiWord(lVal)
      Case "LPSTR", "LPWSTR"
           If lVal = 0 Then Exit Function
           s = String$(260, 0)
           Toolhelp32ReadProcessMemory pid, lVal, ByVal s, 260, 0
           If bitNum <> "" Then s = Mid(s, CLng(bitNum))
           If sType = "LPWSTR" Then s = StrConv(s, vbFromUnicode)
           GetControlProperty = TrimNULL(s)
      Case "FONT"
         If lVal = 0 Then Exit Function
         If UCase(GetControlProgID(pid, BaseAddress)) = "VB.FORM" Then
            Toolhelp32ReadProcessMemory pid, BaseAddress + Offset + 8, lVal, 4, 0
         End If
         GetObj lVal, Len(lf), lf
         GetControlProperty = TrimNULL(StrConv(lf.lfFaceName, vbUnicode))
      Case "LINKOBJECT"
           If lVal = 0 Then Exit Function
           ReDim abData(259)
           Toolhelp32ReadProcessMemory pid, lVal, abData(0), 260, 0
           lVal = 0
           Select Case UCase(bitNum)
               Case "ITEM"
                    ReDim abTemp(259)
                    CopyMemory abTemp(0), abData(28), 200
                    s = StrConv(abTemp, vbUnicode)
                    lVal = InStr(1, s, Chr(0))
                    If lVal > 0 Then s = Mid(s, lVal + 10)
               Case "MODE"
               Case "SOURCE"
               Case "TIMEOUT"
                    CopyMemory lVal, abData(14), 2
                    s = lVal
               Case "TOPIC"
                    ReDim abTemp(259)
                    CopyMemory abTemp(0), abData(28), 200
                    s = StrConv(abTemp, vbUnicode)
           End Select
           GetControlProperty = TrimNULL(s)
      Case "DATAFORMAT"
           If lVal = 0 Then Exit Function
           Toolhelp32ReadProcessMemory pid, lVal + 8, lVal, 4, 0
           Toolhelp32ReadProcessMemory pid, lVal + 80, lVal1, 4, 0
           Select Case lVal1
              Case 0: s = "General"
              Case 1
                   Toolhelp32ReadProcessMemory pid, lVal + 92, lVal1, 4, 0
                   Select Case lVal1
                      Case 1:  s = "Number"
                      Case 2:  s = "Percentage"
                      Case 7:  s = "Time"
                      Case 9:  s = "Scientific"
                      Case 10: s = "Time"
                      Case 12: s = "Currency"
                      Case Else: s = "Custom"
                   End Select
              Case 2: s = "Picture"
              Case 3: s = "Object"
              Case 4: s = "Checbox"
              Case 5: s = "Boolean"
              Case 6: s = "Bytes"
              Case Else: s = "Unknown"
           End Select
           GetControlProperty = s
      Case "ICON"
           If lVal = 0 Then GetControlProperty = "(None)" Else GetControlProperty = "(Icon)"
      Case "FLAG"
           If bitNum = "" Then Exit Function
           varBitNums = Split(bitNum, ",")
           varBitNames = Split(bitNames, ",")
           For i = 0 To UBound(varBitNums)
               If (lVal And varBitNums(i)) Then
                  s = varBitNames(i)
                  Exit For
               End If
           Next i
           If s = "" Then s = varBitNames(UBound(varBitNames))
           GetControlProperty = s
      Case Else
   End Select
End Function

Private Function ValidateSize(ByVal iSize As Long) As Boolean
   ValidateSize = True
   Select Case iSize
       Case 224 'Frame
       Case 232 'label,command button, checkbox, option button
       Case 248 'array of controls (including menu and list box)
       Case 256 'textbox
       Case 280 'combobox
       Case 328 'picturebox
       Case 376 'WebBrowser, Common controls, DataList/Combo
       Case 408 'Form
       Case Else
            ValidateSize = False
   End Select
End Function

Private Function ShortProgID(ByVal sProgid As String) As String
   Dim nPos As Long
   nPos = InStr(1, sProgid, ".")
   If nPos = 0 Then Exit Function
   Select Case sProgid
       Case "VB.Menu", "VB.Printer", "VB.Clipboard"
       Case Else: ShortProgID = Mid(sProgid, nPos + 1)
   End Select
End Function

Private Function GetIndex(ByVal pid As Long, ByVal BaseAddress As Long) As Long
   Dim lVal As Long, idx As Long
   Toolhelp32ReadProcessMemory pid, BaseAddress + 208, lVal, 4, 0
   GetIndex = LoWord(lVal)
End Function

Public Function TrimNULL(ByVal str As String) As String
    If InStr(str, Chr$(0)) > 0& Then
        TrimNULL = Left$(str, InStr(str, Chr$(0)) - 1&)
    Else
        TrimNULL = str
    End If
End Function

Public Function LoWord(ByVal dw As Long) As Integer
    If dw And &H8000& Then
        LoWord = dw Or &HFFFF0000
    Else
        LoWord = dw And &HFFFF&
    End If
End Function

Public Function HiWord(ByVal dw As Long) As Integer
    HiWord = (dw And &HFFFF0000) \ 65536
End Function

'===========Form code=======
'Add Listbox (Name=lbWindows), ComboBox (cbControls) and ListView(lvPropertis) on form - any size, any position
'Copy/Paste following code:
Option Explicit

Private Sub cbControls_Click()
   EnumProperties
End Sub

Private Sub Form_Load()
   Caption = "VB controls demo"
   Width = 8700
   With lvProperties
      .View = lvwReport
      .ColumnHeaders.Clear
      .ColumnHeaders.Add , , "Property", 2000
      .ColumnHeaders.Add , , "Value", 1900
      .Appearance = ccFlat
      .FullRowSelect = True
      .GridLines = True
      .LabelEdit = lvwManual
   End With
   FillPropertiesNames
   EnumVBWindows lbWindows
   Show
'   If lbWindows.ListCount Then lbWindows.ListIndex = 0
End Sub

Private Sub Form_Resize()
   lbWindows.Move 60, 60, ScaleWidth / 2 - 120, ScaleHeight - 120
   cbControls.Move ScaleWidth / 2, 60, ScaleWidth / 2 - 60
   lvProperties.Move cbControls.Left, cbControls.Top + cbControls.Height + 60, cbControls.Width
   lvProperties.Height = ScaleHeight - lvProperties.Top - 60
End Sub

Private Sub lbWindows_Click()
   MousePointer = vbHourglass
   DoEvents
   EnumVBControls lbWindows.ItemData(lbWindows.ListIndex), cbControls
   If cbControls.ListCount Then cbControls.ListIndex = 0
   MousePointer = vbDefault
End Sub

Private Sub FillPropertiesNames()
   lvProperties.ListItems.Clear
   AddProperty "(Name)", "60", "NAME"
   AddProperty "Alignment", "212", "FLAG", "4,2", "2 - Center,1 - Right Justify,0 - Left Justify"
   AddProperty "Appearance", "212", "FLAG"
   AddProperty "AutoSize", "212", "FLAG", "1", "True,False"
   AddProperty "BackColor", "116", "HEX"
   AddProperty "BackStyle", "212", "FLAG", "16", "1 - Opaque,0 - Transparent"
   AddProperty "BorderStyle", "212", "FLAG", "32", "1 - Fixed Single,0 - None"
   AddProperty "Caption", "136", "LPSTR"
   AddProperty "DataField", "140", "LPSTR"
   AddProperty "DataFormat", "152", "DATAFORMAT"
   AddProperty "DataMember", "144", "LPSTR"
   AddProperty "DataSource", "148", "LPSTR"
   AddProperty "DragIcon", "172", "ICON"
   AddProperty "DragMode", "0", "UNKNOWN"
   AddProperty "Enabled", "212", "FLAG"
   AddProperty "Font", "216", "FONT"
   AddProperty "ForeColor", "120", "HEX"
   AddProperty "Height", "104", "DWORD"
   AddProperty "Index", "208", "LOWORD"
   AddProperty "Left", "92", "DWORD"
   AddProperty "LinkItem", "180", "LINKOBJECT", "ITEM"
   AddProperty "LinkMode", "0", "UNKNOWN"
   AddProperty "LinkTimeout", "180", "LINKOBJECT", "TIMEOUT"
   AddProperty "LinkTopic", "180", "LINKOBJECT", "TOPIC"
   AddProperty "MouseIcon", "176", "ICON"
   AddProperty "MousePointer", "204", "HIWORD"
   AddProperty "OLEDropMode", "0", "UNKNOWN"
   AddProperty "RightToLeft", "212", "FLAG"
   AddProperty "TabIndex", "196", "DWORD"
   AddProperty "Tag", "132", "LPWSTR"
   AddProperty "ToolTipText", "168", "LPSTR"
   AddProperty "Top", "96", "DWORD"
   AddProperty "UseMnemonic", "212", "FLAG", "64", "True,False"
   AddProperty "Visible", "0", "UNKNOWN"
   AddProperty "WhatsThisHelpID", "164", "DWORD"
   AddProperty "Width", "100", "DWORD"
   AddProperty "WordWrap", "212", "FLAG", "8", "True,False"
End Sub

Private Sub AddProperty(ByVal sName As String, ByVal sOffset As String, _
                        ByVal sType As String, _
                        Optional bitNum As String, _
                        Optional bitName As String)
   sType = sOffset & "_" & sType
   If bitNum <> "" Then sType = sType & "_" & bitNum
   If bitName <> "" Then sType = sType & "_" & bitName
   lvProperties.ListItems.Add(, , sName).Tag = sType
End Sub

Private Sub EnumProperties()
   Dim li As Object
   Dim varData As Variant
   Dim iOffset As Long, bitNum As Long
   Dim sType As String, s As String
   For Each li In lvProperties.ListItems
      varData = Split(li.Tag, "_")
      Select Case UBound(varData)
         Case 1
              s = GetControlProperty(cbControls.Tag, cbControls.ItemData(cbControls.ListIndex), varData(0), varData(1))
         Case 2
              s = GetControlProperty(cbControls.Tag, cbControls.ItemData(cbControls.ListIndex), varData(0), varData(1), varData(2))
         Case 3
              s = GetControlProperty(cbControls.Tag, cbControls.ItemData(cbControls.ListIndex), varData(0), varData(1), varData(2), varData(3))
         Case Else: s = "Invalid Type"
      End Select
      If (li.Text = "Index") And (s = "-1") Then s = ""
      li.SubItems(1) = s
   Next
End Sub

Regards
Ark

PS
>>If you are a guy<< Yes :)

Like I said before... YOU TOTALLY ROCK!!! DUDE!!!

I'm going to be picking off of this code for weeks. You're making me appear to be VERY smart!

Thanks again!

Warp

More amazing - you can change another process properties on the fly!
Add following declarations to mEnumControls.bas:

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Const MEM_COMMIT = &H1000
Const MEM_RESERVE = &H2000
Const MEM_RELEASE = &H8000

Const PAGE_READWRITE = &H4&
Const PAGE_EXECUTE_READWRITE = &H40&
Const PROCESS_ALL_ACCESS = &H1F0FFF
Public hFont As Long, hDragIcon As Long, hMouseIcon As Long

'Add Follofing functions also:

Public Function SetControlProperty(ByVal pid As Long, ByVal BaseAddress As Long, _
                                   ByVal Offset As Long, ByVal sType As String, _
                                   ByVal varValue As Variant) As Boolean
   Dim hProcess As Long, lVal As Long, ret As Long, addr As Long, oldProtect As Long
   Dim intVal As Integer
   Dim s As String
   hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
   Select Case sType
      Case "DWORD"
           lVal = CLng(varValue)
           WriteProcessMemory hProcess, ByVal BaseAddress + Offset, lVal, 4, ret
      Case "HEX"
           lVal = CLng(Val(varValue))
           WriteProcessMemory hProcess, ByVal BaseAddress + Offset, lVal, 4, ret
      Case "LOWORD"
           intVal = CInt(varValue)
           WriteProcessMemory hProcess, ByVal BaseAddress + Offset, intVal, 2, ret
      Case "HIWORD"
           intVal = CInt(varValue)
           WriteProcessMemory hProcess, ByVal BaseAddress + Offset + 2, intVal, 2, ret
      Case "LPSTR", "LPWSTR"
           s = CStr(varValue)
           If sType = "LPWSTR" Then s = StrConv(s, vbUnicode)
           addr = VirtualAllocEx(hProcess, 0, Len(s), MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
           If addr Then
              WriteProcessMemory hProcess, ByVal addr, ByVal s, Len(s), ret
              WriteProcessMemory hProcess, ByVal BaseAddress + Offset, addr, 4, ret
           End If
      Case "FONT"
           lVal = CLng(varValue)
           WriteProcessMemory hProcess, ByVal BaseAddress + Offset, lVal, 4, ret
      Case "LINKOBJECT"
      Case "DATAFORMAT"
      Case "ICON"
           lVal = CLng(varValue)
           WriteProcessMemory hProcess, ByVal BaseAddress + Offset, lVal, 2, ret
      Case "FLAG"
           lVal = CLng(varValue)
           WriteProcessMemory hProcess, ByVal BaseAddress + Offset, lVal, 4, ret
      Case Else
   End Select
   CloseHandle hProcess
   SetControlProperty = CBool(ret)
End Function


Public Function ShowFontDialog(cdlg As CommonDialog) As Long
   Dim lf As LOGFONT
   Dim tmpArr() As Byte
  Dim i As Integer, lArr As Long
   GetObj hFont, Len(lf), lf
   With cdlg
        .Flags = cdlCFBoth
        .FontBold = (lf.lfWeight > 400)
        .FontItalic = lf.lfItalic
        .FontName = StrConv(lf.lfFaceName, vbUnicode)
        .FontSize = -MulMul(lf.lfHeight, GetDeviceCaps(GetDC(0), 90&), 72)
        .FontStrikethru = lf.lfStrikeOut
        .FontUnderline = lf.lfUnderline
        .CancelError = True
        On Error Resume Next
        If Err Then Exit Function
        .ShowFont
        lf.lfHeight = -MulDiv(.FontSize, GetDeviceCaps(GetDC(0), 90&), 72)
        lf.lfItalic = Abs(.FontItalic)
        lf.lfStrikeOut = Abs(.FontStrikethru)
        lf.lfUnderline = Abs(.FontUnderline)
        lf.lfWeight = IIf(.FontBold, 700, 400)
        tmpArr = StrConv(.FontName & Chr$(0), vbFromUnicode)
        lArr = UBound(tmpArr)
        For i = 0 To lArr
            lf.lfFaceName(i) = tmpArr(i)
        Next i
        hFont = CreateFontIndirect(lf)
   End With
   ShowFontDialog = hFont
End Function

Private Function MulMul(arg1 As Long, arg2 As Long, arg3 As Long) As Integer
   Dim tmp As Single
   tmp = arg2 / arg3
   tmp = arg1 / tmp
   MulMul = CInt(tmp)
End Function

'Add common dialog control on form.
'And finally add following event handler on form:

Private Sub lvProperties_ItemClick(ByVal Item As MSComctlLib.ListItem)
   Dim varData As Variant, varValue As String, sType As String
   Dim pid As Long, BaseAddress As Long, iOffset As Long
   Dim sFont As StdFont
   pid = cbControls.Tag
   BaseAddress = cbControls.ItemData(cbControls.ListIndex)
   varData = Split(Item.Tag, "_")
   iOffset = varData(0)
   sType = varData(1)
   Select Case UCase(sType)
      Case "FONT"
          varValue = ShowFontDialog(CommonDialog1)
          SetControlProperty pid, BaseAddress, iOffset, sType, varValue
      Case Else
          varValue = InputBox("EnterNewValue for " & Item.Text, "Change property", Item.SubItems(1))
          SetControlProperty pid, BaseAddress, iOffset, sType, varValue
   End Select
   cbControls_Click
End Sub

'Now, you can change any property. For example, to change BackColor for label, just click on appropriate property and type &HFF in inputbox, press OK - you'll get red back color. To cahge font - click on font property and change font values in common dialog. I didn't apply code for Icons, Flags etc, but its not too difficult. It's even possible to make same property windows like in VB IDE for remote process!