Je m' emmerdait, cet aprem, alors j' ai bricolé un prog qui ouvre et ferme les lecteurs CDs
Source / Exemple :
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Const INVALID_HANDLE_VALUE = -1
Const OPEN_EXISTING = 3
Const FILE_FLAG_DELETE_ON_CLOSE = 67108864
Const FILE_FLAG_WRITE_THROUGH = &H80000000
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000
Const IOCTL_STORAGE_EJECT_MEDIA = 2967560
Const IOCTL_STORAGE_LOAD_MEDIA = 2967564
Const VWIN32_DIOC_DOS_IOCTL = 1
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const CREATE_ALWAYS = 2
Const OPEN_ALWAYS = 4
Const TRUNCATE_EXISTING = 5
Private Type DIOC_REGISTERS
reg_EBX As Long
reg_EDX As Long
reg_ECX As Long
reg_EAX As Long
reg_EDI As Long
reg_ESI As Long
reg_Flags As Long
End Type
Public Sub lancement()
Dim Lecteur(1000), LecteurInv(1000), LecteurPair(500), LecteurImpair(500) As String
Set fso = CreateObject("Scripting.Filesystemobject")
Set ListeLecteurs = fso.drives
i = 0
For Each ListeEntree In ListeLecteurs
If ListeEntree.drivetype = 4 Then Lecteur(i) = ListeEntree: i = i + 1
Next
NbLecteurs = i
' retrie dans l' ordre décroissant
boucle = 0
Do
LecteurInv(boucle) = Lecteur(NbLecteurs - 1 - boucle)
boucle = boucle + 1
Loop Until boucle = NbLecteurs
'trie pair/impair
NP = 0
NiP = 0
boucle = 0
Do
If boucle / 2 = Int(boucle / 2) Then
LecteurPair(boucle) = Lecteur(boucle)
NP = NP + 1
Else
LecteurPair(boucle) = Lecteur(boucle)
NiP = NiP + 1
End If
boucle = boucle + 1
Loop Until boucle = NbLecteurs
'trie impair
'***** départ
Do
DoEvents
' ouvre dans l'ordre
For boucle = 1 To NbLecteurs
Pause (0.5 / NbLecteurs)
DoEvents
ouvrirlecteur (Lecteur(boucle - 1))
Next
Pause (1)
' ferme tout
For boucle = 1 To NbLecteurs
FermerLecteur (Lecteur(boucle - 1))
Next
Pause (2)
' ouvre dans le désordre
For boucle = 1 To NbLecteurs
Pause (0.5 / NbLecteurs)
DoEvents
ouvrirlecteur (LecteurInv(boucle - 1))
Next
Pause (1)
' ferme tout
For boucle = 1 To NbLecteurs
FermerLecteur (Lecteur(boucle - 1))
Next
Pause (2)
'Pair puis impairs
For boucle = 1 To NP
ouvrirlecteur (LecteurPair(boucle - 1))
Next
Pause (0.5)
For boucle = 1 To NiP
ouvrirlecteur (LecteurImpair(boucle - 1))
Next
Pause (1)
For boucle = 1 To NP
FermerLecteur (LecteurPair(boucle - 1))
Next
Pause (0.5)
For boucle = 1 To NiP
FermerLecteur (LecteurImpair(boucle - 1))
Next
Pause (2)
'Impair puis Pairs
For boucle = 1 To NiP
ouvrirlecteur (LecteurImpair(boucle - 1))
Next
Pause (0.5)
For boucle = 1 To NP
ouvrirlecteur (LecteurPair(boucle - 1))
Next
Pause (1)
For boucle = 1 To NiP
FermerLecteur (LecteurImpair(boucle - 1))
Next
Pause (0.5)
For boucle = 1 To NP
FermerLecteur (LecteurPair(boucle - 1))
Next
Pause (2)
DoEvents
Pause (1.5)
Loop
End Sub
Sub ouvrirlecteur(Lecteur)
Dim hDrive As Long, DummyReturnedBytes As Long
Dim RawStuff As DIOC_REGISTERS
If Len(Lecteur) Then 'Si une réponse
If GetVersion >= 0 Then 'marche si Windows NT/2000 ou XP
hDrive = CreateFile("\\.\" & Lecteur, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
If hDrive <> INVALID_HANDLE_VALUE Then
'Ejecte CD!
Call DeviceIoControl(hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0, 0, DummyReturnedBytes, ByVal 0)
Call CloseHandle(hDrive) 'Fin
End If
Else 'marche si Windows 9x ou Me
hDrive = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)
If hDrive <> INVALID_HANDLE_VALUE Then
RawStuff.reg_EAX = &H440D 'Fonction a utiliser ???? !!! ????
RawStuff.reg_EBX = Asc(Lecteur) - Asc("A") + 1 'Ouvre le lecteur
RawStuff.reg_ECX = &H49 Or &H800
'Ouverture
Call DeviceIoControl(hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff, LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0)
Call CloseHandle(hDrive) 'Fin
End If
End If
End If
End Sub
Public Sub FermerLecteur(Lecteur)
Dim hDisk As Long
Dim dwRc As Long
Dim sDisk As String
LettreLecteur = Left(Lecteur, Len(Lecteur) - 1)
' Crée le nom du disque
sDisk = "\\.\" & UCase(Mid(LettreLecteur, 1, 1)) & ":"
'prépare le "handle"
hDisk = CreateFile(sDisk, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or _
FILE_SHARE_WRITE, ByVal CLng(0), OPEN_EXISTING, FILE_FLAG_WRITE_THROUGH, _
ByVal CLng(0))
If hDisk = -1 Then Exit Sub 'erreur
'Vide la memoire cache
FlushFileBuffers (hDisk)
'Rentre le lecteur
If DeviceIoControl(hDisk, IOCTL_STORAGE_LOAD_MEDIA, _
ByVal CLng(0), 0, ByVal CLng(0), 0, _
dwRc, ByVal CLng(0)) = 0 Then
End If
'fini
CloseHandle (hDisk)
End Sub
Sub Pause(temps) 'en secondes
t = Timer
Do
DoEvents
Loop Until Timer >= t + temps
End Sub
Conclusion :
J' ai malhereusement qu' un seul lecteur CD, je n' ai donc pas vraiment pu l' essayer, je demenderait alrs à eux qui en ont plusieurs de me faire part de vos commentaires.
J' ai un peu modifié le code: cette sub peut fermer séparément chaque lecteur. Elle devrait mieux marcher.
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.