Activie - logger les sites visités

Télécharger le projet
Commenter

Description

[vb 5.0]
Programme qui permet :
- Soit avec un timer de regarder si la fenêtre active est une fenêtre IE
- Soit de marquer toutes les fenêtres IE présentes (même sans le focus)

Entre temps le résultat sera marqué avec le nom de la fenêtre et l'URL

!!! N'oubliez pas !!!
Fonctionne sans module mais nécéssite l'ajout dans les références a :
MICROSOFT INTERNET CONTROL

Source / Exemple : 


Il vous faut 1 form avec 3 boutons, 1 timer (Nom = Tmr) et une ListBox
Le 1er bouton déclenche le timer pour éxécuter ce qui est dans Sub, le bouton 2 arrête cette Sub, le 3 permet de déclencher la Sub qu'il contient

Option Explicit
'Fonction qui renvois le handle de la fenêtre actuellement
'ouverte, ou sur laquelle on a le focus, ou l'on travaille
Private Declare Function GetForegroundWindow Lib "user32" () As Long

'Variable qui récupère le handle précédent (voir plus bas
'(pour comprendre)
Dim oldhwnd As Long

--------------------------------------------------------------------------------

Private Sub Tmr_Timer()
'2 variable ici. L'une qui correspond à ce qu'on pourrait
'définir comme une fenêtre de Windows incarnant n'importe
'quoi : jeux, explorateur...
'Et une autre variable correspondant à une fenêtre Internet
'Explorer.
Dim fenetre As New SHDocVw.ShellWindows, fenetreIE As SHDocVw.InternetExplorer
'2 autres variables : l'une pour récuperer le handle de
'la fenêtre active et l 'autre pour récuperer les infos
'd'une fenêtre Internet Explorer
Dim hwnd, URLstring As String

    'On recupere le handle de la fenêtre active
    hwnd = GetForegroundWindow
        
        'Routine pour empecher de remettre toutes les
        'secondes la même fenêtre dans la liste
        If hwnd <> oldhwnd Then
        'Si cette fenêtre est différente de la précédente
        'alors la précédente devient la présente pour
        'devenir précédente au prochain appel :p
        'Dur de bien faire comprendre !
        oldhwnd = hwnd
        
            'Avec de bonne variable et un soupçon de logique
            'on en déduit que :
            'Pour chaque fenêtre d'Internet explorer
            'trouvée parmis les fenêtres lancées, alors :
            For Each fenetreIE In fenetre
            
                'Vérifie si un fenêtre Internet explorer
                'qui est trouvée serait la fenêtre active
                'Si non, alors on enregistre rien
                If fenetreIE.hwnd = hwnd Then
                'On enregistre les infos de la fenêtre IE:
                'Nom de la fenêtre par lavariable.LocationName
                'et son URL par lavariable.LocationURL
                URLstring = "[" & DateTime.Time & "]" & " Nom: " & fenetreIE.LocationName & " URL: " & fenetreIE.LocationURL
                List1.AddItem URLstring
                End If
                
            Next
            
        End If
End Sub

-----------------------------------------------------------------------------

Private Sub Command1_Click()
    'Efface la liste
    List1.Clear
    'On démarre le timer
    Tmr.Enabled = True
End Sub

-----------------------------------------------------------------------------

Private Sub Command3_Click()
    'On eteint le timer
    Tmr.Enabled = False
End Sub

-----------------------------------------------------------------------------

Private Sub Command2_Click()
    'Si le timer est déja allumé, j'ai pas testé mais ca
    'peut merder, donc on vérifie
    If Tmr.Enabled = True Then
    MsgBox "Il faut d'abord arréter la 1ere détéction", vbInformation + vbOKOnly, "Erreur"
    End
    
    Else
    
    'Même variable qu'au dessus
    Dim fenetre As New SHDocVw.ShellWindows, fenetreIE As SHDocVw.InternetExplorer
    Dim URLstring As String

    List1.Clear
    'Pour chaque fenêtre d'Internet explorer
    'trouvée parmis les fenêtres lancées, alors :
    For Each fenetreIE In fenetre
    URLstring = "[" & DateTime.Time & "]" & " Nom: " & fenetreIE.LocationName & " URL: " & fenetreIE.LocationURL
    List1.AddItem URLstring
    Next
    
    End If
End Sub

Conclusion :


Hope This Will Help Some of You :p

Si vous avez une question, une suggestion, vous avez trouvé un bug : commentez

http://www.kephren.fr.fm/
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Kephren)