Détection disque dur USB Résolu

Question

Bonjour,

J'ai un script me permettant de retrouver le disque local ayant le plus d'espace mais les disques USB sont aussi dans cette liste, il y aurait-t-il une solution pour que mon script ne prenne pas en compte les disques locaux connecté en USB?

Merci d'avance, ci-dessous le script utilisé,


Dim oFSO 'FileSystemObject
Dim oDrv 'Disque lu
Dim FreeSpace 'Espace disque restant du disque lu
Dim GDiskSpace 'Greatest DiskSpace

Set oFSO = CreateObject("Scripting.FileSystemObject")

For Each oDrv In oFSO.Drives
  If oFSO.DriveExists(oDrv) AND oDrv.DriveType = "2" Then
    If oDrv.FreeSpace > FreeSpace Then
      FreeSpace = oDrv.FreeSpace
      GDiskSpace = oDrv.DriveLetter
    End If
  End If
Next

Session.Property("GDISKSPACE") = GDiskSpace + ":"

Set oFSO = Nothing
Set oDrv = Nothing

jimbilba · Accepted Answer

Salut,

je ne sais pas si ça va t'aider mais c'est juste une idée. Tu peux attribuer une lettre particulière à un disque externe. Tu n'auras qu'à exclure après les dites lettres attribuées.

@+

Utilisateur anonyme · Answer

Bonjour,

Tu peux détecter le type des lecteurs et en éviter de cette manière :
Dim drives() As IO.DriveInfo = IO.DriveInfo.GetDrives
For Each drv As IO.DriveInfo In drives
    If drv.IsReady Then
        If drv.DriveType <> IO.DriveType.Removable Then
            '...
        End If
    End If
Next

mmethivier · Answer

Bonjour,

Cette solution n'est pas possible car je ne connais pas à l'avance les lettres des disques des postes sur lesquels j'installe mon appli.

Merci.

mmethivier · Answer

Bonjour, 

Merci pour cet exemple de code, mais cela ne fonctionne pas non plus car le disque apparait comme fixe même s'il est connecté en USB.

Merci quand même.

cs_JMO · Answer

Bonjour le Forum,

Banana32 (bonjour) avait pourtant montré la voie à suivre.


Option Explicit

Dim MyArrayDrives, MyArraySpaces, strList

Set MyArrayDrives = CreateObject("System.Collections.ArrayList")
Set MyArraySpaces = CreateObject("System.Collections.ArrayList")

MsgBox CheckDrives(strList) 

Set MyArrayDrives = Nothing
Set MyArraySpaces = Nothing
WScript.Quit

Function CheckDrives(strList)
   Dim objFso, strDrive, strItem, strResult, i
   Set objFso = CreateObject("Scripting.FileSystemObject")
   
   For Each strDrive In objFso.Drives
      If strDrive.IsReady And strDrive.DriveType = 2 Then
         MyArrayDrives.Add "DriveLetter " & strDrive.DriveLetter & ":" &_
                           vbTab & "=> AvailableSpace: " &_
                           FormatNumber(strDrive.AvailableSpace/1024/1024, 0) & " Mo"
         MyArraySpaces.Add Space(1) & FormatNumber(strDrive.AvailableSpace/1024/1024, 0) & " Mo"
         
         strList = strList &vbLf&_
                   "DriveLetter " & strDrive.DriveLetter & ":" &vbTab&_
                   "=> AvailableSpace: " &_
                   FormatNumber(strDrive.AvailableSpace/1024/1024, 0) & " Mo"
      End If
   Next
   MyArraySpaces.Sort
   MyArraySpaces.Reverse
   
   For Each strItem in MyArrayDrives
       If InStr(1, strItem, MyArraySpaces(0)) Then strResult = strItem : Exit For
   Next
   
   CheckDrives = strResult &vbCrLf&vbCrLf&vbCrLf& "List Drives" &vbLf& strList
   
   Set objFso = Nothing
End Function 







jean-marc

mmethivier · Answer

Bonjour JMO,

Merci pour ta réponse mais ça fonctionne pas, car si tu branches un disque dûr USB sur ton PC tu verras qu'il apparaitra en DriveType 2.

Cdlt,

cs_JMO · Answer

