Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: m[a]rkus en Diciembre 28, 2010, 06:34:44 pm
-
Bueno el probleme en si es k estoy tratando de obtener todas las ventanas hijo (Childs) del google chrome para coger solo una que me interesa pero al listarlas no me da ninguna ventana hijo desde la ventana padre pero con el Spy++ y el WinId si me sale la ventana hijo que quiero que es "Chrome_AutocompleteEditView" , por lo que queria ver si me pueden ayudar a encontrar esa ventana del Chrome, hasta ahora eh estado provando con este code y me funciona con cualquier otro programa que no sea Chrome pero no para el mismo :
Option Explicit
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Const WM_SETTEXT As Long = &HC
Private lCount As Long
Sub Main()
Call Chrome("Hola JAJA?")
End Sub
Public Function Chrome(ByVal pNewURL As String) As Boolean
Dim phWnd As Long
Const pClass As String = "Chrome_WidgetWin_0"
Const pURL As String = "Chrome_AutocompleteEditView"
phWnd = FindWindow(pClass, vbNullString)
' SendMessage ByVal &H209A0, WM_SETTEXT, 0, ByVal pNewURL
If phWnd <> 0 Then
phWnd = FindWindowEx(phWnd, 0&, ByVal pURL, vbNullString)
EnumWindows phWnd
End If
End Function
Private Function CallBackEnumWindowChild(ByVal handle As Long, ByVal lParam As Long) As Boolean
CallBackEnumWindowChild = True
Dim pBuffer As String * 260
GetWindowText handle, pBuffer, Len(pBuffer)
pBuffer = Left$(pBuffer, InStr(1, pBuffer, Chr$(0)) - 1)
Debug.Print pBuffer
'SendMessage ByVal phWnd, WM_SETTEXT, 0, pNewURL
lCount = lCount + 1
End Function
Public Sub EnumWindows(lHwnd As Long)
lCount = 0
If lHwnd <> 0 Then
EnumChildWindows lHwnd, AddressOf CallBackEnumWindowChild, ByVal 0&
End If
End Sub
Saludos y espero que me puedan echar una manito ;)
-
Pues tu metodo de obtener el hwnd de la ventana del URL no me funciono xD (Sera que uso una version modificada de chromium?)
Pero este si :P
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnumWindows Lib "user32.dll" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Const WM_SETTEXT As Long = &HC
Private Const WM_GETTEXT As Long = &HD
Private sUrl As String
Private bcontinue As Boolean
Private bGetSet As Boolean
Public Const GoogleMainWin As String = "Chrome_WidgetWin_0"
Public Const GoogleUrlWin As String = "Chrome_AutocompleteEditView"
Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim sClass As String
sClass = String$(255, 0)
Call GetClassName(hwnd, sClass, 255)
sClass = Trim$(Replace$(sClass, vbNullChar, vbNullString))
If sClass = GoogleMainWin Then
Call EnumChildWindows(hwnd, AddressOf EnumChildWindowsProc, ByVal 0&)
End If
EnumWindowsProc = bcontinue
End Function
Private Function EnumChildWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim sClass As String
sClass = String$(255, 0)
Call GetClassName(hwnd, sClass, 255)
sClass = Trim$(Replace$(sClass, vbNullChar, vbNullString))
If sClass = GoogleUrlWin Then
If bGetSet Then
Call SendMessage(hwnd, WM_SETTEXT, Len(sUrl) + 1, ByVal sUrl & vbNullChar)
bcontinue = False
EnumChildWindowsProc = False
Else
sUrl = String$(255, 0)
Call SendMessage(hwnd, WM_GETTEXT, 255, ByVal sUrl)
sUrl = Trim$(Replace$(sUrl, vbNullChar, vbNullString))
End If
EnumChildWindowsProc = False
bcontinue = False
End If
EnumChildWindowsProc = True
End Function
Public Function GetURLCHrome() As String
If FindWindow(GoogleMainWin, vbNullString) = 0 Then Exit Function
bGetSet = False
bcontinue = True
Call EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
While bcontinue
DoEvents
Wend
GetURLCHrome = sUrl
End Function
Public Sub CambiarURLChrome(ByVal newURL As String)
If FindWindow(GoogleMainWin, vbNullString) = 0 Then Exit Sub
bGetSet = True
sUrl = newURL
bcontinue = True
Call EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
End Sub
Public Sub main()
Debug.Print GetURLCHrome()
Call CambiarURLChrome("Raul338 FTW!")
End Sub
Se, me quise pasar y puse también para obtener la url activa de chrome, haber si Leandro lo pone en su keylogger xD
PD: Va todo en un modulo :P
Lo mismo sirve para obtener la url de la pestaña activa de cada ventana chrome, solo tienen que cambiar WM_SETTEXT por WM_GETTEXT (busquen la declaracion xD) y listo :P , eso si, tienen que esperar momentito. GetWindowText no funciona con chrome u.u
-
jajajaja, raul te pasaste..! Buen code...!
-
Muchas Gracias funciona perfecto, pero ahora tengo un problema parecido pero con Firefox y Opera que no tienen hwnd para la barra de navegación, alguna idea de como se puede cambiar ? tengo esto hecho fue lo que se me ocurrio.
Option Explicit
Private Declare Function DdeInitialize Lib "user32" Alias "DdeInitializeA" (pidInst As Long, ByVal pfnCallback As Long, ByVal afCmd As Long, ByVal ulRes As Long) As Integer
Private Declare Function DdeCreateStringHandle Lib "user32" Alias "DdeCreateStringHandleA" (ByVal idInst As Long, ByVal psz As String, ByVal iCodePage As Long) As Long
Private Declare Function DdeConnect Lib "user32" (ByVal idInst As Long, ByVal hszService As Long, ByVal hszTopic As Long, pCC As Any) As Long
Private Declare Function DdeFreeStringHandle Lib "user32" (ByVal idInst As Long, ByVal hsz As Long) As Long
Private Declare Function DdeUninitialize Lib "user32" (ByVal idInst As Long) As Long
Private Declare Function DdeClientTransaction Lib "user32.dll" (ByVal pData As Long, ByVal cbData As Long, ByVal hConv As Long, ByVal hszItem As Long, ByVal wFmt As Long, ByVal wType As Long, ByVal dwTimeout As Long, ByRef pdwResult As Long) As Long
Private Declare Function DdeAccessData Lib "user32.dll" (ByVal hData As Long, ByRef pcbDataSize As Long) As Long
Private Declare Function DdeUnaccessData Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeFreeDataHandle Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeDisconnect Lib "user32.dll" (ByVal hConv As Long) As Long
Private Declare Function DdeGetLastError Lib "user32.dll" (ByVal idInst As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const XCLASS_DATA As Long = &H2000
Private Const XTYP_REQUEST As Long = (&HB0 Or XCLASS_DATA)
Private Const CP_WINANSI As Long = 1004
Private Const CF_TEXT As Long = 1
Private Const FIREFOX As String = "firefox"
Private Const OPERA As String = "opera"
Private Const IEXPLORER As String = "iexplore"
'-------------------------------------------
Private Const WBuscar As String = "www.cine.com"
Private Const WFalsa As String = "www.cinemas.com"
Private Function GetBrowserInfo(ByVal sServer As String) As String
Dim lpData As Long, hData As Long, sData As String
Dim hServer As Long, hTopic As Long, hItem As Long
Dim hConv As Long, idInst As Long
Dim sBuffer As String
Const sTopic = "WWW_GetWindowInfo"
Const sItem = "0xFFFFFFFF"
If DdeInitialize(idInst, 0, 0, 0) <> 0 Then Exit Function
hServer = DdeCreateStringHandle(idInst, sServer, CP_WINANSI)
hTopic = DdeCreateStringHandle(idInst, sTopic, CP_WINANSI)
hItem = DdeCreateStringHandle(idInst, sItem, CP_WINANSI)
hConv = DdeConnect(idInst, hServer, hTopic, ByVal 0&)
If hConv Then
hData = DdeClientTransaction(0, 0, hConv, hItem, CF_TEXT, XTYP_REQUEST, 1000, 0)
lpData = DdeAccessData(hData, 500)
sBuffer = String(500, Chr(0))
lstrcpy sBuffer, lpData
GetBrowserInfo = Left$(sBuffer, InStr(sBuffer, Chr(0)) - 1)
DdeUnaccessData hData
DdeFreeDataHandle hData
DdeDisconnect hConv
End If
DdeFreeStringHandle idInst, hServer
DdeFreeStringHandle idInst, hTopic
DdeFreeStringHandle idInst, hItem
DdeUninitialize idInst
End Function
Private Sub Form_Load()
' MsgBox GetBrowserInfo(OPERA)
' MsgBox GetBrowserInfo(IEXPLORER)
' MsgBox GetBrowserInfo(FIREFOX)
End Sub
Private Sub Timer1_Timer()
Debug.Print GetBrowserInfo(FIREFOX)
Debug.Print GetBrowserInfo(OPERA)
If InStr(1, GetBrowserInfo(FIREFOX), WBuscar) Then
Call CambiarURL
Else
If InStr(1, GetBrowserInfo(OPERA), WBuscar) Then
Call CambiarURLOP
End If
End If
End Sub
Private Sub CambiarURL()
Timer1.Enabled = False
'MsgBox ("Entro al F6")
SendKeys ("{F6}")
Sleep (250)
SendKeys (WFalsa)
Sleep (100)
SendKeys ("{ENTER}")
'Timer1.Enabled = True
Sleep (250)
SendKeys ("{F6}")
SendKeys (WBuscar)
Sleep (100)
SendKeys ("{ESC}")
End Sub
Private Sub CambiarURLOP()
Timer1.Enabled = False
SendKeys ("{F8}")
Sleep (250)
SendKeys (WFalsa)
Sleep (100)
SendKeys ("{ENTER}")
'Timer1.Enabled = True
Sleep (250)
SendKeys ("{F8}")
SendKeys (WBuscar)
Sleep (100)
SendKeys ("{ESC}")
End Sub
-
Con opera se puede hacer mediante otro Mensaje DDE
http://jp.opera.com/support/kb/view/263/ (http://jp.opera.com/support/kb/view/263/)
Private Declare Function DdeInitialize Lib "user32" Alias "DdeInitializeA" (pidInst As Long, ByVal pfnCallback As Long, ByVal afCmd As Long, ByVal ulRes As Long) As Integer
Private Declare Function DdeCreateStringHandle Lib "user32" Alias "DdeCreateStringHandleA" (ByVal idInst As Long, ByVal psz As String, ByVal iCodePage As Long) As Long
Private Declare Function DdeConnect Lib "user32" (ByVal idInst As Long, ByVal hszService As Long, ByVal hszTopic As Long, pCC As Any) As Long
Private Declare Function DdeFreeStringHandle Lib "user32" (ByVal idInst As Long, ByVal hsz As Long) As Long
Private Declare Function DdeUninitialize Lib "user32" (ByVal idInst As Long) As Long
Private Declare Function DdeClientTransaction Lib "user32.dll" (ByRef pData As Byte, ByVal cbData As Long, ByVal hConv As Long, ByVal hszItem As Long, ByVal wFmt As Long, ByVal wType As Long, ByVal dwTimeout As Long, ByRef pdwResult As Long) As Long
Private Declare Function DdeAccessData Lib "user32.dll" (ByVal hData As Long, ByRef pcbDataSize As Long) As Long
Private Declare Function DdeUnaccessData Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeFreeDataHandle Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeDisconnect Lib "user32.dll" (ByVal hConv As Long) As Long
Private Declare Function DdeGetLastError Lib "user32.dll" (ByVal idInst As Long) As Long
Private Const XCLASS_DATA As Long = &H2000
Private Const XTYP_REQUEST As Long = (&HB0 Or XCLASS_DATA)
Private Const CP_WINANSI As Long = 1004
Private Const CF_TEXT As Long = 1
Public Sub main()
' NOTA: Si o si debe ser una url valida, si no ponen la barra al
' final, no se pondra la URL completa segun el navegador
Debug.Print SetURL("firefox", "http://www.Raul338.com.ar/")
Debug.Print SetURL("opera", "http://www.Raul338.com.ar/")
Debug.Print SetURL("iexplore", "http://www.Raul338.com.ar/")
End Sub
Public Function SetURL(ByVal navegador As String, ByVal sUrl As String) As Boolean
If navegador = "opera" Or navegador = "firefox" Or navegador = "iexplore" Then
Dim lpData As Long, hData As Long, sData As String
Dim hServer As Long, hTopic As Long, hItem As Long
Dim hConv As Long, idInst As Long
Const sTopic = "WWW_OpenURL"
If DdeInitialize(idInst, 0, 0, 0) <> 0 Then Exit Function
hServer = DdeCreateStringHandle(idInst, navegador, CP_WINANSI)
hTopic = DdeCreateStringHandle(idInst, sTopic, CP_WINANSI)
hItem = DdeCreateStringHandle(idInst, sUrl, CP_WINANSI)
hConv = DdeConnect(idInst, hServer, hTopic, ByVal 0&)
If hConv Then
hData = DdeClientTransaction(0, 0, hConv, hItem, CF_TEXT, XTYP_REQUEST, 1000, 0)
Call DdeUnaccessData(hData)
Call DdeFreeDataHandle(hData)
Call DdeDisconnect(hConv)
End If
SetURL = hConv
Call DdeFreeStringHandle(idInst, hServer)
Call DdeFreeStringHandle(idInst, hTopic)
Call DdeFreeStringHandle(idInst, hItem)
Call DdeUninitialize(idInst)
End If
End Function
Ahi esta, lo malo es que si o si los navegadores deben estar abiertos :P
-
Conheço muitos sites e fóruns... Mas, esse é um dos melhores. estava com problema em um aplicativo a tempos e consegui achar a resposta nesse estimado site. Parabéns para os idealizadores, bem como, a todos os usuários do site!
:)
-
Es viejo esto pero ya que estamos consulto, alguno sabe como obtener la url del chrome, mozilla y IE ????
-
Fijate en el codigo del keylogger que esta en el blog
Enviado desde mi MB525 usando Tapatalk 2