Detecter la présence d'un cd

Soyez le premier à donner votre avis sur cette source.

Vue 4 121 fois - Téléchargée 449 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

Ajouter un commentaire

Commentaires

Messages postés
26
Date d'inscription
mercredi 19 décembre 2001
Statut
Membre
Dernière intervention
17 août 2009

J' ai déjà vu ta source sur http://www.planet-source-code.com/
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
1
comme la plupart des jeux commerciaux et non commercials !!!
Messages postés
72
Date d'inscription
mardi 26 février 2002
Statut
Membre
Dernière intervention
20 juin 2003

Thanks a lot for your program... mais k'S qu'il me prend de parler anglais ;) Sans doute la chaleur lol. Vraiment très bien... et très pratique. Merci.
Messages postés
31
Date d'inscription
samedi 16 février 2002
Statut
Membre
Dernière intervention
8 octobre 2002

Bien !!!!!!!!!! (même très bien)
Ta source est bien utile. Merci
Messages postés
1491
Date d'inscription
dimanche 19 novembre 2000
Statut
Modérateur
Dernière intervention
7 juillet 2014

C'est cool sa change du code qui est la 50 fois de ouvrir/fermer le CD.......

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.