1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
| Option Compare Database
Public fso As FileSystemObject
Public Drive As Drive
Public NumSerieUSB As Long
Public DongleOK As Boolean
Private Sub Form_Load()
'************ Tester si la clé est presente au démarrage ************
NumSerieUSB = 217259051 ' Numéro de série de la clé USB
DongleOK = False ' Met le Dongle absent
Scan_Dongle ' Va à la procédure Scan du dongle
If DongleOK = False Then 'Si pas de dongle on quitte l'appli
DoCmd.Quit
Exit Sub
End If
Ens Sub
'************ TESTER si (USB se connecte) ************
'************ si oui, ne traiter que les périphériques de stockage de type USB ************
Private Sub SysInfo1_DeviceArrival(ByVal devicetype As Long, ByVal deviceid As Long, ByVal devicename As String, ByVal devicedata As Long)
' Ne traiter que les unités de stockage de type data0
If devicetype <> 2 Or devicedata <> 0 Then Exit Sub
' Scan de la presence du dongle
Scan_Dongle
'Text2.Visible = True ' <<<< A supprimer "affiche votre N° de série" !!!!
If DongleOK = True Then
'Code de démarrage ' si le dongle est présent démarrage du programme
End If
End Sub
'************ TESTER si (USB se déconnecte) ************
'************ si oui, ne traiter que les périphériques de stockage de type USB ************
Private Sub SysInfo1_DeviceRemoveComplete(ByVal devicetype As Long, ByVal deviceid As Long, ByVal devicename As String, ByVal devicedata As Long)
'Text2.Visible = True ' <<<< A supprimer "affiche votre N° de série"
' Ne traiter que les unités de stockage de type data0
If devicetype <> 2 Or devicedata <> 0 Then
Exit Sub
End If
'Si le dongle est déconnecté fin du prog
If Log(deviceid) / Log(2) + 65 = DongleLettre Then
Unload Me 'Code pour quitter le programme
End If
End Sub
'************ Tester si la clé USB est présente
Sub Scan_Dongle()
On Error GoTo Err
If DongleOK = True Then
Exit Sub ' si Dongle déja présent pas de scan
End If
' Retrouver le dongle et son numéro de serie
Set fso = New FileSystemObject
For Each Drive In fso.Drives
If Drive.IsReady = True And Drive.DriveLetter <> "a:" And Drive.DriveLetter <> "b:" Then
'Text2.Text = fso.Drives(Drive + "\").SerialNumber ' <<<< A supprimer "affiche votre N° de série"
If NumSerieUSB = fso.Drives(Drive + "\").SerialNumber Then
DongleOK = True ' dongle present
DongleLettre = Asc(Left$(Drive, 1)) ' memorise la lettre du dongle
Set fso = Nothing
'Text1.Visible = True ' efface text1
Exit Sub
End If
Else
Série = fso.Drives(Drive + "\").SerialNumber
Msg = MsgBox("Il y a un problème avec le lecteur " & Drive & vbCrLf & "Erreur: " & Err.Description, vbInformation + vbOKOnly, "Erreur disque")
End If
Next
Err:
If Err.Number = 71 Then
Msg = MsgBox("Il y a un problème avec le lecteur " & Drive & vbCrLf & "Erreur: " & Err.Description, vbInformation + vbOKOnly, "Erreur disque")
End If
End Sub |
Partager