Comment énumérer les dossiers ouverts dans l'explorateur... avec des fonctions non documentées

Télécharger le projet
Commenter

Description

Ce code permet d'énumérer les dossiers ouverts dans les fenêtres de l'explorateur et d'internet explorer gràce à des fonctions et des messages non documentées.

Ce code ne renvoie pas le titre des fenetres mais le chemin du dossier affiché ou l'URL

On peut s'en servir pour fermer des popups par leurs URL et non par le titre affiché dans la barre de titre.

On peut aussi changer le répertoire affichée d'une fenêtre de l'Explorer et IE.

Source / Exemple : 


Option Explicit

Public Type SHITEMID
    cb As Integer
    abID As Byte
End Type

Public Type Infos
    Path As String
    hwnd As Long
End Type
'version de windows
Public Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128      '  Maintenance string for PSS usage
End Type
'obtient le version de l'OS
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
'permet de fermer une fenetre
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

'renvoie le numéro de process correspondant à la fenetre spécifiée
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
'renvoie le numéro de process correspondant à la fenetre appelante
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
'envoie un message à une fenetre
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

Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Const TRANSLATEURL_FL_USE_DEFAULT_PROTOCOL = &H2
Private Const S_OK As Long = 0&
Private Declare Function TranslateURLA Lib "url.dll" (ByVal pcszURL As String, ByVal dwInFlags As Long, ppszTranslatedURL As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As String, lpString2 As Any) As String

' message pouvant etre envoyés au fenetres du shell
Private Const WM_USER = &H400 'base
Private Const CWM_GETPATH = WM_USER + 12 'renvoie le chemin du dossier affiché
Private Const CWM_SETPATH As Long = WM_USER + 16 'ne fonctionne pas sous XP apparement

'fonctions non documentées de Shell32.dll
'alloue de la mémoire dans la zone mémoire du processus specifié
Private Declare Function SHAllocShared Lib "Shell32" Alias "#520" (ByVal pv As Long, ByVal cb As Long, ByVal pid As Long) As Long
'libère la mémoire allouée avec la fonction précédente
Private Declare Function SHFreeShared Lib "Shell32" Alias "#523" (ByVal hMem As Long, ByVal pid As Long) As Long
'permet de lire la mémoire allouée par SHAllocShared
Private Declare Function SHLockShared Lib "Shell32" Alias "#521" (ByVal hMem As Long, ByVal pid As Long) As Long
'libère le pointeur ouvert avec la focntion précédente
Private Declare Function SHUnlockShared Lib "Shell32" Alias "#522" (ByVal pv As Long) As Long
'copie un idl
Private Declare Function ILClone Lib "Shell32" Alias "#18" (ByVal pidl As Long) As Long
'libère la mémoire allouée à un idl
Private Declare Sub ILGlobalFree Lib "Shell32" Alias "#156" (ByVal pidl As Long)
'renvoie le chemin associé à l'idl spécifié
Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
'renvoie la taille de l'idl
Private Declare Function ILGetSize Lib "Shell32" Alias "#152" (ByVal pidl As Long) As Long
'copie un idl
Private Declare Function ILGlobalClone Lib "Shell32" Alias "#20" (ByVal pidl As Long) As Long
'crée un idl correspondant au chemin spécifié
Private Declare Function SHILCreateFromPath Lib "Shell32" Alias "#28" (ByVal lpszPath As String, ByRef ppidl As Long, ByRef pdwAttributes As Long) As Long
'crée un idl correspondant au chemin spécifié
Private Declare Function ILCreateFromPath Lib "Shell32" Alias "#157" (ByVal lpszPath As Long) As Long
'renvoie le dernier ID du l'IDList
Private Declare Function ILFindLastID Lib "Shell32" (ByVal pidl As Long) As Long
'libère un PIDL
Private Declare Function ILFree Lib "Shell32" Alias "#195" (ByVal pidlFree As Long) As Long

'crée un idl correspondant au chemin spécifié
Private Declare Function SHSimpleIDListFromPath Lib "Shell32" Alias "#162" (ByVal lpszPath As String) As Long
Public Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer

'fonctions documentées
'copie la mémoire
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'recherche des fenetre
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwnd1 As Long, ByVal hwnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

'enumère les chemins des dossiers ouverts
Public Function EnumOpenedShellFolders() As Infos()
Dim hwnd1 As Long 'fenetre précédente
Dim hwnd2 As Long 'fenetre suivante
Dim t() As Infos 'tableau temporaire
Dim ret As Long 'valeur de retour
Dim X As Long 'compteur

