EJECTER UN CD EN FONCTION DE LA LETTRE DU LECTEUR

' Vous devez placer 2 boutons de commande (Command1) et (Command2)

Option Explicit

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 Const INVALID_HANDLE_VALUE = -1
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_DELETE_ON_CLOSE = 67108864
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const IOCTL_STORAGE_EJECT_MEDIA = 2967560 'Pour éjecter le lecteur
Private Const IOCTL_STORAGE_LOAD_MEDIA = 2967564 'Pour charger le lecteur
Private Const VWIN32_DIOC_DOS_IOCTL = 1
 
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

Private Enum Eject
    EJECT_MEDIA = 2967560
    LOAD_MEDIA = 2967564
End Enum

Private Sub Command1_Click()
    Operation EJECT_MEDIA
End Sub

Private Sub Command2_Click()
    Operation LOAD_MEDIA
End Sub

Private Sub Form_Load()
    Command1.Caption = "Ejecter"
    Command2.Caption = "Charger"
End Sub

Private Sub Operation(Action As Eject)
    Dim hDrive As Long, DummyReturnedBytes As Long
    Dim Ejecter As String, DriveLetterAndColon As String
    Dim RawStuff As DIOC_REGISTERS
    Ejecter = InputBox("Quel lecteur dois-je éjecter ?", "Ejecter un lecteur")
    If Len(Ejecter) Then 'Vérrifie que l'utilisateur n'ai pas appuyé sur Cancel
        DriveLetterAndColon = UCase(Left$(Ejecter & ":", 2)) 'Met en majuscule pour une interprétation facile
        If GetVersion >= 0 Then 'Tourne sous NT/2000/XP
            hDrive = CreateFile("\\.\" & DriveLetterAndColon, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
            If hDrive <> INVALID_HANDLE_VALUE Then
                'Ejection du lecteur
                Call DeviceIoControl(hDrive, Action, 0, 0, 0, 0, DummyReturnedBytes, ByVal 0)
                Call CloseHandle(hDrive)
            End If
        Else  'Tourne sous Win9x/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   'La fonction à utiliser
                RawStuff.reg_EBX = Asc(DriveLetterAndColon) - Asc("A") + 1 'Le lecteur à utiliser
                RawStuff.reg_ECX = &H49 Or &H800
                'Ejection du lecteur
                Call DeviceIoControl(hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff, LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0)
                Call CloseHandle(hDrive)  'Nettoyer après l'éjection
            End If
        End If
    End If
End Sub