Detecter la présence d'un cd

Télécharger le projet
Commenter

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
Télécharger le projet

Codes Sources

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 (SkylandeR)