LANCER EXPLORER SUR LE NOM DE VOLUME

Option Explicit

'2008-11-25
'Version 0.3.1
'        Suppresion de la Form ==> Module Main
'
'        Parm et "PARM" accepté
'
'       Ajout fichier ressource pour l'icone

' Cet outil a pour but d'implementer l'ouverture de 'Explorer.exe' via son nom de volume.
'
' En effet de nombreuses unités mobiles sont maintenant utilisées et d'une fois sur
' l'autre le nom de l'unité qui les accueille change, d'ou cet utilitaire.
'
'   Input: Nom du volume, attention sensible à la case
'   Ouput: Lancement d'Explorer.exe sur l'unité accueillant ce volume.

'Prereq:    runtime VB6

'Mise en oeuvre
'   Installer le programme ou vous avez l'habitude d'installer vos applications.
'             attention il faut les runtime VB6

'   Créer un bouton sur le bureau avec comme paramètre le nom du volume à explorer
'               Ex: "J:\User Pgm\Mes Programmes\ExplorerVolume.exe" E-PRODUITS
'                   "J:\User Pgm\Mes Programmes\ExplorerVolume.exe" "Mes Images"
'

'Declarations
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" ( _
        ByVal lpRootPathName As String, _
        ByVal lpVolumeNameBuffer As String, _
        ByVal nVolumeNameSize As Long, _
        lpVolumeSerialNumber As Long, _
        lpMaximumComponentLength As Long, _
        lpFileSystemFlags As Long, _
        ByVal lpFileSystemNameBuffer As String, _
        ByVal nFileSystemNameSize As Long) As Long

Private Const DRIVE_CDROM = 5
Private Const DRIVE_FIXED = 3
Private Const DRIVE_RAMDISK = 6
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_REMOVABLE = 2

'=========================================
'   Create Process declaration
'=========================================

Dim TxtStart As String

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Declare Function CreateProcess Lib "kernel32" Alias _
        "CreateProcessA" (ByVal lpApplicationName As String, _
        ByVal lpCommandLine As String, lpProcessAttributes As Any, _
        lpThreadAttributes As Any, ByVal bInheritHandles As Long, _
        ByVal dwCreationFlags As Any, lpEnvironment As Any, _
        ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, _
        lpProcessInformation As PROCESS_INFORMATION) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&

Private pInfo As PROCESS_INFORMATION
Private sInfo As STARTUPINFO
Public sNull As String

Sub Main()
    Dim strDrive As String
    Dim intCnt As Integer
    
    Dim NomVolume As String
    Dim ResStr As String
    Dim dum As Long
    Dim RetVal As Long
    Dim VolumeToDisplay As String
   
    'Suppression des quotes si le parametre est entre quotes
    VolumeToDisplay = Replace(Command(), """", "", 1)

    If VolumeToDisplay = "" Then MsgBox "Pas de parametre en entrée":   End
    
    For intCnt = 67 To 86   ' Scan des unité à partir de C: juqu'a Z:
        strDrive = Chr(intCnt) & ":\"
        Select Case GetDriveType(strDrive)
            Case DRIVE_REMOVABLE, DRIVE_FIXED, DRIVE_REMOTE, DRIVE_CDROM, DRIVE_RAMDISK
                '*** Récuperation du nom de volume du disque
                NomVolume = Space$(15)  'Attribue l'espace nécessaire
                ResStr = Space$(32)     'aux variables de type chaine de taille fixe
                RetVal = GetVolumeInformation(strDrive, NomVolume, Len(NomVolume), _
                    dum, dum, dum, ResStr, Len(ResStr))

                If Len(Trim(NomVolume)) > 0 Then
                    NomVolume = Left(NomVolume, Len(Trim(NomVolume)) - 1) ' Suppress right character: end of string
                    If NomVolume = VolumeToDisplay Then
                        TxtStart = "Explorer.exe " & strDrive
                        'Lancement de l'Explorateur.
                        sInfo.cb = Len(sInfo)
                        RetVal = CreateProcess(sNull, TxtStart, ByVal 0&, ByVal 0&, 1&, _
                            NORMAL_PRIORITY_CLASS, ByVal 0&, sNull, sInfo, pInfo)
                        If RetVal = 0 Then MsgBox "Unable to start process " & TxtStart
                    End ' Exit pgm
                    End If
                End If
        End Select
        
    Next intCnt
    MsgBox "Le volume " & VolumeToDisplay & " n'a pas été identifié comme présent." & vbCrLf _
            & vbCrLf & "Attention le nom du disque est sensible à la case."
End Sub

Télécharger le zip

23 novembre 2008 14:36:56 :

.

24 novembre 2008 11:33:02 :

-Suppression de la Form passage en module Main - Traitemant du parm format Parm et "Parm" acceptés

24 novembre 2008 11:35:31 :

- Remplacement de la Form par un module Main - Parm et "Parm" format acceptable

24 novembre 2008 11:38:08 :

-remplacement de la Form par un module Main - Format du paramètre PARM et "PARM acceptable

24 novembre 2008 23:07:03 :

Réécriture code Fichier ressource pour l'icone

25 novembre 2008 09:58:55 :

Fignolage commentaires et code