Obtener Urls navegadores

[noele1995]

Bueno el otro dia se me ocurrio obtener las urls de los navegadores (para nada bueno   ) y buscando encontre una funcion de nuestro compañero LeandroA, pero esta solo podia sacar las URLs de Firefox,IExplorer y Opera. Me he puesto a investigar un poco para añadirle algun navegador mas y esto es lo que he sacado. A la funcion se le pasa el caption de la ventana de la que se queire obtener la url.

Código (vb) [Seleccionar] Expandir

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 lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 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 GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long

Private Const FIREFOX       As String = "firefox"
Private Const OPERA         As String = "opera"
Private Const IEXPLORER     As String = "iexplore"
Private Const CHROME        As String = "chrome"
Private Const NETCAPTOR     As String = "netcaptor"

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 WM_GETTEXT = &HD

Private Type WindowNavegador
    Hwnd    As Long
    Class   As String
End Type

Private WindowsNavegadores() As WindowNavegador

Public Function GetBrowserInfo(ByVal Hwnd As Long, Optional ByVal WinCaption As String) As String
On Error Resume Next
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, sServer    As String
Dim Ret         As Long, i          As Long
Dim sBuffer     As String, CLASS_1 As String, CLASS_2 As String

If WinCaption = "" Then
    sBuffer = String$(1024, Chr$(0))
    SendMessage Hwnd, WM_GETTEXT, Len(sBuffer), sBuffer
    WinCaption = Replace$(sBuffer, Chr$(0), "")
    If WinCaption = "" Then Exit Function
End If

If InStr(1, LCase$(WinCaption), LCase$(CHROME)) <> 0 Then sServer = CHROME: CLASS_1 = "Chrome_OmniboxView": CLASS_2 = "Chrome_AutocompleteEditView"
If InStr(1, LCase$(WinCaption), LCase$(FIREFOX)) <> 0 Then sServer = FIREFOX
If InStr(1, LCase$(WinCaption), LCase$("INTERNET EXPLORER")) <> 0 Then sServer = IEXPLORER
If InStr(1, LCase$(WinCaption), LCase$(OPERA)) <> 0 Then sServer = OPERA
If InStr(1, LCase$(WinCaption), LCase$(NETCAPTOR)) <> 0 Then sServer = NETCAPTOR: CLASS_1 = "Edit": CLASS_2 = "Edit"
If sServer = "" Then Exit Function

If sServer = FIREFOX Or sServer = OPERA Or sServer = IEXPLORER Then
    If DdeInitialize(idInst, 0, 0, 0) <> 0 Then Exit Function
   
    hServer = DdeCreateStringHandle(idInst, sServer, CP_WINANSI)
    hTopic = DdeCreateStringHandle(idInst, "WWW_GetWindowInfo", CP_WINANSI)
    hItem = DdeCreateStringHandle(idInst, "0xFFFFFFFF", 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
   
    If GetBrowserInfo <> "" Then GetBrowserInfo = Split(GetBrowserInfo, ",")(0)
    If Right$(GetBrowserInfo, 1) = """" Then GetBrowserInfo = Left$(GetBrowserInfo, Len(GetBrowserInfo) - 1)
    If Left$(GetBrowserInfo, 1) = """" Then GetBrowserInfo = Right$(GetBrowserInfo, Len(GetBrowserInfo) - 1)
End If

If sServer = CHROME Or sServer = NETCAPTOR Then
    ReDim WindowsNavegadores(0)
   
    EnumChildWindows Hwnd, AddressOf EnumChildWndProc, 0&
   
    sBuffer = String$(1024, Chr$(0))
    For i = 1 To UBound(WindowsNavegadores)
        If WindowsNavegadores(i).Class = CLASS_1 Or WindowsNavegadores(i).Class = CLASS_2 Then
            SendMessage WindowsNavegadores(i).Hwnd, WM_GETTEXT, Len(sBuffer), sBuffer
            GetBrowserInfo = Replace$(sBuffer, Chr$(0), "")
            Exit Function
        End If
    Next i
End If
End Function

Public Function EnumChildWndProc(ByVal Hwnd As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim Ret     As Long, sText  As String * 255

ReDim Preserve WindowsNavegadores(UBound(WindowsNavegadores) + 1)
WindowsNavegadores(UBound(WindowsNavegadores)).Hwnd = Hwnd

Ret = GetClassName(Hwnd, sText, 255)
If Ret <> 0 Then
    WindowsNavegadores(UBound(WindowsNavegadores)).Class = Left$(sText, Ret)
End If

EnumChildWndProc = 1
End Function

La funcion esta un poco chapucera pero sirve :DD

PD: Espero que a LeandroA no le moleste haber modificado su funcion

Salu2 Noele1995



Edit: He puesto la funcion mas ordenada con los parametros que deberia llevar y mas cortita. Safari no lo he conseguido hacer si alguien tiene una idea de como sacar la url de safari que ponga un ejemoplo o me indique un poco porque estoy dando palos a ciegas.

[Karcrack]

LeandroA también mostró que puedes hacerlo con un label y las opciones DDE* del mismo. Muy útil si estás utilizando algún formulario y quieres ahorrar code.

Un saludo

[noele1995]

Si, eso se puede hacer en vez de usar las apis dde pero solo funciona con iexplorer, firefox y opera (igual que usando las apis), los demas no implementas las conversaciones dde y hay que buscar la ventana en la que se muestra la url para sacarla :-)

[raul338]

si algo así se habia hablado en su foro

Aunque de la forma recorrer por ventanas no te asegura que funcione en todos los chrome

[seba123neo]

los navegadores mas usados del mundo segun las estadisticas son IE,Chrome,Firefox, Opera y Safari los otros ni figuran, no me calentaria en hacerlo para otros que no sean estos.

[noele1995]

Si pero la forma esa de obtener el handle de la ventana del chrome no me funcionaba y aparte con el spy++ vi que la ventana que tenia la url no era esa aunque la debere modificar para todas las versiones.

Si, safari lo hare cuando tenga un rato netcaptor lo he hecho porque era el navegador que usaba antes y me apetecia.



Ahira que los pienso la funcion esta chapucera porqye si tienes el caption de l ventana tienes el hwnd y hay mas variables de las que deberia, hoy no puedo pero mañana la pongo optimizada y con el safari incluido 

salu2 Noele1995