Detecter la présence d'un cd
Soyez le premier à donner votre avis sur cette source.
Vue 4 171 fois - Téléchargée 450 fois
Description
C'est au fait une fonction qui détécte la présence d'un CD dans le lecteur: Comme pour la plus part des jeux commercials.
Source / Exemple :
'Les constantes Public Const INVALID_HANDLE_VALUE = -1 Public Const GENERIC_WRITE = &H40000000 Public Const OPEN_EXISTING = 3 Public Const FILE_SHARE_READ = &H1 Public Const FILE_SHARE_WRITE = &H2 'Les API Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long Public Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Public 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 Public Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long Sub main() Call CD_Detection End Sub Sub CD_Detection() A = App.Path lecteur = Left$(A, 3) Label_du_CD = App.EXEName '1er méthode : Voit l'espace restant dans un CD en utilisant GetDiskFreeSpace '( Normallement, y'a pas d'espaces libres dans un CD) GetDiskFreeSpace lecteur, Sectors, Bytes, FreeC, TotalC If FreeC <> 0 Then GoTo fin '2eme méthode : la plus connu : Getdrivetype qui consiste à renvoyer la nature 'd'un lecteur, pour notre cas, ca doit être = 5 qui signifie "CD-ROM" If GetDriveType(lecteur) <> 5 Then GoTo fin '3eme méthode : Vérifie le label (ou nom) du cd et voir si il correspond 'au notre, utile pour vérifier si le CD est original ou gravé Vname = String$(255, Chr$(0)) FSName = String$(255, Chr$(0)) GetVolumeInformation lecteur, Vname, 255, Serial, 0, 0, FSName, 255 Vname = Left$(Vname, InStr(1, Vname, Chr$(0)) - 1) If Vname <> Label_du_CD Then GoTo fin '4eme méthode : essai de changer le label du CD (normallement impossible) A = SetVolumeLabel(lecteur, "") If A = 0 Then GoTo fin '5eme méthode : essai de créer un fichier dans le CD (re-normallement impossible) lngHandle = CreateFile(lecteur & "Test.sky", GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0) If lngHandle <> INVALID_HANDLE_VALUE Then Kill (lecteur & "Test.sky") 'L'efface si le fichier est créer. GoTo fin End If fin: MsgBox "Veuillez insérer le CD-ROM fournit avec " & App.EXEName, vbCritical + vbOKOnly, "CD non présent" End End Sub
Codes Sources
A voir également
- Detecter la présence d'un cd
- Détecter la présence de 2 pages de démarrage ✓ - Forum - Visual Basic 6
- Détecer la présence d'un disque amovible et la présence d'un CD dans le lecteur ✓ - Forum - VB.NET
- Détecter la présence d'excel ✓ - Forum - Visual Basic 6
- Visual Basic / VB.NET : Détection de mouvement/présence par webcam - CodeS SourceS - Guide
- Detecter insertion cd et bloquer autorun - Codes sources - Visual Basic / VB.NET (Fichier / Disque)
elle ne vient donc pas de toi
- Messages postés
-
412
- Date d'inscription
- mercredi 19 décembre 2001
- Statut
- Membre
- Dernière intervention
- 7 avril 2008
1Ta source est bien utile. Merci
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.