Effectivement, je viens de tester avec une clé USB et un disque USB. 
Même avec WMI, le disque USB est considéré comme hard disk.

Prospection en cours !!!

Il faut contrôler le FileSystem.


Option Explicit

Dim MyArrayDrives, MyArraySpaces, strList

Set MyArrayDrives = CreateObject("System.Collections.ArrayList")
Set MyArraySpaces = CreateObject("System.Collections.ArrayList")

MsgBox CheckDrives(strList) 

Set MyArrayDrives = Nothing
Set MyArraySpaces = Nothing
WScript.Quit

Function CheckDrives(strList)
   Dim objFso
   Dim strDrive, strDriveLetter, strDriveSpace, strItem, strResult
   Set objFso = CreateObject("Scripting.FileSystemObject")
   
   For Each strDrive In objFso.Drives
      If strDrive.IsReady And strDrive.DriveType = 2 Then 
         If strDrive.FileSystem = "NTFS" Then
            strDriveLetter = "DriveLetter " & strDrive.DriveLetter & ":"
            strDriveSpace = "=> AvailableSpace: " &_
                            FormatNumber(strDrive.AvailableSpace/1024/1024, 0) & " Mo"
           
            MyArrayDrives.Add strDriveLetter & vbTab & strDriveSpace
            MyArraySpaces.Add strDriveSpace
         
            strList = strList &vbLf&_
                      strDriveLetter &vbTab& strDriveSpace
         End If
      End If 
   Next
   MyArraySpaces.Sort
   MyArraySpaces.Reverse
   
   For Each strItem in MyArrayDrives
       If InStr(strItem, MyArraySpaces(0)) Then strResult = strItem : Exit For
   Next
   
   CheckDrives = strResult &vbCrLf&vbCrLf&vbCrLf& "List Drives" &vbLf& strList
   
   Set objFso = Nothing
End Function 



jean-marc

Utilisateur anonyme · Answer

Bonjour,

Ce programme, pris ici-même, utilise WMI pour trouver les informations sur le PC. Il suffit juste de regarder le paramètre Interface pour savoir si c'est un disque USB.

cs_Le Pivert · Answer

Bonjour,
je crois avoir trouvé un code en VBS qui détecte les clés et les disques durs connectés et donne leur emplacement:

 'Find USB Stick
Set dicUSBDrives = GetUSBDrives
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------
If dicUSBDrives.Count = 0 Then
MsgBox "Pas trouvé de clé USB!",48,"Chercher clé USB connectée"
Else
MsgBox "Trouvé une clé USB:",64,"Chercher clé USB connectée"
For Each strUSBDrive In dicUSBDrives
MsgBox "Emplacement: "  & strUSBDrive & "",64,"Chercher clé USB connectée"
Target = strUSBDrive & "\MyDocuments"
Next
End If
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function GetUSBDrives
' Populate a dictionary object with USB drive letters
Set dicUSBList = CreateObject("Scripting.Dictionary")
   dicUSBList.CompareMode = vbTextCompare
   strComputer = "."   
   Set objWMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")
   Set colDiskDrives = objWMI.ExecQuery ("Select DeviceID from Win32_DiskDrive WHERE InterfaceType='USB'")
           For Each objDiskDrive In colDiskDrives
                   strDeviceID = objDiskDrive.DeviceID
                   strEscapedDeviceID = Replace(strDeviceID, "", "\")
               Set colDiskPartitions = objWMI.ExecQuery _
                   ("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" &  strEscapedDeviceID & """} WHERE " _
                   &  "AssocClass = Win32_DiskDriveToDiskPartition")
           For Each objDiskPartition In colDiskPartitions
               Set colLogicalDisks = objWMI.ExecQuery ("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & _
                   objDiskPartition.DeviceID & """} WHERE " & _
                   "AssocClass = Win32_LogicalDiskToPartition")
           For Each objLogicalDisk In colLogicalDisks
               dicUSBList.Add objLogicalDisk.DeviceID, ""
           Next
       Next
Next
Set GetUSBDrives = dicUSBList
End Function

J'espère que ça fera ton affaire
@+Le Pivert

Détection disque dur USB

9 réponses

Votre réponse

Discussions similaires