Lancer explorer sur le nom de volume

Télécharger le projet
Commenter

Description

'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"
'

Source / Exemple : 


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

Conclusion :


A l'écoute de vos remarques, critiques et bonnes idées
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.