- '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
'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