Soucis avec l'USB

Bonjour, depuis plusieurs heure je cherche une solution a mon probleme et sur le net je ne trouve rien (ou j'ai mal cherché)

Depuis peu, je suis sur un projet en rapport avec l'ultilisation de l'USB.

Aucuns soucis mise à part que je n'arrive pas a ouvrir un dossier d'une clé dans l'explorateur windows que ce soit sur n'importe quel ordinateur (donc changement de Lettre de lecteur de l'USB et du disque dure de l'hote)

C:\windows\explorer.exe peut devenir E:\windows\explorer.exe
quand à L'usb peut etre G:\dossier\ ou f:\dossier... enfin vous voyez ?

J'ai essayé avec le composant "sysinfo" mais pas réussit...
Utilisation de shell avec app.path idem

Si quelqun d'entre vous pourrai m'eclaircir ca serai vraiment sympa.

(-:fr3nz:-)

WMI doit pouvoir t'aider

Renfield
Admin CodeS-SourceS- MVP Visual Basic

Bonjour Frenz,

Il va te falloir être très précis :

Plusieurs "clés" USB peuvent être présentes au même moment sur un PC.

A quoi reconnais-tu la tienne, donc ?
Ta réponse précise emportera la mienne, également alors précise... sinon : impossible de voir où tu veux aller ainsi...

Pour etre plus precis je peut dire que la clé USB ciblé contient un certain fichier (le fichier du programme) a la racine de celle ci.

comme par exemple a la racine :
\USBme.exe

Donc le lecteur ciblé contient USBme.exe, le programme doit trouver la clé contenant "USBme" pas bète merci. Mais je ne sais pas comment je pourrait mis prendre

(-:fr3nz:-)

Mais ca peut aussi etre par rapport au nom de volume de la clé USB ? ca serait pe etre plus simple

(-:fr3nz:-)

Moi, je bveux bien, Frenz, mais j'ai des principes bien ancrés, parmi lesquels ne jamais conduire l'autre sur un chemin s'il en ignore tout.

Je ne t'y conduis donc que si je suis sur que rien ne t'échappe :
Philosophie :

1) on regarde tous les lecteurs disponibles
2) pour chaque lecteur, on regarde son type
3) si le type correpond, on l'examine de plus près et on décide en connaissance de cause ...

Etape 1, donc : recensement des lecteurs présents :
Sur une Form un bouton de commande command1

Code

Const MAX_PATH = 260
Private Type MSGBOXPARAMS
    cbSize As Long
    hwndOwner As Long
    hInstance As Long
    lpszText As String
    lpszCaption As String
    dwStyle As Long
    lpszIcon As String
    dwContextHelpId As Long
    lpfnMsgBoxCallback As Long
    dwLanguageId As Long
End Type
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long

Private Sub Command1_Click()
   Dim MBP As MSGBOXPARAMS, LDs As Long, Cnt As Long, sDrives As String
    disques = GetLogicalDrives
    For Cnt = 0 To 25
        If (disques And 2 ^ Cnt) <> 0 Then
          MsgBox Chr$(65 + Cnt)
        End If
    Next Cnt
End Sub

Vois ce que celà fait et analyse.
La suite viendra ensuite, en ne modifiant que command1, pas à pas...
Tu dis....

Interessant mais j'avoue que là ce n'est pas le code mais toi qui me fascine car j'aime beaucoup ta façon de penser.

Bref.... Je regarde le code et te repond mais sache que je ne met rien dans mes programmes que je ne connaisse pas.

Donc je regarde

(-:fr3nz:-)

Pour l'instant ca va, l'analyse est ok mais je peut bien lui faire analyser le nom du volume à cette étape non ?

(-:fr3nz:-)

Non, pas encore v(étape par étape)

Etape 2 :

voilà le code (à lancer, regarder attentivement les messages reçus, un par un... tu vas voir les choses commencer à prendre raison...) :

Private Type MSGBOXPARAMS
    cbSize As Long
    hwndOwner As Long
    hInstance As Long
    lpszText As String
    lpszCaption As String
    dwStyle As Long
    lpszIcon As String
    dwContextHelpId As Long
    lpfnMsgBoxCallback As Long
    dwLanguageId As Long
