Authentification par votre cle usb personnelle

Soyez le premier à donner votre avis sur cette source.

Vue 11 884 fois - Téléchargée 1 452 fois

Télécharger le projet
Commenter

Description

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, j'ai programmer ce Script qui simule tout ce que je viens de dire ci-dessus.Voila comme le titre l'indique "Authentification par votre clé USB personnelle: c'est comme Trouver la clé à sa serrure !"

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 !.

-Le Programme est 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 a mon script testé et approuvé sur une machine windows XP SP3.
Par contre sur Windows Vista et Seven je n'ai aucune idée si ce programme va marcher ou non et c'est a vous de le tester et a participer un peu pour le faire marcher dans ces derniers systèmes d'exploitations.

- J'ai ajouté l'agent de Microsoft Merlin le Magicien pour animer un peu le script Voila une Démonstration en vidéo http://www.swfcabin.com/swf-files/1285584982.swf

- voila le nouveau lien de téléchargement du script AUTHENTIFICATION-CLE-USB-MERLIN http://www.4shared.com/file/-xx-HIOI/AUTH-USB-MERLIN.html

Source / Exemple : 


'----------------------------------------INSTALL_AUTH_USB.vbs----------------------------------------------
 ' © Hackoo © 2010
 ' http://hackoo.ifrance.com
 ' 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-------------------------------------------

'---------------------------------Fonction Scramble--------------------------------------
'Thanks to the Author of this Function © AMBience
'C'est une Fonction de Cryptage trouvé dans ce lien:
'http://www.visualbasicscript.com/Tiny-text-encryption-m83948.aspx
' strText = String to encrypt\decrypt
' lngSeed = Long number for the random seed (key)
' Returns a string
' To Encrypt:- Send the plain text with a positive seed number (1-2147483647)
' To Decrypt:- Send the encrypted text with the same number but negative

Function Scramble (strText, lngSeed)
     Dim L,intRand,bytASC
     
     '---- Force seeded random mode 
     Rnd(-1)
     
     '---- Set (positive) seed 
     Randomize ABS(lngSeed)
     
     '---- Scan through string
     For L = 1 To Len(strText)
         
         '---- Get ASC of char
         bytASC=Asc(Mid(strText, L))
         
         '---- Fix for quotes (tilde to quote)
         If bytASC=126 then bytASC=34
         
         '---- Add a random value from -80 to 80, encode\decode is decided by the seed's sign
         intRand = bytASC + ((Int(Rnd(1) * 160) - 80) * SGN(lngSeed)) 
         
         '---- Cycle char between 32 and 125 (with carry)
         If intRand <= 31 Then 
             intRand = 125 - (31 - intRand)
         ElseIf intRand >= 126 Then
             intRand = 32 + (intRand - 126)
         End If
         
         '---- Fix for quotes (quote to tilde)
         If intRand=34 then intRand=126
         
         '---- Output string
         Scramble = Scramble & Chr(intRand)
     Next
 End Function
'-----------------------------------Fin de la Fonction Scramble--------------------------------------
 '---------------------------------------------------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"
 NumSerie = ABS(Int(NumSerie))
 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()
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
 '-----------------------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
  Numserie=ABS(INT(Numserie))
  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
  Set colItems = GetObject("winmgmts:root\cimv2").ExecQuery("Select ScreenHeight, ScreenWidth from Win32_DesktopMonitor Where ScreenHeight Is Not Null And ScreenWidth Is Not Null") 
     
    For Each objItem in colItems 
        intHorizontal = objItem.ScreenWidth
        intVertical = objItem.ScreenHeight
    Next 
   On error resume next
    Dim objExplorer : Set objExplorer = WScript.CreateObject("InternetExplorer.Application", "IE_")
    With objExplorer
        .Navigate "about:blank"  
        .ToolBar = 0
        '.Left = (intVertical+intHorizontal+700) / 2
        '.Top = (intVertical+intHorizontal+570) / 2
        .StatusBar = 0
        .Width = 380
        .Height = 240
        .Visible = 1   
        .Resizable = 0	
	.MenuBar = 0
        .Document.Title = "Setup Password Secours"
        Dim strHTML : strHTML = "<center><h3 style='color:Red'>Choisisez Votre Mot de Passe de Secours</h3>"
	strHTML = strHTML &"<body bgcolor='#FFFFD2' scroll='no'>"
        strHTML = strHTML & "<input type='password' name='txt_Password1' size='30'><br>"
	strHTML = strHTML & "<h3 style='color:Red'>Retapez Votre Mot de Passe de Secours</h3>"
	strHTML = strHTML & "<input type='password' name='txt_Password2' size='30'>"
        strHTML = strHTML & "<br><button style='font-family:Verdana;font-size:14px;height:30px;Width:100px;' id='btn_Exit' onclick=" & Chr(34)& "VBScript:me.Value='Fermeture...'" & Chr(34)& " title='Validation et sortir...'>Ok</button></body></center>"
       .Document.Body.InnerHTML = strHTML
    End With
    Do While (objExplorer.Document.All.btn_Exit.Value = "Ok")
        Wscript.Sleep 250
    Loop
	Password1=objExplorer.document.GetElementByID("txt_Password1").Value
	Password2=objExplorer.document.GetElementByID("txt_Password2").Value
	If Password1 = Password2 Then
    Password = objExplorer.document.GetElementByID("txt_Password2").Value
	PasswordCrypt = Scramble(Password,2010)
    
	MsgBox "Votre Mot de Passe Crypté est: " & PasswordCrypt ,64,"Mot de Passe Crypté"
	Msgbox "VOTRE MOT DE PASSE EN CLAIR 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 © !!"
	else
	MsgBox "Les Deux mots de passe ne sont pas identiques" ,16,"Mot de Passe Erroné !"
	end if
    If Password <>"" Then 
      VIDE=False
       Ws.RegWrite MDP, PasswordCrypt, itemtype
	 If Numserie <> "" then
        Ws.RegWrite SerialNumber,NumSerie
     END IF
   End if 
