[VBS] Authentification avec votre clé USB personnelle

Version imprimable

Salut à Tous ! :)
Introduction:
Voila comme le titre l'indique "Authentification avec votre clé USB personnelle: c'est comme Trouver la clé à sa serrure !" :ccool:
Après des décennies, des siècles d’existence et d’évolution, avec quoi ouvrez-vous votre porte d’entrée ? Une clé, évidemment. Alors pourquoi ne pas en faire de même pour votre ordinateur ?

Cela tombe bien, il existe un homonyme informatique qui est également un petit objet, transportable dans une poche toujours avec soi, muni d’un identifiant unique et très difficilement falsifiable, qui en plus permet de stocker des données : c'est votre clé USB ;).
Alors, je suis entrain de programmer un Script qui simule tout ce que je viens de dire ci-dessus.

Le principe est simple: le script vérifie le numéro d’identification qui est le N° de série de votre clé USB (SerialNumber) et au moment de s’identifier, si il la trouve branchée sur votre système, il lit ces données qu’il y aura placé comme confirmation, ensuite il vous autorise a accéder au système. dans le cas contraire, l'ordinateur va s'éteindre !.

Voila pour commencer un petit script pour tester et vérifier si votre clé USB est connecté ou non, si cette dernière est connectée alors le script nous donne son N° de Série, qu'on va l'utiliser dans le script suivant "AUTHENTIFICATION_PAR_USB.vbs" en remplaçant mon N° Série par le Votre.8-)

