+ Rispondi al Thread
Visualizzazione dei risultati da 1 a 8 su 8

Discussione: Prelevare gli URL delle TAB aperte in Firefox tramite VBA

  1. #1
    BennyB non è in linea Scolaretto
    Post
    102

    Prelevare gli URL delle TAB aperte in Firefox tramite VBA

    Buongiorno.
    Ho un problema che non riesco a risolvere, anche cercando nelle segrete stanze del WEB.
    Vorrei riuscire a copiare con VBA gli URL delle schede aperte in Firefox, e poi salvarli in sequenza in un foglio di Excel (quest'ultima parte, una volta prelevati dli indirizzi, la so fare da solo, ovviamente).
    Non credo sia proprio facile. Spero che qualcuno abbia affrontato il problema e abbia qualcosa da proporre.
    C'è questa "soluzione", ma mi pare fuori dal mio seminato: https://autohotkey.com/boards/viewtopic.php?t=3702

    Grazie.

  2. #2
    L'avatar di @Alex
    @Alex non è in linea Very Important Person
    Post
    15,606
    È ben più complesso di quello che pensi....
    Ti passo un link, ci sono 2 tecniche, una quella API è la più corretta ma la più complessa per chi ha poca dimestichezza... l'altra potrebbe essere affetta da interpretazioni.
    Get current URL from Browser - Xtreme Visual Basic Talk
    @Alex
    Il CROSSPOST è VIETATO
    Mirror al vecchio sito WEB(salvare i Demo riassegnando l'estensione (.Zip/.Rar/.Exe in base all'icona...):
    http://mirror.masterdrive.it/alessandrobaraldi/
    Leggi il
    Regolamento del Forum e nel comprenderne la filosofia rispettalo.

  3. #3
    BennyB non è in linea Scolaretto
    Post
    102
    Grazie della risposta, Alex.
    Replico solo oggi perchè ci sono state le vacanze di mezzo.
    Allora, non credevo affatto che fosse facile, anzi, e me ne hai dato piena conferma.
    Ho preso visione del link, e proverò ad approfondire. Spero di riuscire ad applicare la tecnca API; sarà l'occasione per approfondire la mia (scarsa) conoscenza in merito.
    Spero di trovare il bandolo...

  4. #4
    BennyB non è in linea Scolaretto
    Post
    102
    Allora, Alex, ho provato la routine descritta nell parte finale della discussione al link che mi hai indicato.
    Non funziona, o meglio forse sbaglio qualcosa.
    Se chiamo la funzione GetURLList, ottengo sempre una stringa vuota. Ho controllato, e ho visto che nella funzione EnumProc la variabile title è sempre vuota. Pure length è sempre 0. Sto lavorando con Firefox aperto con 3 tabs. Se title è vuota, la IF successiva è inutile, ovviamente, e quindi modificarla non ha senso.
    Non so se riesci a capire dove sbaglio, spero di sì.

  5. #5
    BennyB non è in linea Scolaretto
    Post
    102
    Credo che la mia risposta precedente sia "fumosa" perché non c'è il codice che ho verificato.
    Lo aggiungo. Utilizza le API di Windows, e come sopra detto non funziona correttamente. Almeno per quanto mi riguarda.
    Riporto paro paro quello descritto in xtremevbtalk.com, che in gran parte viene dichiarato funzionante (tranne una parte della routine d'estrazione degli urls che deve essere affinata tramite l'istruzione IsValidURL, e che non ho preso in considerazione perché l'errore è di certo a monte). Il codice è questo:
    codice:
    Option Explicit
    
    Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Any, ByVal lParam As Long) As Long
    
    Private Type ProcData
        AppHwnd As Long
        title As String
        Placement As String
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
    
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
    
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd 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 Long, lParam As Any) As Long
    
    Private Const WM_GETTEXT = &HD
    Private Const WM_GETTEXTLENGTH = &HE
    
    Private Const GW_CHILD = 5
    Private Const GW_HWNDNEXT = 2
    Private Const GW_HWNDFIRST = 0
    
    'string that will contain the List of URL's, seperated by ","
    Private sURLList As String
    
    
    Public Function GetURLList() As String
        sURLList = ""
        
        EnumWindows AddressOf EnumProc, 0
        
        If Len(sURLList) > 0 Then
            sURLList = Mid(sURLList, 2) 'cut the leading ","
        End If
        
        GetURLList = sURLList
        
    End Function
    
    
    ' If this window is of the Edit class, return
    ' its contents. Otherwise search its children
    ' for an Edit object.
    Private Function EditInfo(window_hwnd As Long) As String
        Dim txt As String
        Dim buf As String
        Dim buflen As Long
        Dim child_hwnd As Long
        Dim children() As Long
        Dim num_children As Integer
        Dim i As Integer
        
        
        
        ' Get the class name.
        buflen = 256
        buf = Space$(buflen - 1)
        buflen = GetClassName(window_hwnd, buf, buflen)
        buf = Left$(buf, buflen)
        
        ' See if we found an Edit object.
        If buf = "Edit" Then
            EditInfo = WindowText(window_hwnd)
            Exit Function
        End If
        
        ' It's not an Edit object. Search the children.
        ' Make a list of the child windows.
        num_children = 0
        child_hwnd = GetWindow(window_hwnd, GW_CHILD)
        Do While child_hwnd <> 0
            num_children = num_children + 1
            ReDim Preserve children(1 To num_children)
            children(num_children) = child_hwnd
            
            child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT)
        Loop
        
        ' Get information on the child windows.
        For i = 1 To num_children
            txt = EditInfo(children(i))
            If txt <> "" Then Exit For
        Next i
    
        EditInfo = txt
    End Function
    ' ************************************************
    ' Return the text associated with the window.
    ' ************************************************
    Private Function WindowText(window_hwnd As Long) As String
    Dim txtlen As Long
    Dim txt As String
    
        WindowText = ""
        If window_hwnd = 0 Then Exit Function
        
        txtlen = SendMessage(window_hwnd, WM_GETTEXTLENGTH, 0, 0)
        If txtlen = 0 Then Exit Function
        
        txtlen = txtlen + 1
        txt = Space$(txtlen)
        txtlen = SendMessage(window_hwnd, WM_GETTEXT, txtlen, ByVal txt)
        WindowText = Left$(txt, txtlen)
    End Function
    
    
    Private Function EnumProc(ByVal app_hwnd As Long, ByVal lParam As Long) As Boolean
        Dim buf As String * 1024
        Dim title As String
        Dim length As Long
    
        ' Get the window's title.
        length = GetWindowText(app_hwnd, buf, Len(buf))
        title = Left$(buf, length)
    
        ' See if the title ends with " - Netscape" or " -  Microsoft Internet Explorer".
        If Right$(title, 10) = " -Netscape" Or Right$(title, 30) = " - Microsoft Internet Explorer" Then
            ' This is it. Find the ComboBox information.
            sURLList = sURLList & "," & EditInfo(app_hwnd)
        End If
        
        ' Continue searching
        EnumProc = 1
        
    End Function
    Per verificarlo, ho aggiunto una banale sub:
    codice:
    Sub p()
    Debug.Print GetURLList
    End Sub
    Il problema è che GetURLList è sempre vuoto. Non ho familiarità con le API, e sto cercando di approfondire. Al momento, il problema principale da quel che vedo è che nella funzione EnumProc, che è chiamata subito nella funzione (EnumWindows AddressOf EnumProc, 0), tutte le Windows rilevate dovrebbero elencare l'identificativo nella variabile buf,per ricavarne lunghezza e testo della stringa con questa parte di codice:
    codice:
        ' Get the window's title.
        length = GetWindowText(app_hwnd, buf, Len(buf))
        title = Left$(buf, length)
    Invece, buf è sempre composta di soli spazi, e quindi length è sempre 0 e title è sempre una stringa vuota.
    Se in precedenza, almeno da quanto detto dal programmatore di xtremevbtalk.com, l'estrazione funzionava, vuol dire che c'è qualcosa che non torna, e io, con i miei mezzi odierni, non riesco a individuarlo.
    C''è qualcuno in gradi aiutarmi?

    Spero nel forum!

    Grazie.

  6. #6
    BennyB non è in linea Scolaretto
    Post
    102

    Una possibile soluzione

    Ci ho lavorato un po', ho studiacchiato, e ho approfondito qualche variante. Infine, grazie al suggerimento di un amico, ho trovato una strada. Non è la perfezione, ma permette almeno di accedere agli URLs delle schede aperte.
    Vado con ordine.
    Anzitutto, ho cercato di capire il funzionamento della routine suggeritami da Alex, che risale al 2003, tempi remoti in cui i browsers erano più semplici (e anche diversi) di quelli odierni.
    Applicandomi nello studio, cercando altri codici nel WEB, sono poi giunto ad un primo risultato, che è nel codice qui riportato:
    codice:
    Option Explicit
    
    Global r As Long
    '-- dichiarazione delle API ---                    
    Private Declare Function EnumWindows Lib "user32" _
       (ByVal lpEnumFunc As Long, _
        ByVal lParam As Long) As Long
    
    Private Declare Function GetWindowText Lib "user32" _
        Alias "GetWindowTextA" _
       (ByVal hwnd As Long, _
        ByVal lpString As String, _
        ByVal cch As Long) As Long
    
    Private Declare Function GetParent Lib "user32" ( _
         ByVal hwnd As Long) As Long
    
    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" ( _
         ByVal hwnd As Long) As Long
    
    Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
         ByVal hwnd As Long, _
         ByVal lpClassName As String, _
         ByVal nMaxCount As Long) As Long
    
    'funzione di analisie prelievo nelle windows aperte
    Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long ' {
    
        Dim WindowText  As String
        Dim windowClass As String * 256
        Dim retVal      As Long
        Dim l           As Long
    
        Cells(r, 1) = hwnd
        Cells(r, 2) = GetParent(hwnd)
        
        WindowText = Space(GetWindowTextLength(hwnd) + 1)
        retVal = GetWindowText(hwnd, WindowText, Len(WindowText))
        WindowText = Left$(WindowText, retVal)
        Cells(r, 3) = WindowText
    
        retVal = GetClassName(hwnd, windowClass, 255)
        windowClass = Left$(windowClass, retVal)
        Cells(r, 4) = windowClass
    
        r = r + 1
        
      '
      ' Compilare TRUE nella variabile di ritorno
      ' permette di continuare a enumerare le Windows:
      '
        EnumWindowsProc = True
    
    End Function
    
    Sub main()
    'Routine di estrazione
        r = 1
        Call EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
    End Sub
    In questo modo, nel foglio di Excel si compilano i vari ID, il titolo della windowds e la classe della windows per tutte le finestre attive, che sono tante e di vario tipo.
    Analizzando i risultati, si scopre che le finestre elencate sono effettivamente tutte quelle aperte, ma non tutti i titoli sono accessibili.
    Per esempio, avendo 3 Tabs aperte in Firefox, queste si riconoscono per la classe MozillaWindowClass, ma solo di quella che ha lo stato attivo nel browser viene riportato il titolo. E così per gli altri browsers, tranne che per IE (classe TabThumbnailWindow). E, in ogni modo, non c'è traccia degli URLs ricercati. Studiando, ho visto che tutte le WEB API utilizzate nel mio codice (e pure in quello precedente), agiscono sulla Barra del titolo, e in nessun caso nella barra degli indirizzi. Ho provato anche a cercare nei Children, ma non sono riuscito a cavare un ragno dal buco. Lascio a chi è più esperto di me, se vuole, l'ultima parola.

    La mia soluzione, invece, prende un'altra strada
    . L'altro posto dove individuare gli URLs di un browser è la cronologia. Firefox, che è quello che mi interessa, in effetti salva tutto in un file libero ed apribile in SQL. Il file in questione si chiama places.sqlite, ed è posto nella cartella profile di Mozilla. Il file in oggetto ha una sua struttura, che è facilmente consultabile con «sqlite browser».

    Quindi, finalmente, sono arrivato al seguente codice:
    codice:
    Sub provaSQL()
    
    Dim conn As Object, rst As Object
    Dim strSQL As String
    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")
    
    conn.Open "DRIVER=SQLite3 ODBC  Driver;Database=C:\Users\[nome utente]\AppData\Roaming\Mozilla\Firefox\Profiles\h6mfz4zy.default\places.sqlite;"
    
    strSQL = "Select * From moz_places order by last_visit_date"
    
    rst.Open strSQL, conn, 1, 1
    
    Sheets(1).Range("A1").CopyFromRecordset rst
    rst.Close
    
    Set rst = Nothing: Set conn = Nothing
    end sub
    La personalizzazione da farsi è nel percorso, che è da individuare sul proprio computer, dipendentemente dal SO e dalle versioni di Firefox.
    Anche la Query può cambiare: nel mio caso la tabella dei dati è moz_places, ma in un altro computer era moz_origins. Bisogna controllare.
    Va da sé che è necessario installare il driver sqlite 3 perché un tempo era default in office ma adesso MS diffida di tutto quello che è open...
    Funziona, l'intera tabella del DB viene prelevata, quindi gli URLs divengono gestibili.
    La soluzione, però, ha 2 limiti:
    1. Non è possibile trovare le Tabs aperte, non c'è nessun attributo nella cronologia che lo indichi
    2. Com'è ovvio, funziona solo per Firefox

    Poi, vorrei poter chiudere le Tabs aperte, o cancellare la cronologia di Firefox, ma qui andiamo ancora in ambiti complessi ed inesplorati. Almeno per me.
    Se qualcuno vuole suggerire migliorie o altre strade, tutto sarà ben accetto.

  7. #7
    L'avatar di willy55
    willy55 non è in linea Scribacchino
    Post
    644

  8. #8
    BennyB non è in linea Scolaretto
    Post
    102

    Una soluzione (solo per Firefox)

    Grazie willy55 per i suggerimenti, ma non sono affatto abile a trattare VB.net.
    Ho trovato una soluzione partendo dal grabbing della Cronologia che ho esposto in precedenza. Essendo il mio problema quello di prelevare gli URLs delle Tabs attive in Mozilla (poi penserò a IE, ma è molto più semplice), e avendo a disposizione l'elenco cronologico senza riferimenti di attributo, ho pensato di agire in modo indiretto. L'idea è semplice, e per le mie necessità funzionale.
    All'apertura verifico se Mozilla è aperto e, nel caso, lo chiudo. Eseguo l'operazione intervenendo direttamente sulle finestre prelevando con le WEB API le classi delle finestre stesse: se contengono la stringa "mozilla", le chiudo.
    Ricordo che, almeno sul mio computer (ma ho pure verificato su una macchina diversa, più vecchia, con un SO un po' datato e una versione di Mozilla "arcaica"), le classi di Firefox intercettate sono MozillaWindowClass, MozillaDropShadowWindowClass e MozillaHiddenWindowClass. Con la routine che ho scritto, chiudo tutto, e alla fine Firefox termina chiudendo correttamente la sessione. Infatti, riaprendo, non ripresenta nulla della sessione precedente, e apre la pagina iniziale (che è settata sulla Home page di Google.it).
    Quindi, apro i vari siti che mi interessano tramite VBA, lavoro in Firefox manualmente individuando le pagine corrette che mi servono, poi (tramite un pulsante in Excel che attiva la procedura) eseguo la lettura della cronologia, e mi fermo alla home page di Google prima aperta.
    In questo modo, sono (indirettamente) sicuro di prendere con VBA le pagine aperte ed attive in precedenza.
    Questo è il codice per la chiusura di Mozilla.
    codice:
    Option Explicit
    
    Global r As Long
                        
    Private Declare Function EnumWindows Lib "user32" _
       (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
    
    Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
         ByVal hwnd As Long, _
         ByVal lpClassName As String, _
         ByVal nMaxCount As Long) As Long
    
    Private Const WM_CLOSE = &H10
    Private Const WM_QUIT = &H12
    
    Private Target As String
    Public TargetOpen As Boolean
    
    Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long ' {
    
        Dim WindowText  As String, sMess As String
        Dim windowClass As String * 256
        Dim retVal      As Long
        Dim l           As Long
    
        On Error GoTo errori
        retVal = GetClassName(hwnd, windowClass, 255)
        windowClass = Left$(windowClass, retVal)
        'Cells(r, 1) = windowClass
        If InStr(1, windowClass, "Mozilla") > 0 Then
            TargetOpen = True
            SendMessage hwnd, WM_CLOSE, 0, 0
        End If
        
        r = r + 1
      '
        EnumWindowsProc = True
    Exit Function
    errori:
    sMess = MsgBox("Errore n. " & Err.Number, " - " & Err.Description)
    Resume Next
    End Function
    
    Sub main()
    'chiude le singole finestre, e poi il programmma, cosicché riaprendo
    'il browser inizia una nuova sessione (CORRETTO!!!!)
        r = 1
        Call EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
    End Sub
    Non è il massimo, ma per quel che mi occorre è efficace.
    Sono graditi commenti e considerazioni.

+ Rispondi al Thread

Tag per questa discussione

Permessi di invio

  • Non puoi inserire discussioni
  • Non puoi inserire repliche
  • Non puoi inserire allegati
  • Non puoi modificare i tuoi messaggi