End if
    objExplorer.Quit
	Set objExplorer = Nothing

Wend
end Sub
Sub IE_onQuit()
Dim Com,Kill
'MsgBox "Vous avez choisi d'annler le programme !" ,48,"Mot de Passe Erroné !"
Set WS = CreateObject("WScript.Shell")
Com="taskkill /f /IM IEXPLORE.exe"
kill=Ws.Run(Com,0,True)
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=ABS(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
Set colItems = GetObject("winmgmts:root\cimv2").ExecQuery("Select ScreenHeight, ScreenWidth from Win32_DesktopMonitor Where ScreenHeight Is Not Null And ScreenWidth Is Not Null") 
     
    For Each objItem in colItems 
        intHorizontal = objItem.ScreenWidth
        intVertical = objItem.ScreenHeight
    Next 
 On error resume next  
    Dim objExplorer : Set objExplorer = WScript.CreateObject("InternetExplorer.Application", "IE_")
    With objExplorer
        .Navigate "about:blank"  
        .ToolBar = 0
        .Left = (intHorizontal-380) / 2
        .Top = (intVertical-250) / 2
        .StatusBar = 0
        .Width = 380
        .Height = 175
        .Visible = 1   
        .Resizable = 0	
	.MenuBar = 0
        .Document.Title = "MOT DE PASSE DE SECOURS"
        Dim strHTML : strHTML = "<center><body bgcolor='#000000' text='#Green' ><h3 style='color:Red'>Entrez Votre Mot de Passe de Secours</h3>"
        strHTML = strHTML & "<input type='password' name='txt_Password' size='30'>"
        strHTML = strHTML & "<br><button style='font-family:Verdana;font-size:14px;height:30px;Width:180px;' id='btn_Exit' onclick=" & Chr(34)& "VBScript:me.Value='Fermeture...'" & Chr(34)& " title='Validation...'>AUTHENTIFICATION</button></body></center>"
       .Document.Body.InnerHTML = strHTML
    End With
    Do While (objExplorer.Document.All.btn_Exit.Value = "AUTHENTIFICATION")
        Wscript.Sleep 250
    Loop
    Password = objExplorer.document.GetElementByID("txt_Password").Value
	PassowrdCrypt = Scramble(Password,2010)
    
	'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 © !!"
    'MsgBox "Votre Mot de Passe est: " & Password ,64,"Mot de Passe"
	objExplorer.Quit
	Set objExplorer = Nothing

If RegExists(SerialNumber) AND RegExists(MDP) Then
	 LireSerialNumber = ws.RegRead(SerialNumber)
	 LireMDP = ws.RegRead(MDP)
	 LireMDP = Scramble(LireMDP,-2010)
	 '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>"
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-------------
 '----------------------------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---------------------------------

Le Code Source de UNINSTALL_AUTH_USB.vbs :

'-------------------------------------UNINSTALL_AUTH_USB.vbs-------------------------------------------
'© Hackoo © 2010
'http://hackoo.ifrance.com
'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
 
 
'--------------------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()-----------

Conclusion :


-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
-j'ai ajouter aussi un script pour la désinstallation pour remettre tout en ordre
-Remarque: Assurez bien de ne pas modifiez le Nom du script INSTALL_AUTH_USB.vbs afin de garantir sa désinstallation par le 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 . Merci pour votre éventuelle contribution, et vos remarques et vos commentaires sont les bienvenues !
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
cc125
Messages postés
14
Date d'inscription
mardi 1 mai 2012
Statut
Membre
Dernière intervention
15 novembre 2013
 -
Bonjour, dans ton code je vois qu'il y a un moyen de récupérer le serial number d'une clé, mais je ne sais pas comment l'utiliser sur un autre programme =( merci de m'aider
Signaler
juliusII
Messages postés
4
Date d'inscription
samedi 27 février 2010
Statut
Membre
Dernière intervention
14 novembre 2014
 -
Bravo ça a l'air d'être du bon boulot ^^.
Peux-tu expliquer plus en détail comment tu t'y prends pour interrompre le démarrage de windows? Est-ce possible de l'utiliser si on a plusieurs sessions?


Sinon voici une fonction include permettant de diviser le code en plusieurs fichiers: taper include "nomfichier.extension" permet d'inclure toutes fonctions vbscript présentes dans le fichier "nomfichier.extension". ça peut être utile pour structurer les programmes en vbs bien que ton code sois bien structuré à l'aide de commentaires ;-)

