Ejecter les CD ou DVD des lecteurs CDRom ou DVDRom

Commenter

Contenu du snippet 

Private Const INVALID_HANDLE_VALUE      As Long  = -1
Private Const OPEN_EXISTING             As Long  = 3
Private Const FILE_FLAG_DELETE_ON_CLOSE As Long  = 67108864
Private Const GENERIC_READ              As Long  = &H80000000
Private Const GENERIC_WRITE             As Long  = &H40000000
Private Const IOCTL_STORAGE_EJECT_MEDIA As Long  = 2967560
Private Const VWIN32_DIOC_DOS_IOCTL     As Long  = 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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) 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 GetVersion Lib "kernel32" () As Long
'
'
Public Sub EjectDrive(ByVal sLetter As String)
    Dim hDrive              As Long
    Dim DummyReturnedBytes  As Long
    Dim RawStuff            As DIOC_REGISTERS
        
'    nettoyage lettre
    sLetter = GetValideDriveLetter(sLetter)
    
    If LenB(sLetter) Then
        If GetVersion >= 0 Then 'We are running Windows  NT/2000
            hDrive = CreateFile("\\.\" & sLetter, GENERIC_READ Or GENERIC_WRITE, 0, ByVal  0, OPEN_EXISTING,  0, 0)
            If hDrive <> INVALID_HANDLE_VALUE  Then
                'Eject media!
                Call DeviceIoControl(hDrive,  IOCTL_STORAGE_EJECT_MEDIA, 0, 0,  0, 0, DummyReturnedBytes, ByVal 0)
                Call CloseHandle(hDrive)  'Clean up after  ourselves
            End If
        Else  'We are running Win9x/Me
            hDrive = CreateFile("\\.\VWIN32", 0, 0, ByVal 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)
            If hDrive <> INVALID_HANDLE_VALUE  Then
                'Setup our raw registers to use Interrupt 21h  Function 440Dh Minor Code 49h
                RawStuff.reg_EAX = &H440D  'The function to use
                RawStuff.reg_EBX = Asc(sLetter) - Asc("A") + 1 'The  drive to do it on
                RawStuff.reg_ECX = &H49 Or &H800 'The minor code of the  function in the low byte of the low word and the device category of 8 in the  high byte of the low word
                'Eject  media!
                Call DeviceIoControl(hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff,  LenB(RawStuff), RawStuff,  LenB(RawStuff),  DummyReturnedBytes, ByVal 0)
                Call CloseHandle(hDrive)  'Clean up after ourselves
            End If
        End If
    End If
End Sub
Public Function GetValideDriveLetter(ByVal sLetter As String) As String
    sLetter = UCase$(LeftB$(Trim$(sLetter), 2))
    If sLetter Like "[A-Z]" Then GetValideDriveLetter = sLetter & ":"
End Function

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

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.

Du même auteur (cs_bultez)