Problema con SendMenssage y Google Chrome

[m[a]rkus]

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 :

Código: (vb) [Seleccionar]


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

[raul338]

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

Código: (vb) [Seleccionar]

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

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 , eso si, tienen que esperar momentito. GetWindowText no funciona con chrome u.u

[ssccaann43]

jajajaja, raul te pasaste..! Buen code...!

[m[a]rkus]

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.

Código: (vb) [Seleccionar]

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



[raul338]

Con opera se puede hacer mediante otro Mensaje DDE

http://jp.opera.com/support/kb/view/263/

Código: (vb) [Seleccionar]

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

[wavecorporate]

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!

[SKL]

Es viejo esto pero ya que estamos consulto, alguno sabe como obtener la url del chrome, mozilla y IE ?

[LeandroA]

Fijate en el codigo del keylogger que esta en el blog

Enviado desde mi MB525 usando Tapatalk 2