J'ai fait dernièrement un vbscript pour protéger un dossier particulier par mot de passe. Alors dés la 1ère exécution du script il vous demande de choisir un mot de passe qui va être crypté et stocké dans un fichier dans le dossier RacineUSB:\private et création d'un fichier lpt3.Dossier_protégé pour qu'il soit difficile à supprimer voir même impossible par l'explorateur windows.
Alors j'attends vos suggestions et vos conseils pour réaliser ce script et Merci à l'avance
Voila le code source Vbscript :
► Afficher le texte
Code : Tout sélectionner
Call checkUSB()
Titre="Protection du Dossier Private dans le Flash USB © Hackoo"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("Wscript.Shell")
Set dc = fso.Drives
For Each d in dc
If d.IsReady and d.DriveType = 1 Then
NumSerie=dc(d + "\").SerialNumber
RacineUSB = d.Driveletter
MsgBox "Votre Lecteur Flash est le " &RacineUSB&":\",64,Titre
MsgBox "La Clé Usb inséré a comme Num° de Série "&NumSerie,64,"Vérification Clé Usb © Hackoo"
'Titre=" Private Dossier © Hackoo © 2012 "
strDirectory = RacineUSB&":\Private"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Desktop = RacineUSB&":\Private\desktop.ini"
MDP = RacineUSB&":\Private\MDP.txt"
If objFSO.FileExists(Desktop) or objFSO.FileExists(MDP) Then
Call InputPassword
Else
Call Setup_Password()
end if
end if
Next
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!"
else
WshShell.Run "cmd /c @echo " & beep, 0
wscript.sleep 1000
MsgBox "Votre Clé USB Personnelle n'est pas Connectée !" &VbCrlf&_
"Veuillez SVP la brancher puis réexécuter ce VBScript de nouveau !"&VbCrlf&_
"Merci !",48,"Flash Drive Check © Hackoo !"
wscript.Quit
End If
End Sub
Sub WriteDesktopINI
Set objFSO = CreateObject("Scripting.FileSystemObject")
'strDirectory ="C:\Private"
strFile = "\desktop.ini"
strText = "[.ShellClassInfo]" & vbCrLf & "CLSID={21EC2020-3AEA-1069-A2DD-08002B30309D}"'"{645FF040-5081-101B-9F08-00AA002F954E}"<======>'clé systeme indiquant le dossier protègé est comme la Corbeille
'Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile,2,True)
objTextFile.WriteLine(strText)
objTextFile.Close
End Sub
Sub Hide()
Set WS = CreateObject("WScript.Shell")
com="cmd /c attrib +h +s "&strDirectory&""
com1="cmd /c type nul > \\?\"&strDirectory&"\lpt3.Dossier_protégé"
Result = Ws.Run(Com,0,True)
Result1 = Ws.Run(Com1,0,True)
End Sub
Sub Setup_Password()
Dim Ws,Password,MDP,LireMDP
Set Ws = CreateObject("Wscript.Shell")
'Set FSO = CreateObject("Scripting.FileSystemObject")
'strDirectory ="C:\Private"
If Not FSO.FolderExists(strDirectory) Then
FSO.CreateFolder (strDirectory)
end if
MDP = strDirectory&"\MDP.txt"
VIDE=True
While VIDE
If Password="" Then
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 = 370
.Height = 280
.Visible = 1
.Resizable = 0
.MenuBar = 0
'.ScrollBar = 0
.Document.Title = "Setup du Mot de Passe © Hackoo ******"
Dim strHTML : strHTML = "<center><h3 style='color:Red'>Choisissez Votre Mot de Passe</h3>"
strHTML = strHTML &"<body bgcolor='#FFFFD2' scroll='no'>"
strHTML = strHTML & "<input type='password' name='txt_Password1' size='30'>"
strHTML = strHTML & "<h3 style='color:Red'>Retapez Votre Mot de Passe</h3>"
strHTML = strHTML & "<input type='password' name='txt_Password2' size='30'><br>"
strHTML = strHTML & "<br><button type='submit' style='font-familc:\privateVerdana;font-size:14px;height:30px;Width:180px;' id='btn_Exit' onclick=" & Chr(34)& "VBScript:me.Value='Enregistrement....'" & Chr(34)& " title='Enregistrement....'>Envoyer</button></body></center>"
.Document.Body.InnerHTML = strHTML
.Document.Body.Style.overflow = "auto"
.Document.body.style.backgroundcolor="lightblue"
End With
Do While (objExplorer.Document.All.btn_Exit.Value = "Envoyer")
Wscript.Sleep 250
Loop
Password1=objExplorer.document.GetElementByID("txt_Password1").Value
Password2=objExplorer.document.GetElementByID("txt_Password2").Value
If Password1 = Password2 and Password1 = "" Then
MsgBox "Le mot passe choisi est vide !"& vbcr &_
"Veuillez SVP Choisir un Mot de Passe non vide "& vbcr &_
"Merci !"& vbcr & vbcr &_
"The password chosen is empty !"& vbcr &_
"Please choose a password is not empty "& vbcr &_
"Thanks !",48,"Mot de Passe vide © Hackoo ******************"
end if
If Password1 = Password2 and Password1 <> "" Then
Password = objExplorer.document.GetElementByID("txt_Password2").Value
PasswordCrypt = Scramble(Password,2012)
Set objTextFile = FSO.OpenTextFile(MDP,2,True)
objTextFile.WriteLine(passwordCrypt)
objTextFile.Close
Call AutoCopy2Flash
MsgBox "Votre Mot de Passe Crypté est: " & PasswordCrypt & vbcr&_
"Encrypted Password is: "& 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 DOSSIER Private !" &vbcr&vbcr&_
"YOUR PASSWORD IS IN CLEAR ""{"& Password &"}"" SAVE IT IN A GOOD PLACE ! THIS IS THE ONLY WAY TO UNLOCK THE FILE Private !",64,"MOT DE PASSE INSTALLE Hackoo © 2012 !"
else
MsgBox "Les deux mots de passe ne sont pas identiques !" & vbcr & vbcr &_
"The two passwords do not match !",16,"Mot de Passe Erroné © Hackoo ****************"
end if
If Password <>"" Then
VIDE=False
Call WriteDesktopINI
Call Hide()
Call Autorun()
Call AutoCopy2Flash()
MsgBox "Le Dossier Private est désormais créé et protégé avec succès ! et vous pouvez copier vos dossiers et vos fichiers dans ce dernier pour les protéger !"& vbcr & vbcr &_
"Folder Private Created and Protected Sucessfully ! and of course you can copy your folders and files in it to protect them !",64,Titre
End if
End if
objExplorer.Quit
Set objExplorer = Nothing
Wend
Call InputPassword()
end sub
'--------------------------------InputPassword-------------------------
Sub InputPassword()
Const ForWriting = 2
Const ForAppending = 8
Dim Ws,Password,MDP,itemtype,LireMDP
Titre=" Private Dossier © Hackoo © 2012 "
Set Ws = CreateObject("Wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
MDP = strDirectory&"\MDP.txt"
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-300) / 2
.Top = (intVertical-300) / 2
.StatusBar = 0
.Width = 320
.Height = 190
.Visible = 1
.Resizable = 0
.MenuBar = 0
'.ScrollBar = 0
.Document.Title = "Mot de Passe © Hackoo ************** "
Dim strHTML : strHTML = "<center><h3 style='color:Red'>Entrez Votre Mot de Passe</h3>"
strHTML = strHTML &"<body bgcolor='#FFFFD2' scroll='no'>"
strHTML = strHTML & "<input type='password' name='txt_Password' size='30'><br>"
strHTML = strHTML & "<br><button type='submit' style='font-familc:\privateVerdana;font-size:14px;height:30px;Width:180px;' id='btn_Exit' onclick=" & Chr(34)& "VBScript:me.Value='AUTENTIFICATION...'" & Chr(34)& " title='Vérifier le mot de passe...'>Envoyer</button></body></center>"
.Document.Body.InnerHTML = strHTML
.Document.Body.Style.overflow = "auto"
.Document.body.style.backgroundcolor="lightblue"
End With
Do While (objExplorer.Document.All.btn_Exit.Value = "Envoyer")
Wscript.Sleep 250
Loop
Password = objExplorer.document.GetElementByID("txt_Password").Value
Set objTextFile = FSO.OpenTextFile(MDP,1,True)
LireMDP = objTextFile.ReadLine
objTextFile.Close
objExplorer.Quit
Set objExplorer = Nothing
If FSO.FileExists(MDP) Then
LireMDP = Scramble(LireMDP,-2012)
If Password = LireMDP then
Question = MsgBox ("Voulez-vous accéder à votre Dossier protégé ? " &vbcr &_
"Do you want to access your protected folder ?",VBYesNO+VbQuestion,Titre)
If Question = VbYes then
Call Delete_Desktop()
Explorer(strDirectory)
else
Call WriteDesktopINI
Call Hide()
Call Autorun()
Call AutoCopy2Flash
end if
else
Call WriteDesktopINI
Call Hide()
Call Autorun()
Call AutoCopy2Flash
Msgbox "MOT DE PASSE INCORRECT ET PERMISSION REFUSEE D'ACCEDER A CE DOSSIER !" & vbCr & vbCr &_
"PASSWORD INCORRECT AND PERMISSION DENIED TO ACCESS TO THIS FOLDER !",16,"MOT DE PASSE INCORRECT Hackoo © 2012 !"
end if
end if
end sub
'--------------------Fin du InputPassword-------------
Function Explorer(Dir)
Set ws=CreateObject("wscript.shell")
ws.run "Explorer.exe "& Dir & "\"
end Function
Sub Delete_Desktop()
Set objFSO = CreateObject("Scripting.FileSystemObject")
desktop = strDirectory&"\desktop.ini"
If objFSO.FileExists(desktop) Then
objFSO.DeleteFile desktop, True
end if
end sub
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
Sub AutoRun()
NomScript = WScript.ScriptName
Set auto = fso.CreateTextFile(RacineUSB&":\AutoRun.inf", True)
auto.Write "[autorun]"& vbcrlf & "shellexecute=wscript.exe "& NomScript & vbcrlf & "shell\open=Ouvrir"
auto.Write vbcrlf & "shell\Open\Command= wscript "& NomScript & vbCrLf & "shell\open\Default=1" & vbcrlf & "shell\explore=Explorer" & vbcrlf & "shell\explore\Command= wscript "& NomScript
auto.Close
Set tf1=fso.getfile(RacineUSB&":\AutoRun.inf")
tf1.Attributes = 32
End Sub
Sub AutoCopy2Flash
Monscript = WScript.ScriptFullName
cible = RacineUSB &":\"
if (not fso.fileexists(cible & Monscript)) then
fso.copyfile Monscript ,cible, True
end if
End sub