End Type
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
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 typelecteur As String
Private Sub Command1_Click()
   Dim LDs As Long, Cnt As Long, disques As String
    disques = GetLogicalDrives
    For Cnt = 0 To 30
        If (disques And 2 ^ Cnt) <> 0 Then
          titi = Chr$(65 + Cnt)
          infoslecteur Trim(titi) & ":\", toto, nmserie, nomvolume
          If toto = "INSERABLE" And titi <> "A" Then
            toto = toto & vbCrLf & "il nous intéresse donc" & vbCrLf & "car peut-être notre clé USB"
          End If
          MsgBox titi & " est un lecteur " & toto
        End If
    Next Cnt
End Sub

Private Sub infoslecteur(lecteur, typelecteur, nmserie, nomvolume)
  Dim numserie As Long, Serie As String
  Dim retVal As Long
  Dim DriveType As String
  retVal = GetDriveType(lecteur)
  Select Case retVal
    Case 0
        typelecteur = "INDETERMINE"
    Case 1
        typelecteur = "NO ROOT"
    Case 2
        typelecteur = "INSERABLE"
    Case 3
        typelecteur = "DISQUE DUR"
    Case 4
        typelecteur = "DISTANT"
    Case 5
        typelecteur = "CD ROM"
    Case 6
        DriveType = "RAMDISK"
  End Select
  nomvolume = Space$(15)
  ResStr = Space$(32)
  retVal = GetVolumeInformation(lecteur, nomvolume, Len(nomvolume), _
                        numserie, dum, dum, ResStr, Len(ResStr))
  Serie = Right(String(8, "0") + Hex$(numserie), 8)
  nmserie = Left(Serie, 4) + "-" + Right$(Serie, 4)
  numvolume = Trim(nomvolume)
End Sub

 

Non, pas encore v(étape par étape)

Etape 2 :

voilà le code (à lancer, regarder attentivement les messages reçus, un par un... tu vas voir les choses commencer à prendre raison...) :

Private Type MSGBOXPARAMS
    cbSize As Long
    hwndOwner As Long
    hInstance As Long
    lpszText As String
    lpszCaption As String
    dwStyle As Long
    lpszIcon As String
    dwContextHelpId As Long
    lpfnMsgBoxCallback As Long
    dwLanguageId As Long
End Type
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
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 typelecteur As String
Private Sub Command1_Click()
   Dim LDs As Long, Cnt As Long, disques As String
    disques = GetLogicalDrives
    For Cnt = 0 To 30
        If (disques And 2 ^ Cnt) <> 0 Then
          titi = Chr$(65 + Cnt)
          infoslecteur Trim(titi) & ":\", toto, nmserie, nomvolume
          If toto = "INSERABLE" And titi <> "A" Then
            toto = toto & vbCrLf & "il nous intéresse donc" & vbCrLf & "car peut-être notre clé USB"
          End If
          MsgBox titi & " est un lecteur " & toto
        End If
    Next Cnt
End Sub

Private Sub infoslecteur(lecteur, typelecteur, nmserie, nomvolume)
  Dim numserie As Long, Serie As String
  Dim retVal As Long
  Dim DriveType As String
  retVal = GetDriveType(lecteur)
  Select Case retVal
    Case 0
        typelecteur = "INDETERMINE"
    Case 1
        typelecteur = "NO ROOT"
    Case 2
        typelecteur = "INSERABLE"
    Case 3
        typelecteur = "DISQUE DUR"
    Case 4
        typelecteur = "DISTANT"
    Case 5
        typelecteur = "CD ROM"
    Case 6
        DriveType = "RAMDISK"
  End Select
  nomvolume = Space$(15)
  ResStr = Space$(32)
  retVal = GetVolumeInformation(lecteur, nomvolume, Len(nomvolume), _
                        numserie, dum, dum, ResStr, Len(ResStr))
  Serie = Right(String(8, "0") + Hex$(numserie), 8)
  nmserie = Left(Serie, 4) + "-" + Right$(Serie, 4)
  numvolume = Trim(nomvolume)
End Sub