Accueil > > > AUTHENTIFICATION PAR VOTRE CLE USB PERSONNELLE
AUTHENTIFICATION PAR VOTRE CLE USB PERSONNELLE
Information sur la source
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.
Source
- '----------------------------------------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()-----------
'----------------------------------------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 !
Historique
- 01 août 2010 11:36:43 :
- Copier/Coller des Codes Sources INSTALL_AUTH_USB.vbs et UNINSTALL_AUTH_USB.vbs
- 09 août 2010 16:32:34 :
- - Ajout d'une Fonction de Cryptage de Mot de passe qui va être sauvegarder dans la base de registre.
- Remplacement de la Fonction InputBox pour l'installation et la récupération du mot de passe par une Boîte de dialogue généré dynamiquement par une page HTML.
- 10 août 2010 19:21:25 :
- Mise à jour du Zip
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Peut-on cracker une authentification username/password ? [ par Natanyanka ]
Voilà, je suis nouvelle sur ce forum et j'aurais bien aimé savoir s'il était possible de rentrer dans un site dit sécurisé pour lequel on doit normale
sécurité base de registre [ par makli5 ]
Salut Es possible d'ajouté des droits sur la base de registre avec un scripte vbs par exemple HKLM/system/CurrentControlSet/ (clique droite autorisa
Login/Password VBA [ par sofmartel ]
Bonjour, je suis sur un projet VBA Excel j'ai creer un userform d'authentification. on doit entrer un login et un mot de passe et il y a un bouton ok
Registre/Password [ par diiplayer ]
Salut, j'sais que windows stock les passwords et els nom d'utilisateur dans le registre, et j'aimerais savoir s'il n'y a pas quelqu'un qui serait au c
password sur une clé USB ..... HELP PLEASE ! [ par xzonz ]
salut à toutes et à tousvoila .... j'ai une clé usb 256 Mo tout à fait classiqueet j'aimerais la proteger ....à savoir:quand
Base de registre ou ini????? [ par Youpien ]
Salut,bon je programme pas depuis longtemps en VB, mais je me posais une question :Je suis en train de faire une application assez grosse en ressource
port USB [ par nari ]
Bonjour à tous! Je n' arrive pas à trouver des docs sur le port USB alors qu'il faut que j' utilise ce port pour la sortie d' un petit progr de reconn
Piloter Excel pour modif des options de sécurité [ par eldim ]
Bonjour à tous !Comment peut-on faire pour cocher l'option suivante par programmation (vb ou vb.net peu importe)* "Faire confiance au proje
Lire dans la base de registre via une BDD Access 2002 [ par Asaiel ]
Bonjour, Une petite question toute bete, je souhaite lire une valeur du registre dans mon appli ACCESS. J'utilise le code suivant: Private Sub Form_
Access 2002 et base de registre [ par Asaiel ]
Bonjour, Une petite question toute bete, je souhaite lire une valeur du registre dans mon appli ACCESS 2002. J'utilise le code suivant: Dim key As
|
Derniers Blogs
[WP7] UTILISER UN WRAPPANEL DANS UNE APPLICATION WINDOWS PHONE 7[WP7] UTILISER UN WRAPPANEL DANS UNE APPLICATION WINDOWS PHONE 7 par Audrey
Lors de la réalisation de ma 2ème application Windows Phone 7, j'ai souhaité utiliser un WrapPanel pour afficher plusieurs photos. Mais le contrôle WrapPanel ne fait pas parti de la liste des contrôles inclus dans le SDK de la version Beta des outils pour...
Cliquez pour lire la suite de l'article par Audrey [WP7] BESOIN D'AVOIR DES DONNéES EN CACHE[WP7] BESOIN D'AVOIR DES DONNéES EN CACHE par Nicolas
Les développeurs ASP.NET ont l'habitude de mettre des données en cache pour éviter de requêter a chaque fois la base de données. Et il est toujours utilie de penser que vos utilisateurs mobiles n'ont pas troujours une super connexion 3G/WIFI et un for...
Cliquez pour lire la suite de l'article par Nicolas [TFS] COMMENT FORCER LA SAISIE D'UN AREA OU ITERATION[TFS] COMMENT FORCER LA SAISIE D'UN AREA OU ITERATION par cyril
Lorsque l'on créé un Work Item dans TFS, il est possible de le classer dans un "area" et dans une "iteration". Dans la plupart des types de projet, un "area" correspond à une catégorie, une "iteration" à un numéro de version. Il est possible de cré...
Cliquez pour lire la suite de l'article par cyril SQL : FONCTIONS D'AGRéGATION MIN/MAX ET VALEURS NULLSQL : FONCTIONS D'AGRéGATION MIN/MAX ET VALEURS NULL par coq
Les fonctions d'agrégation comme MIN et MAX ignorent les valeurs NULL présentes dans le jeu de données sur lequel porte leur calcul, d'où le fameux message d'avertissement : Warning: Null value is eliminated by an aggregate or other SET operation...
Cliquez pour lire la suite de l'article par coq VOTEZ POUR WARNYGOVOTEZ POUR WARNYGO par Nicolas
La vidéo du projet Warnygo est disponible sur facebook et attend vos votes ! Pour rappel: Warnygo est une application Windows Phone 7 qui permet d'alerter tous utilisateurs inscrits qui se trouve dans la zone où se passe l'...
Cliquez pour lire la suite de l'article par Nicolas
Logiciels
sDEVIS-FACTURES vlPRO (3.8.0)SDEVIS-FACTURES VLPRO (3.8.0)sDEVIS-FACTURES vlPRO a été mis au point pour permettre besoins des particuliers, créateurs, entr... Cliquez pour télécharger sDEVIS-FACTURES vlPRO LettresFaciles (5.6.0)LETTRESFACILES (5.6.0)LettresFaciles est un logiciel facilitant la création et la rédaction de lettres types.
Son inte... Cliquez pour télécharger LettresFaciles MyPlanning 2010 (5.6.0)MYPLANNING 2010 (5.6.0)MyPlanning 2010 permet de créer des plannings sous la représentation de diagrammes. Plannings pré... Cliquez pour télécharger MyPlanning 2010 Emicsoft Mac DVD en iPad Convertisseur (3.1.16)EMICSOFT MAC DVD EN IPAD CONVERTISSEUR (3.1.16)Emicsoft Mac DVD en iPad Convertisseur, logiciel professionnel de convertir les fichiers DVD en i... Cliquez pour télécharger Emicsoft Mac DVD en iPad Convertisseur Emicsoft ipad ménager pour mac (3.1.08)EMICSOFT IPAD MéNAGER POUR MAC (3.1.08)Emicsoft ipad ménager pour mac est spécialement conçu pour les utilisateurs Mac pour copier des f... Cliquez pour télécharger Emicsoft ipad ménager pour mac
|