Code:

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
'----------------------------NumSerie_Usb.vbs------------------------------
'Tester et vérifier si votre clé USB est connecté ou non, 
'si cette dernière est connectée alors le script nous donne son N° de Série.
'© Hackoo
'--------------------------------------------------------------------------
  Sub NumSerie_Usb()
  Dim NumSerie
  'Retrouver la clé Usb et son numéro de série
  Set fso = CreateObject("Scripting.FileSystemObject")
  For Each Drive In fso.Drives
  If Drive.IsReady Then
  If Drive.DriveType=1 Then
  NumSerie=fso.Drives(Drive + "\").SerialNumber
  MsgBox "La Clé Usb inséré a comme Num° de Série "&NumSerie,64,"Vérification Clé Usb © Hackoo"
  end if
  End If
  Next
  End Sub
 
'------------------------------checkUSB----------------------------
Sub checkUSB
strComputer = "."
On Error Resume Next
Set WshShell = CreateObject("Wscript.Shell")
beep = chr(007)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE InterfaceType='USB'",,48)
intCount = 0
For Each drive In colItems
    If drive.mediaType <> "" Then
        intCount = intCount + 1
    End If
Next
If intCount > 0 Then
    MsgBox "Votre Clé USB Personnelle est bien Connectée !",64,"Flash Drive Check © Hackoo!"
	Call NumSerie_Usb() ' Appelle a la procédure NumSerie_Usb()
else
	WshShell.Run "cmd /c @echo " & beep, 0
	wscript.sleep 1000
	MsgBox "Votre Clé USB Personnelle n'est pas Connectée ",48,"Flash Drive Check © Hackoo !"
End If
End Sub
'---------------------------Fin du checkUSB----------------------------
Call checkUSB ' Appelle a la procédure checkUSB

Description du Script: AUTHENTIFICATION_PAR_USB.vbs

Ce Script utilise Le N°de Série de votre clé usb personnelle pour être autorisé a utiliser l'ordinateur.
Dés le démarrage du système , l'utilisateur a trois chances séparés par un intervalle de temps de 10 secondes pour insérer la bonne clé personnelle tout en désactivant le Gestionnaire des Tâches et en tuant l'explorateur windows (explorer.exe).
Si celle-ci aprés une authentification soit la bonne clé, alors l'utilisateur peut poursuivre son travail en quittant ce script, Sinon l'ordinateur va s'éteindre !

Code:

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
'------------------------AUTHENTIFICATION_PAR_USB.vbs---------------------------------------
'© Hackoo ©
' Description du Ce Script :
' Ce script utilise Le N°de Série de votre clé usb personnelle pour être autorisé a utiliser l'ordinateur.
' Dés le démarrage du système , l'utilisateur a trois chances séparés par un intervalle de temps 
' de 10 secondes pour insérer la bonne clé personnelle tout en désactivant le Gestionnaire des Tâches 
' et en tuant l'explorateur windows (explorer.exe).
' Si celle-ci après une authentification soit la bonne clé, alors l'utilisateur peut poursuivre son travail
' en quittant ce script, Sinon l'ordinateur va s'éteindre !
'© Hackoo ©
'----------------------------------------------------------------------------------------------------------
 
'---------------------------Programme Principal-------------------------------------------
Dim MonScript,cible,Boucle,Count,AppData
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = WScript.CreateObject("WScript.Shell")
AppData= ws.ExpandEnvironmentStrings("%AppData%")
cible = AppData & "\"
Boucle=True
count = 0
MonScript = wscript.scriptfullname
if (not fso.fileexists(AppData & "\"& MonScript)) then
		fso.copyfile MonScript , cible
		end if
	Shortcut
 
while Boucle ' Tant que la Variable Booléene Boucle est en True on lance La Boucle While
Count = Count + 1 ' Alors on incremente le compteur
MsgBox "POUR ETRE AUTORISE A UTILISER CET ORDINATEUR, VEUILLEZ SVP INSERER VOTRE CLE USB PERSONNELLE POUR L'AUTHENTIFICATION,MERCI !",48,"ESSAI N°  "&Count& "  Vérification de Votre Clé Usb Personnelle © Hackoo !"
wscript.sleep 10000 ' vous avez 10 secondes pour insérer votre clé !
  checkUSB  ' Contrôle de la clé USB si elle est connectée ou non
  Kill_Explorer ' Tuer le Processus d'explorer.exe
  DisableTaskMgr ' Désactiver le Gestionnaire des Tâches
If Count > 2 Then ' Si la le Compteur devient > 2 alors la Boucle devient False et on sort de la Boucle While
   Boucle =False
MsgBox "ATTENTION VOTRE ORDINATEUR VA S'ARRÊTER MAINTENANT !",48,"ESSAI N°  "&Count& "  Vérification Clé Usb © Hackoo !"
    Call ShutDown ' Appelle La Fonction Shutdown pour éteindre l'ordinateur
end if
wend
'----------Fin du Programme Principal---------
 
'-----------------checkUSB()------------------
Sub checkUSB
strComputer = "."
On Error Resume Next
Set WshShell = CreateObject("Wscript.Shell")
beep = chr(007)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE InterfaceType='USB'",,48)
intCount = 0
For Each drive In colItems
    If drive.mediaType <> "" Then
        intCount = intCount + 1
    End If
Next
If intCount > 0 Then
    MsgBox "Votre Flash Disk est bien Connecté, On passe a l'Authentification Merci !",64,"Flash Drive Check © Hackoo !"
 
	Verif_Serial_Usb
 
else
	WshShell.Run "cmd /c @echo " & beep, 0
	wscript.sleep 1000
	MsgBox "ATTENTION ! VOTRE FLASH DISK N'EST PAS CONNECTE !",48,"Flash Drive Check © Hackoo !"
End If
End Sub
'---------------Fin checkUSB()----------------
 
'-------------Verif_Serial_Usb()-------------
Sub Verif_Serial_Usb()
Dim SerialNumber,NumSerie
'Boucle=True
SerialNumber = 1021505376 'C'est ici !! que vous devez placer le N°de série de votre clé USB (pour moi 1021505376)
                         'et c'est a vous de le remplacer par le votre,
			 'en utilisant le script NumSerie_Usb.vbs pour Retrouver son numéro de série
  Set fso = CreateObject("Scripting.FileSystemObject")
For Each Drive In fso.Drives
If Drive.IsReady  Then
    If Drive.DriveType=1 Then
	NumSerie=fso.Drives(Drive + "\").SerialNumber
    If SerialNumber=NumSerie then 'Si Le N° de série est bien de votre clé usb 		                             
	MsgBox "La Clé Usb inséré a été Bien Authentifié ! Merci Bien !",64,"Vérification Clé Usb © Hackoo !"
	Call Explorer() 'Lancer l'explorateur Windows explorer.exe
	Call EnableTaskMgr() ' Activer Le Gestionnaire des Tâches
	wscript.Quit() ' Quitter le Script
	    else
	MsgBox  "La Clé Usb inséré n'a pas été Authentifié !",16,"Vérification Clé Usb © Hackoo !"
	    end if
    End If
End If
Next
End Sub
'--------------------Fin du Verif_Serial_Usb()----------
 
'---------------------------Shortcut()------------------
sub Shortcut
dim shell,startupPath,link,temp,FSO,nom,WshNetwork,AppData
Set Shell = CreateObject("WScript.Shell")
startupPath = Shell.SpecialFolders("startup")
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
AppData= Shell.ExpandEnvironmentStrings("%AppData%")
NomScript=wscript.scriptname
Set link = Shell.CreateShortcut(startupPath & "\Windows Update.lnk")
link.Description = "Windows Update"
link.IconLocation = "explorer.exe, 0"
link.TargetPath = AppData & "\" & NomScript
link.WorkingDirectory = AppData
link.Save
end sub
'---------------------Fin du Shortcut()---------------
 
'-----------------------ShutDown()--------------------
Sub ShutDown()
Set WS = CreateObject("WScript.Shell")
    Command = "cmd /C shutdown -s -t 60 -c Arrêt_du_Système_dans_une_Minute_©Hackoo"
    Result = Ws.Run(Command,0,True)
End Sub
'-------------------Fin du ShutDown()-------------
 
'--------------------EnableTaskMgr()--------------
sub EnableTaskMgr
Dim WshShell,System
System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
Set WshShell=WScript.CreateObject("WScript.Shell")
Wshshell.RegWrite System, "REG_SZ"
WshShell.RegWrite System &"\DisableTaskMgr", 0, "REG_DWORD"
end sub
'-------------Fin du EnableTaskMgr()-----------
 
'----------------DisableTaskMgr()--------------
sub DisableTaskMgr
Dim WshShell,System
System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
Set WshShell=WScript.CreateObject("WScript.Shell")
Wshshell.RegWrite System, "REG_SZ"
WshShell.RegWrite System &"\DisableTaskMgr", 1, "REG_DWORD"
end sub
'-----------------Fin du DisableTaskMgr()------------
 
'--------------------Kill_Explorer()-------------------
Sub Kill_Explorer
Dim Com,Kill
Set WS = CreateObject("WScript.Shell")
Com="taskkill /f /IM explorer.exe"
kill=Ws.Run(Com,0,True)
end Sub
'----------------Fin du Kill_Explorer()-----------------
 
'--------------------Explorer()-------------------------
Sub Explorer
Set WS = CreateObject("WScript.Shell")
Com="cmd /c start explorer.exe"
Launch=Ws.Run(Com,0,True)
end sub
'---------------Fin du Explorer()------------------------

NB: Il ne faut pas exécuter le script AUTHENTIFICATION_PAR_USB.vbs au premier avant de l'éditer et remplacer mon
N° de série par le votre qui est obtenu par le 1er script sinon vous restez bloquer lors du prochain démarrage de windows, mais si c'est le cas par erreur, alors j'ai prévu un autre script pour déinstaller ce dernier.

Code:

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
'Ce script sert a déinstaller le script AUTHENTIFICATION_PAR_USB.vbs et de ne pas rester bloquer avec ce dernier !
'© Hackoo ©
'---------------------------------------------------------------------------
Call Supprimer_Script()
Call EnableTaskMgr()
Call Explorer()
Call Kill_wscript
 
'----------------Kill_wscript()--------------
Sub Kill_wscript()
Dim Com,Kill
Set WS = CreateObject("WScript.Shell")
Com="taskkill /f /IM wscript.exe"
kill=Ws.Run(Com,0,True)
end Sub
'------------Fin du Kill_wscript()-----------
 
'------------------Explorer()----------------
Sub Explorer()
Set WS = CreateObject("WScript.Shell")
Com="cmd /c start explorer.exe"
Launch=Ws.Run(Com,0,True)
end sub
'---------------Fin du Explorer()------------
 
'---------------EnableTaskMgr()--------------
sub EnableTaskMgr()
Dim WshShell,System
System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
Set WshShell=WScript.CreateObject("WScript.Shell")
Wshshell.RegWrite System, "REG_SZ"
WshShell.RegWrite System &"\DisableTaskMgr", 0, "REG_DWORD"
end sub
'-------------Fin du EnableTaskMgr()------------
 
'---------------Supprimer_Script()--------------
Sub Supprimer_Script()
 
Dim destfile,fso,ws,startupPath
Set ws = CreateObject("WScript.Shell")
Set fso = createObject("Scripting.FileSystemObject")
AppData= ws.ExpandEnvironmentStrings("%AppData%")
if  fso.fileexists(AppData & "\AUTHENTIFICATION_PAR_USB.vbs") then
set destfile = fso.GetFile(AppData & "\AUTHENTIFICATION_PAR_USB.vbs")
destfile.Delete 
end if
startupPath = ws.SpecialFolders("startup")
if  fso.fileexists(startupPath & "\Windows Update.lnk") then
set link=fso.GetFile(startupPath & "\Windows Update.lnk")
link.delete
end if 
end Sub
'-------------Fin de Supprimer_Script()------------

Finalement je cherche Maintenant du côté sécurité car ce script n'est pas sécurisé à 100% car n'importe qui peut se logger dans le système sans douleur en mode sans échec.
Donc j'attends de vous quelques propostions et suggestions de codes a ajouter ou bien a supprimer au niveau sécurité pour améliorer ce script. Merci pour votre éventuelle contribution, et vos remarques et vos commentaires sont les bienvenues ! ;) :ccool:

Mise à Jour du Script

Description de La Mise à Jour:
Salut à Tous ! :) voila, j'ai ajouter quelques portions de codes afin d'améliorer la sécurité qui est l'atout essentiel pour ce genre de programme.
-Le Programme devient installable via la base des registres en ajoutant la valeur de la N° de série de la clé USB
et j'ai penser a ajouter une autre valeur qui est le mot de passe lors de l'installation qui va nous servir en cas
d'urgence pour débloquer le système. En effet car c'est le seul moyen pour débloquer le système en cas de panne matériel ("Non Reconnaissance de votre clé , Ports USB défectueux Etc....") ou bien votre clé est perdue ou bien volée !!
-j'ai ajouter aussi un système de journal (LogFile) pour enregistrer les tentatives d'intrusions en les inscrivant dans ce dernier La Date , l'heure, le N° de série et le mot de passe non Authentifiés.

NB : Ce script Modifie bien une valeur de clé dans la base de registre que je la considère comme une clé "VITALE" pour le bon fonctionnement du système : HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\userinit
(Ce processus se lance après une ouverture de session Windows. Il établit votre connexion au réseau et à Internet, charge différents processus système (comme la barre des tâches) et mettre en marche le shell de windows. ainsi que les paramètres propres à votre session.)
C'est le seul moyen que j'ai trouver pour assurer une sécurité maximale pour le système, même le Mode sans échec n'échappera jamais de mon script :) testé et approuvé sur une machine windows XP SP3.
Sur Windows Vista et Seven je ne crois pas qu'il va marcher et c'est a vous de le juger et a participer un peu pour le faire marcher dans ces derniers systèmes d'exploitations.

-Un Conseil lisez bien le code et vérifiez bien s'il n'y a pas des erreurs par ici ou bien par là, car je ne suis pas responsable si vous rencontriez des problèmes dans votre système. Plutôt essayez-le sur une veille
machine dans le cas ou vous êtes obliger à réinstaller windows.Par exemple moi j'ai du le réinstaller pas mal de fois a cause de la clé "VITALE" et ceci par erreur de Syntaxe :lol:
-j'ai ajouter aussi un script pour la désinstallation pour remettre tout en Ordre ;)
-Remarque: Enregistrez le 1er script sous le Nom INSTALL_AUTH_USB.vbs et assurez bien de ne pas modifiez son nom afin de garantir sa désinstallation par 2ème script UNINSTALL_AUTH_USB.vbs.

-Finallement j'attends les Bêta-Testeurs et vos feed-back au niveau de sécurité pour ce script :mouarf:. Merci pour votre éventuelle contribution, et vos remarques et vos commentaires sont les bienvenues ! ;) :ccool:

Code source du script : INSTALL_AUTH_USB.vbs

Code:

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
'--------------------------------------INSTALL_AUTH_USB.vbs------------------------------------------------
'© Hackoo © 2010
'Description du Ce Script :
'Ce script utilise Le N°de Série de votre la clé usb personnelle pour être autorisé a utiliser l'ordinateur.
'Dés le démarrage du système ,l'utilisateur a trois chances pour insérer la bonne clé personnelle tout en désactivant le Gestionnaire des Tâches et en remplaçant le processus "Vitale" (userinit.exe) par ce script.
'Si celle-ci aprés une authentification soit la bonne clé, alors l'utilisateur peut poursuivre son travail en quittant ce script, Sinon l'ordinateur va s'éteindre !
'© Hackoo © 2010
'----------------------------------------------------------------------------------------------------------
'---------------------------Programme Principal------------------------------------------------------------
Dim MonScript,cible,Count,AppData
Dim Controle,Compteur
Set fso = CreateObject("Scripting.FileSystemObject")
Titre="  VERIFICATION DE VOTRE CLE USB © Hackoo © 2010 "
 Compteur = 0
 Controle = True
 checkUSBInstall
 If RegExists("HKLM\Software\AUTH_USB\") Then
DisableTaskMgr ' Désactiver le Gestionnaire des Tâches
While Controle ' Tant que la Variable Booléene Controle est en True on lance La Boucle While
Compteur = Compteur + 1 ' Alors on incremente le compteur
MsgBox "                POUR ETRE AUTORISE A UTILISER CET ORDINATEUR !"& vbcrlf &"VEUILLEZ SVP INSERER VOTRE CLE USB PERSONNELLE POUR L'AUTHENTIFICATION ",48,"ESSAI N°  "&Compteur& Titre
'wscript.sleep 2000 ' vous avez 2 secondes pour insérer votre clé !
checkUSB 
if Compteur > 2 then ' Si la le Compteur devient > 2 alors le Compteur devient False et on sort de la Boucle While
Controle=False
MsgBox "ATTENTION VOTRE ORDINATEUR VA S'ARRETER MAINTENANT !",48,"ESSAI N°  "&Compteur& Titre
    Call ShutDown ' Appelle La Fonction Shutdown pour éteindre l'ordinateur
end if
'MsgBox "DESOLE VOTRE ORDINATEUR VA S'ETEINDRE !",16,"ESSAI N° "&Compteur& " Vérification Clé Usb Hackoo © "
wend
 Else
Call Install
 end if
'----------Fin du Programme Principal----------
 
'---------------------Install()-----------------------
sub Install
on error resume next
Dim AppData,Monscript,cible
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ws = WScript.CreateObject("WScript.Shell")
AppData= ws.ExpandEnvironmentStrings("%AppData%")
cible = AppData & "\"
Title = "INSTALLATION CLE USB © Hackoo © 2010 "
' Retrouver la clé Usb et son numéro de serie
  For Each Drive In fso.Drives
  If Drive.IsReady Then
  If Drive.DriveType=1 Then
  NumSerie=fso.Drives(Drive + "\").SerialNumber
  'MsgBox "La Clé Usb inséré a comme Num° de Série "&NumSerie,64,"Vérification Clé Usb Hackoo © "
  end if
  End If
  Next
 
If Numserie <> "" then
IF MsgBox ("VOULEZ-VOUS INSTALLER VOTRE CLE USB PERSONNELLE SUR CE SYSTEME !",1 + 256 + 48 + 4096 ,Title ) = 2 Then
Msgbox "Vous avez choisi d'annuler l'installation de votre clé usb personnelle sur ce système! !",64,Title
wscript.Quit()
else
Call Setup_Password()
'Ws.RegWrite "HKLM\Software\AUTH_USB\SerialNumber",NumSerie
MonScript = wscript.scriptname
if (not fso.fileexists(AppData & "\"& MonScript)) then
		copier AppData,MonScript
end if
LockSystem
MsgBox "MERCI BIEN VOTRE CLE USB EST DESORMAIS INSTALLEE ET BIEN CONFIGUREE !",64," INSTALLATION Clé Usb Hackoo © "
 end if
 END IF
 end sub
'---------------------Fin du Install()----------------------
 
'-----------------checkUSBInstall-----------------------
Sub checkUSBInstall
strComputer = "."
On Error Resume Next
Set WshShell = CreateObject("Wscript.Shell")
beep = chr(007)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE InterfaceType='USB'",,48)
intCount = 0
For Each drive In colItems
    If drive.mediaType <> "" Then
        intCount = intCount + 1
    End If
Next
If intCount > 0 Then
    MsgBox "Il Y A UNE CLE USB QUI EST CONNECTEE ,ON VA PASSER A L'AUTHENTIFICATION !",64,Titre
 
else
	WshShell.Run "cmd /c @echo " & beep, 0
	wscript.sleep 1000
	MsgBox "ATTENTION !!! VOTRE CLE USB N'EST PAS CONNECTEE ,VEUILLEZ L'INSERER MAINTENANT, MERCI !",48,Titre
 
End If
End Sub
 
 Function RegExists(value)
 On Error Resume Next
 Set WS = CreateObject("WScript.Shell")
 val = WS.RegRead(value)
 If (Err.number = -2147024893) or (Err.number = -2147024894) Then
 RegExists = False
 Else
 RegExists = True
 End If
 End Function
 
Sub Verif_Usb()
  Dim Serial,NumSerie
  Set WS = CreateObject("WScript.Shell")
  Serial = Ws.RegRead("HKLM\Software\AUTH_USB\SerialNumber")
  serial = Int(Serial)
  Titre = " VERIFICATION CLE USB"
  'MsgBOX serial,64,"serialNumber"
  ' Retrouver la clé Usb et son numéro de serie
  Set fso = CreateObject("Scripting.FileSystemObject")
  For Each Drive In fso.Drives
  If Drive.IsReady Then
  If Drive.DriveType=1 Then
  NumSerie=fso.Drives(Drive + "\").SerialNumber
  'MsgBox NumSerie,64,"Donnée par RegREAD"
  if NumSerie = serial Then 'Si Le N° de série est bien de votre clé usb alors on passe a la vérification
  'du mot de passe sinon en quitte le programme
  MsgBox "La CLE USB INSEREE A ETE BIEN RECONNUE !",64,Titre
  Logon()
  'debloquemoi
  else
  MsgBox "La CLE USB INSEREE N'A PAS ETE BIEN RECONNUE !",16,Titre
  'debloquemoi
  end if
  End If
  End If
  Next
  end Sub
'-----------------checkUSB-----------------------
Sub checkUSB
strComputer = "."
On Error Resume Next
Set WshShell = CreateObject("Wscript.Shell")
beep = chr(007)
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive WHERE InterfaceType='USB'",,48)
intCount = 0
For Each drive In colItems
    If drive.mediaType <> "" Then
        intCount = intCount + 1
    End If
Next
If intCount > 0 Then
    MsgBox "VOTRE CLE USB EST BIEN CONNECTEE !",64,Titre
	Verif_Usb()
 
	'debloquemoi
 
else
	WshShell.Run "cmd /c @echo " & beep, 0
	wscript.sleep 1000
	MsgBox "ATTENTION !!! Votre Clé Usb n'est pas Connectée ",48,Titre
	debloquemoi
End If
End Sub
'--------------------------------debloquemoi-------------------------
Sub debloquemoi()
Const ForWriting = 2
Const ForAppending = 8
Dim Ws,EnableLogon,Password,MDP,itemtype,LireSerialNumber,LireMDP,com,oKeyLog
Set Ws = CreateObject("Wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
AppData= ws.ExpandEnvironmentStrings("%AppData%")
For Each Drive In fso.Drives
  If Drive.IsReady Then
  If Drive.DriveType=1 Then
  NumSerie=fso.Drives(Drive + "\").SerialNumber
  NumSerie=Int(Numserie)
  'MsgBox "La Clé Usb inséré a comme Num° de Série "&NumSerie,64,"Vérification Clé Usb"
  end if
  End If
  Next
com = "cmd /c userinit.exe"
MDP = "HKLM\Software\AUTH_USB\MDP"
SerialNumber = "HKLM\Software\AUTH_USB\SerialNumber"
itemtype = "REG_SZ"
Password = InputBox("VEUILLEZ ENTRER VOTRE MOT DE PASSE POUR DEBLOQUER LE SYSTEME !", "VERIFICATION DU MOT DE PASSE © Hackoo ","") 'Demande du mot de passe
If RegExists(SerialNumber) AND RegExists(MDP) Then
	 LireSerialNumber = ws.RegRead(SerialNumber)
	 LireMDP = ws.RegRead(MDP)
	 'MsgBox LireSerialNumber
	 'MsgBox LireMDP
	 If Password = LireMDP then
	 Call EnableTaskMgr() ' Activer Le Gestionnaire des Tâches
	 EnableLogon=Ws.Run(com,0,true)
	 wscript.Quit()
	 'Msgbox "VOTRE MOT DE PASSE EST JUSTE !",64,"Information"
	 else
	 If Not FSO.FileExists(AppData & "\LogUsb.htm") Then
Set oKeyLog = Fso.OpenTextFile(AppData & "\LogUsb.htm",ForWriting, True)
oKeyLog.write "<html><head><title>Journal clé USB © Hackoo © 2010 !</title><body bgcolor=#000000 text=#Green link=#336699 vlink=#336699 alink=#336699>"
oKeyLog.write "<center>**************** Nous sommes le "&Date& " *** 1er Démarrage du Journal USB à "&Time&"******************</center>"
oKeyLog.write "<center>Le "&Date&" à " & Time & " La Clé USB a échoué a l'Autentifiacation a comme N° de Série : "&NumSerie&"<br></center>"
oKeyLog.write "<center>Le "&Date&" à " & Time & " Le Mot de Passe tapé qui a échoué a l'Autentifiacation est : "&Password&"<br></center>"
oKeyLog.write "<center>**************************************************************************************</center>"
else 
Set oKeyLog = Fso.OpenTextFile (AppData & "\LogUsb.htm",ForAppending, True)
'oKeyLog.write "<html><head><title>Journal clé USB © Hackoo © 2010 !</title><body bgcolor=#000000 text=#Green link=#336699 vlink=#336699 alink=#336699>"
'oKeyLog.write "<center>**************** Nous sommes le "&Date& " *** Démarrage du Journal USB à "&Time&"******************</center>"
oKeyLog.write "<center>Le "&Date&" à " & Time & " La Clé USB a échoué a l'Autentifiacation a comme N° de Série : "&NumSerie&"<br></center>"
oKeyLog.write "<center>Le "&Date&" à " & Time & " Le Mot de Passe tapé qui a échoué a l'Autentifiacation est : "&Password&"<br></center>"
oKeyLog.write "<center>**************************************************************************************</center>"
end if
'end if
	 Msgbox "MOT DE PASSE INCORRECT VOUS N'AVEZ PAS LE DROIT D'ACCEDER AU SYSTEME !!",16,"MOT DE PASSE INCORRECT Hackoo © !!"
	 end if
	 end if
 
end sub
'--------------------Fin du debloquemoi-------------
'-----------------------LockSystem-------------------
sub LockSystem
Dim Ws,DisableLogon
Dim n, p, itemtype,Sys32
Set Ws = CreateObject("Wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
AppData= ws.ExpandEnvironmentStrings("%AppData%")
NomScript=wscript.scriptname
'MsgBox AppData &"\"& NomScript
p = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\"
p = p & "Userinit"
itemtype = "REG_SZ"
n = "wscript.exe /E:vbs """& AppData &"\"& NomScript&".db"""
WS.RegWrite p, n, itemtype
end sub
'---------------------copier(x,name)-------------------------
sub copier(x,name)
dim File,fso
Set fso = CreateObject("Scripting.FileSystemObject")
File = Wscript.ScriptFullName
fso.copyfile file ,x & "\" & name & ".db"
end sub
'---------------------Fin du copier(x,name)------------------
 
'-----------------------ShutDown()-----------------------------
Sub ShutDown()
Set WS = CreateObject("WScript.Shell")
    Command = "cmd /C shutdown -s -t 60 -c Arrêt_du_Système_dans_une_Minute_©Hackoo"
    Result = Ws.Run(Command,0,True)
End Sub
'-------------------Fin du ShutDown()-------------
 
'--------------------EnableTaskMgr()--------------
sub EnableTaskMgr
Dim WshShell,System
System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
Set WshShell=WScript.CreateObject("WScript.Shell")
Wshshell.RegWrite System, "REG_SZ"
WshShell.RegWrite System &"\DisableTaskMgr", 0, "REG_DWORD"
end sub
'-------------Fin du EnableTaskMgr()-----------
 
'----------------DisableTaskMgr()--------------
sub DisableTaskMgr
Dim WshShell,System
System="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System\"
Set WshShell=WScript.CreateObject("WScript.Shell")
Wshshell.RegWrite System, "REG_SZ"
WshShell.RegWrite System &"\DisableTaskMgr", 1, "REG_DWORD"
end sub
'----------------Fin du DisableTaskMgr()--------------
 
'-----------------Setup_Password()---------------------
Sub Setup_Password()
Dim Ws,Password,MDP,itemtype,LireSerialNumber,LireMDP
Set Ws = CreateObject("Wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
MDP = "HKLM\Software\AUTH_USB\MDP"
SerialNumber = "HKLM\Software\AUTH_USB\SerialNumber"
itemtype = "REG_SZ"
For Each Drive In fso.Drives
  If Drive.IsReady Then
  If Drive.DriveType=1 Then
  NumSerie=fso.Drives(Drive + "\").SerialNumber
  'MsgBox "La Clé Usb inséré a comme Num° de Série "&NumSerie,64,"Vérification Clé Usb Hackoo © "
  end if
  End If
  Next
VIDE=True
While VIDE
If Password="" Then
 Msgbox "ATTENTION !!! VOTRE MOT DE PASSE EST VIDE VEUIILEZ CHOISIR UN !!!",48,"Tous les droits d'accés au système Hackoo © !!" 
  Password = InputBox("VEUILLEZ ENTRER VOTRE MOT DE PASSE POUR DEBLOQUER LE SYSTEME : C'EST LE SEUL MOYEN POUR DEBLOQUER LE SYSTEME EN CAS D'URGENCE OU VOTRE CLE EST PERDUE OU BIEN VOLEE !!", "INSTALLATION DU MOT DE PASSE © Hackoo","") 'Demande du mot de passe
    If Password <>"" Then 
      VIDE=False
       Msgbox "VOTRE MOT DE PASSE EST  ""{"&Password&"}""  SAUVEGARDER LE BIEN ! C'EST LE SEUL MOYEN POUR DEBLOQUER LE SYSTEME EN CAS D'URGENCE OU VOTRE CLE EST PERDUE OU BIEN VOLEE !!",64,"MOT DE PASSE INSTALLE Hackoo © !!"
	    Ws.RegWrite MDP, Password, itemtype
	 If Numserie <> "" then
        Ws.RegWrite SerialNumber,NumSerie
     END IF
   End if 
End if
Wend
end Sub
'--------------Fin du Setup_Password()-----------
'----------------------------Logon---------------------
Sub Logon()
Dim Ws,EnableLogon,LireSerialNumber,com
Set Ws = CreateObject("Wscript.Shell")
com = "cmd /c userinit.exe"
Call EnableTaskMgr() ' Activer Le Gestionnaire des Tâches
EnableLogon=Ws.Run(com,0,true)
wscript.Quit()
End Sub	 
'----------------------------Fin du Logon---------------------

Code source du script : UNINSTALL_AUTH_USB.vbs
Ce script sert a déinstaller le script INSTALL_AUTH_USB.vbs et de ne pas rester bloquer avec ce dernier !

Code:

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
'--------------------------------------------------------------------------------
'Ce script sert a déinstaller le script INSTALL_AUTH_USB.vbs 
'et de ne pas rester bloquer avec ce dernier !
'© Hackoo © 2010
'-------------------------------------------------------------------------------
Call UNINSTALL
 
sub UNINSTALL
Dim Ws
Dim n, p, itemtype,System32
Set Ws = CreateObject("Wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
AppData= ws.ExpandEnvironmentStrings("%AppData%")
p = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\Winlogon\"
p = p & "Userinit"
itemtype = "REG_SZ"
System32=FSO.GetSpecialFolder(1)
n = System32 & "\userinit.exe"
Title = "DEINSTALLATION Clé Usb © Hackoo © "
If MsgBox ("VOULEZ-VOUS DEINSTALLER VOTRE CLE USB PERSONNELLE DU SYSTEME !",1 + 256 + 48 + 4096 ,Title ) = 2 Then
Msgbox "Vous avez choisi d'annuler la déinstallation de votre clé usb personnelle ! !",64,Title
wscript.Quit()
else
IF fso.fileexists(AppData & "\INSTALL_AUTH_USB.vbs.db") then
FSO.DeleteFile AppData & "\INSTALL_AUTH_USB.vbs.db",True 
end if
IF fso.fileexists(AppData & "\LogUsb.htm") then
FSO.DeleteFile AppData & "\LogUsb.htm",True 
end if
IF RegExists("HKLM\Software\AUTH_USB\") Then 
'Ws.RegDelete("HKLM\Software\AUTH_USB\SerialNumber\")
'Ws.RegDelete("HKLM\Software\AUTH_USB\MDP\")
Ws.RegDelete("HKLM\Software\AUTH_USB\")
WS.RegWrite p, n, itemtype
Msgbox "VOTRE CLE USB PERSONNELLE A ETE DEINSTALLER DU SYSTEME AVEC SUCSSES !",64,Title
ELSE
WS.RegWrite p, n, itemtype
Msgbox "VOTRE CLE USB PERSONNELLE EST DEJA DEINSTALLEE DU SYSTEME !",16,Title
end if
end if
end sub
 
Function RegExists(value)
 On Error Resume Next
 Set WS = CreateObject("WScript.Shell")
 val = WS.RegRead(value)
 If (Err.number = -2147024893) or (Err.number = -2147024894) Then
 RegExists = False
 Else
 RegExists = True
 End If
 End Function

09/08/2010, 19h47
hackoofr

Mise à Jour : Cryptage du mot de passe+Boîte de dialogue en HTML

-Ajout d'une Fonction de Cryptage du Mot de passe de Secours qui va être sauvegarder dans la base de registre.
-Le Mot de passe de Secours va nous servir en cas d'urgence pour débloquer le système. En effet car c'est le seul moyen pour débloquer le système en cas de panne matériel ("Non Reconnaissance de votre clé , Ports USB défectueux Etc....") ou bien votre clé est perdue ou bien volée !!
-Remplacement de la Fonction InputBox pour l'installation et la récupération du mot de passe de Secours par une Boîte de dialogue généré dynamiquement par une page HTML.
-Voila une Capture d'écran du code en exécution: ici

http://dc236.4shared.com/img/3570886...2/AUTH-USB.JPG

-Voila le lien du Téléchargement des Scripts ;) :ccool:
AUTHENTIFICATION-CLE-USB.rar (INSTALL_AUTH_USB.vbs et UNINSTALL_AUTH_USB.vbs)

ou bien dans le serveur interne de développez.net dans la rubrique Téléchargement
28/09/2010, 14h46
hackoofr

1 pièce(s) jointe(s)

Animation par l'agent de Microsoft Merlin le Magicien

- J'ai ajouté l'agent de Microsoft Merlin le Magicien pour animer un peu le script :lol: :ccool: Voila une Démonstration en vidéo
http://img27.imageshack.us/img27/2628/97250894.jpg
- voila le nouveau lien de téléchargement du script AUTHENTIFICATION-CLE-USB-MERLIN
27/03/2013, 07h24
dragonno

Merci pour cette belle contribution ;)

Je ne programme pas en vb, j'aimerais bien l'adapter en C ou en delphi (priorité au Delphi 5/6), as-tu une idée ?
C'est pour pouvoir l'améliorer à mon aise une fois retranscris (sans l'agent).