'on initialise le tableau
X = 0
ReDim t(X)

'on recherche toutes les fenetres du Shell style "Standard"
hwnd1 = FindWindow("CabinetWClass", ByVal vbNullString)
's'il y a des fenetre de cette classe
Do While hwnd1
    'on enregistre dans le tableau
    t(X).Path = ShellGetPath(hwnd1, True)
    t(X).hwnd = hwnd1
    'on ajoute une entrée
    X = X + 1
    ReDim Preserve t(X)
    'on intervertit les handles pour toujours avoir le handle à sauvegarder
    hwnd2 = hwnd1
    'on recherche une autre fenetre de cette classe
    hwnd1 = FindWindowEx(ByVal 0&, ByVal hwnd2, "CabinetWClass", ByVal vbNullString)
Loop

'on recherche toutes les fenetres du Shell style "Tree"
hwnd1 = FindWindow("ExploreWClass", ByVal vbNullString)
's'il y a des fenetre de cette classe
Do While hwnd1
    'on enregistre dans le tableau
    t(X).Path = ShellGetPath(hwnd1, True)
    t(X).hwnd = hwnd1
    'on ajoute une entrée
    X = X + 1
    ReDim Preserve t(X)
    'on intervertit les handles pour toujours avoir le handle à sauvegarder
    hwnd2 = hwnd1
    'on recherche une autre fenetre de cette classe
    hwnd1 = FindWindowEx(ByVal 0&, ByVal hwnd2, "ExploreWClass", ByVal vbNullString)
Loop

's'il y a des fenetres dans le tableau
If UBound(t) > 0 Then
    'le tableau contient une entrée de trop
    ReDim Preserve t(UBound(t) - 1)
    'renvoie le résultat
    EnumOpenedShellFolders = t
End If

'libère la mémoire
Erase t
End Function

'enumère les url des fenetres IE ouverte
Public Function EnumOpenedIEWindows() As Infos()
Dim hwnd1 As Long 'fenetre précédente
Dim hwnd2 As Long 'fenetre suivante
Dim t() As Infos 'tableau temporaire
Dim ret As Long 'valeur de retour
Dim X As Long 'compteur

'on initialise le tableau
X = 0
ReDim t(X)

'on recherche toutes les fenetres du Shell style "Standard"
hwnd1 = FindWindow("IEFrame", ByVal vbNullString)
's'il y a des fenetre de cette classe
Do While hwnd1
    'on enregistre dans le tableau
    t(X).Path = ShellGetPath(hwnd1, False)
    t(X).hwnd = hwnd1
    'on ajoute une entrée
    X = X + 1
    ReDim Preserve t(X)
    'on intervertit les handles pour toujours avoir le handle à sauvegarder
    hwnd2 = hwnd1
    'on recherche une autre fenetre de cette classe
    hwnd1 = FindWindowEx(ByVal 0&, ByVal hwnd2, "IEFrame", ByVal vbNullString)
Loop

's'il y a des fenetres dans le tableau
If UBound(t) > 0 Then
    'le tableau contient une entrée de trop
    ReDim Preserve t(UBound(t) - 1)
    'renvoie le résultat
    EnumOpenedIEWindows = t
End If

'libère la mémoire
Erase t
End Function

'renvoie le chemin du dossier ouvert dans la fenetre hwnd du shell
Public Function ShellGetPath(hwnd As Long, Optional IsExplorer As Boolean = False) As String
     Dim result As Long 'valeur de retour
     
'     If (IsWindowsNT) Then
'     'si on est sous NT
       Dim pid As Long 'ID du processus
       'on trouve le process ID
       pid = GetCurrentProcessId
       Dim hMem As Long 'handle d'une zone mémoire
       'on demande au shell de renvoyer le chemein du dossier de la fenetre hwnd
       hMem = SendMessage(hwnd, CWM_GETPATH, ByVal pid, ByVal 0&)
       If (hMem) Then
       'si la fenetre contient un dossier
         Dim pv As Long 'pointeur vers le IDL local
         'on lit la mémoir
         pv = SHLockShared(hMem, pid)
         If (pv) Then
            'on copie l'idl
           result = ILClone(pv)
           SHUnlockShared pv
         End If
         'on libère la mémoire
         SHFreeShared hMem, pid
       End If
