Lifting text from another app

Just wondering, is there a way of lifting text from labels in another application ?

Thanks,
Jamie.

Yes, but im not telling you how to do it!!!

;)

(just kidding, ill post a sample app in a minute)

Oh thank-you kindly ;)

Code:

---

Option Explicit

Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName$, _
ByVal lpWindowName$)

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal _
wMsg&, ByVal wParam&, lParam As Any)
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Declare Function SendMessageByStr& Lib "user32" Alias "SendMessageA" _
 (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal _
  lParam As String)

Private Sub cmdLiftIt_Click()
Dim t$
Dim c&
Dim hApp&
Dim hLabel&
  t = String(256, " ")
  'insert the right windowname obviously (MSDN just an example)
  hApp = FindWindowEx(0&, 0&, vbNullString, "MSDN Library - April 2001")
  hLabel = FindWindowEx(hApp, 0&, "Static", vbNullString)
  c = SendMessageByStr(hLabel, WM_GETTEXT, 256, t)
  MsgBox Trim(t)
End Sub

---

now the only other problem is to search for the right label, you could modify this to recurse all labels in a parent window (lemme know if you want that code too, and i will supply)

Yes please do supply :)

Sorry abou the delay Jamie, I got mixed up with processes,threads, kangaroos - sh*! thats a different story, anyhow, heres the code:

Code:

---

'in a form
Option Explicit

Private Sub command1_Click()
  Dim hApp&
  Dim retval&
  Dim lParam&
  Dim v As Variant
  hApp = FindWindowEx(0&, 0&, vbNullString, "MSDN Library - April 2001")
  retval = EnumChildWindows(hApp, AddressOf EnumChildProc, lParam)
  For Each v In clabels
    Debug.Print v
  Next v
End Sub


'in a module
Option Explicit
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent _
As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
  (ByVal hwnd As Long, ByVal lpClassName As String, _
  ByVal nMaxCount As Long) As Long
 
Private Const WM_GETTEXT = &HD

Private Declare Function SendMessageByStr& Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal _
lParam As String)
Public clabels As New Collection
 
Function EnumChildProc(ByVal lhWnd As Long, ByVal lParam As Long) As Long
  Dim retval As Long
  Dim t$
  Dim c&
  Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
  Dim WinClass As String, WinTitle As String
  Dim WinWidth As Long, WinHeight As Long
  t = String(256, " ")
  retval = GetClassName(lhWnd, WinClassBuf, 255)
  WinClass = StripNulls(WinClassBuf)
  If WinClass = "Static" Then
    c = SendMessageByStr(lhWnd, WM_GETTEXT, 256, t)
    clabels.Add Trim(t)
  End If
  Debug.Print WinClass
  EnumChildProc = True
End Function

Public Function StripNulls(OriginalStr As String) As String
  If (InStr(OriginalStr, Chr(0)) > 0) Then
      OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
  End If
  StripNulls = OriginalStr
End Function

---

The code looks great, but it only seems to be able to grab the class names, not the captions themselves .... should I be doing something specific ?

when it iterates the collection at the end and debug.prints the captions does it not give you the captions - I worked hard on that bit...

;)

... no it just gives the class names, no captions ...

works fine for me

is it a VB app?

Not a notion :)
But I tested it on a vb app and it didnt work either.

Looking at the code, I see no reason why it would print the captions of the controls ....

I had problems trying it with the API viewer, I think it's because vb labels don't have a hwnd or something like that, i'll keep working on it, maybe i'll ask Megatron about this one im getting a bit stuck - sorry

Well im trying it with a database app.
I would be very grateful if you could get this working :)

Use Spy++ to see if you can highlight the Labels, if you can it will work, if you can't then it will not

some programs such as Office have protections against doing this

Yeah thats what I have been doing, I reckon there must be some slimy hack out there somewhere to do this!

If it means anything, VB Labels do not have a hWnd. So you can't use an API function to get the text out of a VB label.

I can use Spy++ to get the captions out of my own apps, but I cant use your code to do it ...

Any progress ?

Try replacing EnumChildProc in the code from crispin with this: (It's in the module)

Code:

---

Function EnumChildProc(ByVal lhWnd As Long, ByVal lParam As Long) As Long
  Dim retval As Long
  Dim t$
  Dim c&
  Dim WinClassBuf As String * 255, WinTitleBuf As String * 255
  Dim WinClass As String, WinTitle As String
  Dim WinWidth As Long, WinHeight As Long
  t = String(256, " ")
  retval = GetClassName(lhWnd, WinClassBuf, 255)
  WinClass = StripNulls(WinClassBuf)
  c = SendMessageByStr(lhWnd, WM_GETTEXT, 256, t)
  If c > 0 Then
    t = Left(t, c)
    clabels.Add "ClassName: " & WinClass & vbTab & "Text: " & t
  End If
  'Debug.Print WinClass
  EnumChildProc = True
End Function

---

This was changed to list everything on the window it can get text for. And it lists the ClassName and Text together. See if it shows the contents of any of the labels you want.

If it doesn't, I don't think it is possible to get the contents of these labels.

Its getting some labels ...