Soyez le premier à donner votre avis sur cette source.
Snippet vu 4 948 fois - Téléchargée 27 fois
Option Explicit 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 GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Public Enum CD EjecterCD = 2967560 FermerCD = 2967564 End Enum Public Function Operation(ByVal Lecteur As String) Dim hDrive As Long Dim DriveLetterAndColon As String Dim t1 As Variant Dim t2 As Variant Dim Action As CD Action = EjecterCD If Len(Lecteur) = 0 Then Exit Function 'Vérifie la présence d'un caractère Do 'ne sortira de la boucle qu'une fois l'action effectuée DriveLetterAndColon = UCase(Left$(Lecteur & ":", 2)) 'Met en majuscule pour une interprétation facile hDrive = CreateFile("\\.\" & DriveLetterAndColon, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, 3, 0, 0) If hDrive = -1 Then Exit Function t1 = Time '1ere variable de tps Call DeviceIoControl(hDrive, Action, 0, 0, 0, 0, 0, ByVal 0) t2 = Time '2eme variable de tps If Action = EjecterCD Then Action = FermerCD 'inverse la donne Else Action = EjecterCD End If Call CloseHandle(hDrive) 'indispensable Loop Until (t2 - t1) <> 0 'ouvrir ou fermer prends du tps 'donc sortie qd il y a eu du tps qui s'est écoulé durant l'action End Function
une fonction qui te permets proprement de savoir si un CD est présent dans l'un des lecteurs CD (celui désigné par la variable V_NomCD, en V_NomCD = "d:") est ouvert ou fermé
'------------------------------------------------------------------------------
'----Fonction booléenne qui indique VRAI si un CD est présent dans le lecteur
'----CD spécifié V_NomCD ---------bbword ------------------------------
'-----------------------------------------------------------------------------
Public Function CheckCDPresent(V_NomCD As String) As Boolean
Dim I&
Dim S As String * 30
I& = mciSendString("open " & V_NomCD & " type cdaudio alias cdaudio", vbNullString, 0, 0)
I& = mciSendString("status cdaudio media present", S, Len(S), 0)
I& = mciSendString("close cdaudio", vbNullString, 0, 0)
CheckCDPresent = S
End Function
Bravo , je met quand meme 8/10 pcq comme je c po tester, je c po dir si sa marche parfaitement etc...
Bonne continuation
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.