'     Else
'     'si c sous 9x
'       Dim pidl As Long
'       'on récupère directement le pidl
'       pidl = SendMessage(hwnd, CWM_GETPATH, ByVal GetCurrentProcessId, ByVal 0&)
'       If (pidl) Then
'       'on le copie
'         result = ILClone(pidl)
'         'on libère la source
'         ILGlobalFree pidl
'       End If
'     End If
     'on prépare le buffer
     ShellGetPath = Space(255)
     'on récupère le chemin du pidl
     SHGetPathFromIDList result, ShellGetPath
     'on retire les espaces inutiles
     ShellGetPath = Mid$(ShellGetPath, 1, InStr(ShellGetPath, vbNullChar) - 1)
     
     'si buff ne contient rien : c'est surement une URL
     If (ShellGetPath = "") And (IsExplorer = True) Then
        ShellGetPath = Space(255)
        GetWindowText hwnd, ShellGetPath, 255
        ShellGetPath = Mid$(ShellGetPath, 1, InStr(ShellGetPath, vbNullChar) - 1)
     ElseIf (ShellGetPath = "") Then
         Dim l As Long
         'on récupère la taille du pidl
         l = ILGetSize(result)
        
         If l = 0 Then Exit Function
         
         Dim bBuff() As Byte 'buffer pour l'IDL
         Dim IDLen As Integer 'taille de l'ID
         Dim lastptr As Long 'pointeur vers le dernier ID de la liste
        
            'on alloue l'espace nécessaire
         ReDim bBuff(l - 1)
        
        'on copie l'IDL dans le buffer
         CopyMemory ByVal VarPtr(bBuff(0)), ByVal result, l
        
        If (IsWindowsNT) Then
            'l'URL se trouve (généralement) dans le dernier ID de l'IDL
            lastptr = ILFindLastID(VarPtr(bBuff(0)))
        Else
            CopyMemory lastptr, bBuff(0), 2&
            lastptr = lastptr + VarPtr(bBuff(0))
        End If
        
        'on copie la taille du nom de l'URL
        CopyMemory ByVal VarPtr(IDLen), ByVal lastptr, 2&
        
        'on alloue le buffer pour le nom de l'URL
        ShellGetPath = Space(IDLen - 1 - 8)
        
        'on copie le nom de l'URL dans le buffer
        'à lastptr, on trouve :
        ' - un Integer pour la taille de ce qui suit
        ' - un Integer inconnu &H8061
        ' - un Long nul
        ' - l'URL en Unicode
        CopyMemory ByVal StrPtr(ShellGetPath), ByVal lastptr + 8, IDLen - 8
        
        'on retire les espaces inutiles
        ShellGetPath = Mid$(ShellGetPath, 1, InStr(ShellGetPath, vbNullChar) - 1)
     End If
     
     If result Then ILFree result
End Function

'renvoie True si NT/2000/XP et antérieur
Public Function IsWindowsNT() As Boolean
Dim V As OSVERSIONINFO

V.dwOSVersionInfoSize = Len(V)
GetVersionEx V

If V.dwPlatformId = 2 Then IsWindowsNT = True Else IsWindowsNT = False
End Function

Public Function TranslateURL(URL As String) As String
Dim lngTranslatedURL      As Long
Dim strTranslatedURL      As String * 255
Dim lngWin32apiResultCode As Long

lngWin32apiResultCode = TranslateURLA(URL, TRANSLATEURL_FL_USE_DEFAULT_PROTOCOL, lngTranslatedURL)
If lngWin32apiResultCode = S_OK Then
    strTranslatedURL = lstrcpy(strTranslatedURL, ByVal lngTranslatedURL)
    TranslateURL = Left(strTranslatedURL, InStr(strTranslatedURL, vbNullChar) - 1)
End If
End Function

Conclusion :


N'hésitez pas à commenter et à notez...

Le code liste les fenetres de style "Explorateur" (arbre) et pas seulement les fenetres "Dossier"

La dll BrowserInject permet d'utiliser les interfaces IShellBrowser et IHTMLDocument2 (pour changer de dossier) exposés par Explorer et IE dans l'espace d'adresse d'Explorer.exe. Cette dll utilise une méthode de hooking pour s'injecter dans Explorer.exe.

Ce code a été testé sous 98/2000/XP...
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 (ShareVB)