j3877
asked on
Window Enumeration
The question suggests a slightly less complex system than is required... Basically I want to enumerate all open windows on the system, pick out the MSN Messenger Instant Message windows (probably just by checking if the caption ends in " - Instant Message"). Once I have the handles for these windows, I will then need to get the participants and the conversation (Participants in the "To: " text box near the top of the window, and the conversation is in a rich text box I'm guessing... although it's probably not.). It would then put the conversation text in a file (which would be just for that conversation... i can handle that part of it myself really...)
I know it's a lot to ask for 200 points... but it's part of a system logging program that I'm writing to make logging conversations, etc. easier.
Has anybody got any ideas?
I know it's a lot to ask for 200 points... but it's part of a system logging program that I'm writing to make logging conversations, etc. easier.
Has anybody got any ideas?
ASKER
Thanks - it's good, well laid out code... but I need to save the e-mail addresses of the participants, as well as the text for that chat...
Keep the ideas coming.
Keep the ideas coming.
Microsoft seems to not want to let other programs access its text in it's windows, so I devised a workaround. Replace the module's code with this (leave the form code the same)
Option Explicit
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd 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
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_COPY = &H301
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim sSave As String, Ret As Long
Dim ClsName As String
Dim hEmail As Long
Dim sEmail As String
Ret = GetWindowTextLength(hwnd)
sSave = Space(Ret)
GetWindowText hwnd, sSave, Ret + 1
If (sSave <> "") And (InStr(sSave, "Instant Message")) Then
sSave = Left(sSave, InStr(sSave, "- Instant Message") - 2)
ClsName = String(255, 0)
Ret = GetClassName(hwnd, ClsName, Len(ClsName))
ClsName = Left(ClsName, Ret)
If UCase(ClsName) = "IMWINDOWCLASS" Then
hEmail = FindWindowEx(hwnd, 0, "edit", vbNullString)
SendMessage hEmail, WM_COPY, 0, 0
sEmail = sSave & " " & Clipboard.GetText
'% sEmail = "Name <email@address.com>"
'%save it to a file here
End If
End If
EnumWindowsProc = True
End Function
hope that works!
Option Explicit
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd 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
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_COPY = &H301
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim sSave As String, Ret As Long
Dim ClsName As String
Dim hEmail As Long
Dim sEmail As String
Ret = GetWindowTextLength(hwnd)
sSave = Space(Ret)
GetWindowText hwnd, sSave, Ret + 1
If (sSave <> "") And (InStr(sSave, "Instant Message")) Then
sSave = Left(sSave, InStr(sSave, "- Instant Message") - 2)
ClsName = String(255, 0)
Ret = GetClassName(hwnd, ClsName, Len(ClsName))
ClsName = Left(ClsName, Ret)
If UCase(ClsName) = "IMWINDOWCLASS" Then
hEmail = FindWindowEx(hwnd, 0, "edit", vbNullString)
SendMessage hEmail, WM_COPY, 0, 0
sEmail = sSave & " " & Clipboard.GetText
'% sEmail = "Name <email@address.com>"
'%save it to a file here
End If
End If
EnumWindowsProc = True
End Function
hope that works!
ASKER
Ok once again... good code.. but I can't see the text for capturing the conversation text... am I missing something? :s
Im working on it! This is a bit more tricky :-D
ASKER
Thanks. I appreciate your speedy work so far :-D
ASKER
I remember seeing it as a feature in SubSeven (capturing text from an msn chat window)...
This link shows how to enumerate windows and child windows.
http://www.mvps.org/vbnet/index.html?code/enums/enumwindowsdemo.htm
http://www.mvps.org/vbnet/index.html?code/enums/enumwindowsdemo.htm
dgorin, the problem Im having is that the MSN child window's dont respond to WM_GETTEXT. Therefore I am using the clipboard as a go-between kinda...
here's some ugliness I put together:
Option Explicit
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd 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
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Const WM_COPY = &H301
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim sSave As String, Ret As Long
Dim ClsName As String, r As RECT
Dim hEmail As Long, hChat As String
Dim sEmail As String, AppTitle As String
Dim sChat As String
Ret = GetWindowTextLength(hwnd)
sSave = Space(Ret)
GetWindowText hwnd, sSave, Ret + 1
If (sSave <> "") And (InStr(sSave, "Instant Message")) Then
sSave = Left(sSave, InStr(sSave, "- Instant Message") - 2)
ClsName = String(255, 0)
Ret = GetClassName(hwnd, ClsName, Len(ClsName))
ClsName = Left(ClsName, Ret)
If UCase(ClsName) = "IMWINDOWCLASS" Then
AppTitle = sSave & " - Instant Message"
hEmail = FindWindowEx(hwnd, 0, "edit", vbNullString)
GetWindowRect hEmail, r
AppActivate AppTitle, True
SendMessage hEmail, WM_LBUTTONDOWN, 10, 10
SendMessage hEmail, WM_LBUTTONUP, 10, 10
SendKeys "{HOME} +{END}", True
SendMessage hEmail, WM_COPY, 0, 0
SendKeys "{HOME}", True
sEmail = Clipboard.GetText
hEmail = FindWindowEx(hwnd, 0, "RichEdit20W", vbNullString)
GetWindowRect hEmail, r
SendMessage hEmail, WM_LBUTTONDOWN, 10, 10
SendMessage hEmail, WM_LBUTTONUP, 10, 10
SendMessage hEmail, WM_COPY, 0, 0
SendKeys "{HOME}", True
sChat = Clipboard.GetText
Form1.Print "Contact: " & sEmail & vbCrLf & "Chat: " & Left(sChat, 25) & "..." & vbCrLf & vbCrLf
End If
End If
EnumWindowsProc = True
End Function
ahhhhhhhhhhhhhhhhhhhhhhhhh hhh
Option Explicit
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd 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
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Const WM_COPY = &H301
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim sSave As String, Ret As Long
Dim ClsName As String, r As RECT
Dim hEmail As Long, hChat As String
Dim sEmail As String, AppTitle As String
Dim sChat As String
Ret = GetWindowTextLength(hwnd)
sSave = Space(Ret)
GetWindowText hwnd, sSave, Ret + 1
If (sSave <> "") And (InStr(sSave, "Instant Message")) Then
sSave = Left(sSave, InStr(sSave, "- Instant Message") - 2)
ClsName = String(255, 0)
Ret = GetClassName(hwnd, ClsName, Len(ClsName))
ClsName = Left(ClsName, Ret)
If UCase(ClsName) = "IMWINDOWCLASS" Then
AppTitle = sSave & " - Instant Message"
hEmail = FindWindowEx(hwnd, 0, "edit", vbNullString)
GetWindowRect hEmail, r
AppActivate AppTitle, True
SendMessage hEmail, WM_LBUTTONDOWN, 10, 10
SendMessage hEmail, WM_LBUTTONUP, 10, 10
SendKeys "{HOME} +{END}", True
SendMessage hEmail, WM_COPY, 0, 0
SendKeys "{HOME}", True
sEmail = Clipboard.GetText
hEmail = FindWindowEx(hwnd, 0, "RichEdit20W", vbNullString)
GetWindowRect hEmail, r
SendMessage hEmail, WM_LBUTTONDOWN, 10, 10
SendMessage hEmail, WM_LBUTTONUP, 10, 10
SendMessage hEmail, WM_COPY, 0, 0
SendKeys "{HOME}", True
sChat = Clipboard.GetText
Form1.Print "Contact: " & sEmail & vbCrLf & "Chat: " & Left(sChat, 25) & "..." & vbCrLf & vbCrLf
End If
End If
EnumWindowsProc = True
End Function
ahhhhhhhhhhhhhhhhhhhhhhhhh
ASKER
it doesn't work for me :(
It just outputs the e-mail address twice:(
It just outputs the e-mail address twice:(
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
arghhhh and change the {END} to
+{END}
sorry bout all these posts!
+{END}
sorry bout all these posts!
ASKER
also another problem: I will be talking while this occurs... isn't there a way of sending keys to the window without it being active?
Im sure there is a way with sendmessage/wm_keydown/wm_ keyup, and that was my first idea. However, I couldnt get it to work :-/ I'll work on it some more tonight. Id work on it during the day but I have 2 baseball games to play. Sorry this is taking so long!
ASKER
It's okay... no huge rush:)
ASKER
Okay I've tweaked your code just slightly (and upped the points) and got it working - it wasn't working when i updated it from the code you gave me (probably a problem with my update) so i changed it thus:
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
ClipboardContents = Clipboard.GetText
Dim sSave As String, Ret As Long
Dim ClsName As String, r As RECT
Dim hEmail As Long, hChat As String
Dim sEmail As String, AppTitle As String
Dim sChat As String
Ret = GetWindowTextLength(hwnd)
sSave = Space(Ret)
GetWindowText hwnd, sSave, Ret + 1
If (sSave <> "") And (InStr(sSave, "Instant Message")) Then
sSave = Left(sSave, InStr(sSave, "- Instant Message") - 2)
ClsName = String(255, 0)
Ret = GetClassName(hwnd, ClsName, Len(ClsName))
ClsName = Left(ClsName, Ret)
If UCase(ClsName) = "IMWINDOWCLASS" Then
AppTitle = sSave & " - Instant Message"
hEmail = FindWindowEx(hwnd, 0, "edit", vbNullString)
GetWindowRect hEmail, r
AppActivate AppTitle, True
SendMessage hEmail, WM_LBUTTONDOWN, 10, 10
SendMessage hEmail, WM_LBUTTONUP, 10, 10
SendKeys "{HOME} +{END}", True
SendMessage hEmail, WM_COPY, 0, 0
SendKeys "{HOME}", True
sEmail = Clipboard.GetText
hEmail = FindWindowEx(hwnd, 0, "RichEdit20W", vbNullString)
GetWindowRect hEmail, r
SendMessage hEmail, WM_LBUTTONDOWN, 10, 10
SendMessage hEmail, WM_LBUTTONUP, 10, 10
SendKeys "{HOME} +{END}", True
SendMessage hEmail, WM_COPY, 0, 0
SendKeys "{HOME}", True
SendKeys "{TAB}^C{END}{TAB}", True
sChat = Clipboard.GetText
LogConversation sEmail, sChat
End If
End If
EnumWindowsProc = True
Clipboard.SetText ClipboardContents
End Function
So it now doesn't erase the clipboard's text, and will return the carat to the message field.
Is there a way to return the focus to the window which was active at the start?
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
ClipboardContents = Clipboard.GetText
Dim sSave As String, Ret As Long
Dim ClsName As String, r As RECT
Dim hEmail As Long, hChat As String
Dim sEmail As String, AppTitle As String
Dim sChat As String
Ret = GetWindowTextLength(hwnd)
sSave = Space(Ret)
GetWindowText hwnd, sSave, Ret + 1
If (sSave <> "") And (InStr(sSave, "Instant Message")) Then
sSave = Left(sSave, InStr(sSave, "- Instant Message") - 2)
ClsName = String(255, 0)
Ret = GetClassName(hwnd, ClsName, Len(ClsName))
ClsName = Left(ClsName, Ret)
If UCase(ClsName) = "IMWINDOWCLASS" Then
AppTitle = sSave & " - Instant Message"
hEmail = FindWindowEx(hwnd, 0, "edit", vbNullString)
GetWindowRect hEmail, r
AppActivate AppTitle, True
SendMessage hEmail, WM_LBUTTONDOWN, 10, 10
SendMessage hEmail, WM_LBUTTONUP, 10, 10
SendKeys "{HOME} +{END}", True
SendMessage hEmail, WM_COPY, 0, 0
SendKeys "{HOME}", True
sEmail = Clipboard.GetText
hEmail = FindWindowEx(hwnd, 0, "RichEdit20W", vbNullString)
GetWindowRect hEmail, r
SendMessage hEmail, WM_LBUTTONDOWN, 10, 10
SendMessage hEmail, WM_LBUTTONUP, 10, 10
SendKeys "{HOME} +{END}", True
SendMessage hEmail, WM_COPY, 0, 0
SendKeys "{HOME}", True
SendKeys "{TAB}^C{END}{TAB}", True
sChat = Clipboard.GetText
LogConversation sEmail, sChat
End If
End If
EnumWindowsProc = True
Clipboard.SetText ClipboardContents
End Function
So it now doesn't erase the clipboard's text, and will return the carat to the message field.
Is there a way to return the focus to the window which was active at the start?
ASKER
Okay I've done that - it now only saves text from the window that's currently being worked in every so often.
'------------ In module -------------'
Option Explicit
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd 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
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim sSave As String, Ret As Long
Dim ClsName As String
Ret = GetWindowTextLength(hwnd)
sSave = Space(Ret)
GetWindowText hwnd, sSave, Ret + 1
If (sSave <> "") And (InStr(sSave, "Instant Message")) Then
sSave = Left(sSave, InStr(sSave, "- Instant Message") - 2)
ClsName = String(255, 0)
Ret = GetClassName(hwnd, ClsName, Len(ClsName))
ClsName = Left(ClsName, Ret)
If UCase(ClsName) = "IMWINDOWCLASS" Then
'%%%%%%%%%%%%%%%%%%%%%%%%%
'%%% Write to file %%%%%%%%%%%
'%%% Chatting with = sSave %%%
'%%%%%%%%%%%%%%%%%%%%%%%%%
End If
End If
EnumWindowsProc = True
End Function
'------------- In form code --------------'
Private Sub Command1_Click()
'Find MSN windows
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
End Sub
hope that helps!