Function GetPath()
Path=ScriptFullName
ix=InstrRev(Path,"")
Path=Left(Path,ix)
GetPath = Path
End Function
Sub Include(sInstFile)
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set f = oFSO.OpenTextFile(GetPath() & sInstFile)
dll = f.ReadAll
f.Close
ExecuteGlobal dll
End Sub
Signaler
MacGaliver
Messages postés
146
Date d'inscription
vendredi 28 mai 2010
Statut
Membre
Dernière intervention
21 juillet 2013
 3 -
Bon vbs, mais deux critiques:

-Un peu troué
-Qui dit clé perdu ou usée = t'est rapé sauf si on sait trouer le système.
Signaler
medjahedScript
Messages postés
14
Date d'inscription
mercredi 22 décembre 2010
Statut
Membre
Dernière intervention
7 mars 2011
 -
Salut,mon ami j'ai le retour,bon jouer avec ce script,mais je vous conseille à protéger le script qui lance la boite msg qui nous demande une AUTHENTIFICATION par un mot de passe.
la meilleur solution c'est la conversion du fichier vbs qui a l' extension .vbs par .exe il y a des soft qui faire la conversion du script vers un exécutable , donc l'utilasateur n a pas le pouvoir d'ouvrir la source du script ,aussi une autre faille la fenêtre exécuter,il nous permet d'ouvrir la base de registre et désactiver Enablestaskbar ,aussi nous pouvons arreter le script a partir du CMD "la command taskkill par exemple",donc il te faut de désactiver autant de clé,merci comme meme tu as enrechis nos connaissances,bon programmation
Signaler
cs_hackoo
Messages postés
94
Date d'inscription
mercredi 3 avril 2002
Statut
Membre
Dernière intervention
29 juillet 2013
 -
@Dean76
NB : On note et on commente juste sur la source elle-même et non la vidéo (^_^) j'ai ajouté le lien de la vidéo comme BONUS (Travail Personnel Supplémentaire) juste pour les personnes comme avinain qui ont un mal a le faire fonctionner ce script sur leurs systèmes d'exploitation et pour avoir une idée générale sur ce dernier ; alors j'ai envisager tous les cas possibles dans la vidéo que l'utilisateur peut les rencontrer; c'est pour ça la vidéo est un peu longue (^_^).

@avinain:
J'ai bien dis dans la description que "j'ai programmer et tester ce script sur un windows XP SP3; Par contre sur Windows Vista et Seven je n'ai aucune idée si ce programme va marcher ou non et c'est a vous de le tester et a participer un peu pour le faire marcher dans ces derniers systèmes d'exploitations."

Mais comme même la dernière fois,je l'ai tester sur VISTA et SEVEN et il a marcher NICKEL mais après avoir désactiver l'UAC : le UAC qui signifie User Access Control. Il s'agit d'une nouvelle couche de sécurité dont le rôle est de prévenir les utilisations non désirées de privilèges élevés, en Français Contrôle de compte utilisateur.

Les démarches a suivre pour faire fonctionner ce script sous Vista ou bien sous Seven :

-Si vous êtes sous Vista il faut une petite manipulation de la base de registre au niveau de cette clé :
"HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\EnableLUA" et changer sa valeur de 1 à 0
puis redémarrer la machine !

- Si vous êtes sous Seven alors vous avez deux manières :
la 1ère c'est comme sous Vista : "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\EnableLUA" et changer sa valeur de 1 à 0 puis redémarrer la machine !
la 2ème est manuellement càd : Panneau de configuration -> Comptes utilisateurs -> Modifier les paramètres de contrôle de compte utilisateur
Descendez le curseur au niveau le plus bas : ne jamais m'avertir.
pour plus d'information visitez cette page de FAQ : http://www.toutwindows.com/win7_uac.shtml#6
Afficher les 13 commentaires
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 (cs_hackoo)