programmer un script pour verrouiller clef USB

Version imprimable

09/03/2012, 12h10
MichelP

programmer un script pour verrouiller clef USB

Je voudrai programmer script pour verrouiller par mot de passe clef ma USB afin de protéger mes données en cas de vol ou perte de ma clef. J'ai trouvé un excellent fichier .bat que j'ai converti en .exe pour cacher me mot de passe facilement accessible sur le ficher .bat.
Mais ce fichier .bat est obsolète et avec VDS on peut avoir les fenêtres pour saisir le mot de passe etc.. Plus moderne que le vieux DOS...
Qui peut m'aider à construire ce petit programme ?
Ci-joint fichier .bat dont le mot de passe est : AbCd1085
09/03/2012, 13h18
Cachlab

Salut ! Je ne vois pas de fichier joint ...
Peux-tu nous copier/coller le code de ton fichier .bat ?
09/03/2012, 13h21
hackoofr

Citation:

Envoyé par MichelP

Je voudrai programmer script pour verrouiller par mot de passe clef ma USB afin de protéger mes données en cas de vol ou perte de ma clef. J'ai trouvé un excellent fichier .bat que j'ai converti en .exe pour cacher me mot de passe facilement accessible sur le ficher .bat.
Mais ce fichier .bat est obsolète et avec VDS on peut avoir les fenêtres pour saisir le mot de passe etc.. Plus moderne que le vieux DOS...
Qui peut m'aider à construire ce petit programme ?
Ci-joint fichier .bat dont le mot de passe est : AbCd1085

:salut:
copier coller la source du fichier .bat et :tagcode:
:merci:

Mille excuse : voici le code du fichier Batch.
(le mot de passe est : AbCd1085

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
@ECHO OFF 
title Folder Private 
if EXIST "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}" goto UNLOCK 
if NOT EXIST Private goto MDLOCKER 
:CONFIRM 
echo Etes vous sure de vouloir bloquer les fichiers Y=Oui N=Non(Y/N) 
set/p "cho=>" 
if %cho%==Y goto LOCK 
if %cho%==y goto LOCK 
if %cho%==n goto END 
if %cho%==N goto END 
echo Invalid choice. 
goto CONFIRM 
:LOCK 
ren Private "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}" 
attrib +h +s "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}" 
echo Folder locked 
goto End 
:UNLOCK 
echo Saisissez votre mot de passe 
set/p "pass=>" 
if NOT %pass%== AbCd1085 goto FAIL 
attrib -h -s "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}" 
ren "Control Panel.{21EC2020-3AEA-1069-A2DD-08002B30309D}" Private 
echo Bien Bloquer GG 
goto End 
:FAIL 
echo Mot de passe incorrect 
goto end 
:MDLOCKER 
md Private 
echo Private created successfully 
goto End 
:End

10/03/2012, 11h10
MichelP

Verrouillage clé USB en VBs

S'il y a un silence c'est que mes amis correspondants planchent sur leur codes !....
En fait c'est un sujet qui a déjà été traité mais jamais en VBS. Il y a bien des logiciels en free mais aucun ne me conviennent.:ccool:
A bientôt et bon week-end.
MP

Code à tester !

Citation:

Envoyé par MichelP

S'il y a un silence c'est que mes amis correspondants planchent sur leur codes !....

:salut:
Eh bien oui vous avez raison j'ai passé une bonne après-midi pour coder ce script et avec des tests sur un Windows XP Pro SP2 :mouarf: mais Attention ce n'est pas exactement ce que vous souhaitez, càd verrouillage d'une clé USB; c'est juste une petite traduction de votre Batch avec quelques améliorations pour la sécurité exemple vous pouvez choisir dés la 1ère exécution du script un mot de passe qui va être crypté et stocké dans un fichier de votre dossier c:\private et création d'un fichier lp3.Dossier_protégé pour qu'il soit difficile à supprimer voir même impossible par l'explorateur windows :zoubi: :ccool:
Bon j'attends de vous et de nos chers membres des tests et des suggestions sur d'autres plateformes comme Vista et Seven , afin de le poster dans la section téléchargement ;) :ccool:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
Titre=" Private Dossier © Hackoo © 2012 "
strDirectory ="C:\Private"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Desktop = "C:\Private\desktop.ini"
MDP = "C:\Private\MDP.txt"
 If objFSO.FileExists(Desktop) or objFSO.FileExists(MDP) Then
 Call InputPassword
 Else
 Call Setup_Password()
end if
 
 
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 = "c:\Private\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
 
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()
 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 = "c:\Private\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("c:\private")
     else
       Call WriteDesktopINI
       Call Hide()
 end if
else
       Call WriteDesktopINI
       Call Hide()
   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 ="c:\Private\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

11/03/2012, 17h22
MichelP

Verrouillage clef USB sous VBScript

Bravo, quel professionnalisme, un code propre et parfait : rien à dire c'est une super mécanique.. Au fait comment faire pour surprimer c:\private ?
Cependant, j'aimerai qu'un exécutable .exe soit placé à la racine de toutes les clefs USB en ma possession. En exécutant ce fichier, il verrouille ou dévérouille toute la clé ou bien un folder par un mot de passe.
C'est le résultat que j'obtiens avec le petit fichier .bat : mais je le trouve un peu ringard et je ne suis pas sur qu'avec window7 et + il fonctionnera.
A bientôt
11/03/2012, 18h42
hackoofr

Citation:

Envoyé par MichelP

Au fait comment faire pour surpprimer c:\private ?

:salut:
Pour supprimer c:\private il faut utiliser la ligne de commande :mouarf: et non pas l'explorateur windows.
si vous n'arrivez toujours pas à supprimer ce dossier :arf: juste fais-moi signe et je vous coderai un script pour la désinstallation du mot de passe et du dossier c:\private en question :pc:

Code à tester sur flash USB

:salut:
voila vous pouvez tester ce code modifié pour votre USB mais il n'est pas très propre donc juste pour le test :mouarf:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
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

13/03/2012, 19h57
MichelP

C'est quel type de fichier ?

C'est un fichier .vbs ?
Comment l'installer ? c'est pourtant le même type que votre 1er listing ?

Citation:

Envoyé par MichelP

C'est un fichier .vbs ?
Comment l'installer ? c'est pourtant le même type que votre 1er listing ?

il s'installe tout seul juste vous branchez votre clé USB puis vous exécutez ce script; il vous demande alors dés la 1ère exécution de choisir un mot de passe comme dans le script précédent et au lieu de créer un c:\private , il crée un dossier comme ceci RacineUSB:\Private tout en copiant lui-même a la racine du flash disque avec création d'un fichier Autorun.inf :ccool:
Code:

1 2 3 4 5 6 7 [autorun] shellexecute=wscript.exe usb-protection.vbs shell\open=Ouvrir shell\Open\Command= wscript usb-protection.vbs shell\open\Default=1 shell\explore=Explorer shell\explore\Command= wscript usb-protection.vbs

13/03/2012, 21h19
MichelP

Fichier VBS ?

Je n'arrive pas à sauvegarder le script dans notePad en fichier .vbs??
:cry:
Merci
13/03/2012, 21h28
hackoofr

Citation:

Envoyé par MichelP

Je n'arrive pas à sauvegarder le script dans notePad en fichier .vbs??
:cry:
Merci

c'est quoi exactement le problème :koi: alors si vous avez des soucis avec le copier coller ou bien du l'éditeur Notepad vous pouvez alors l'éditez sous Vbsedit

c'est quoi le problème ?

En fait j'arrive parfaitement à sauvegarder votre premier code que vous avez écrit en fichier xxxx.vbs. J'utilise pour cela NotePad de Microsoft ou Notepad++ et Wbsedit.
Cependant je n'arrive pas à faire cette même opération avec votre 2ème code qui commence par :
Code:

1 2 3 4 5 6 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 '........... etc
Le fichier se sauvegarde quelques secondes, puis disparaît...
Notepad, notepad++ et Wbsedit ne reconnaissent pas l'algorythme.

Citation:
Envoyé par MichelP
En fait j'arrive parfaitement à sauvegarder votre premier code que vous avez écrit en fichier xxxx.vbs. J'utilise pour cela NotePad de Microsoft ou Notepad++ et Wbsedit.
Cependant je n'arrive pas à faire cette même opération avec votre 2ème code qui commence par :
Code:

1 2 3 4 5 6 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 '........... etc
Le fichier se sauvegarde quelques secondes, puis disparaît...
Notepad, notepad++ et Wbsedit ne reconnaissent pas l'algorythme.
:salut:
peut-être à cause de la création du fichier Autorun.inf dans le flash disque qui a été bloqué par votre Antivirus; Donc il faut le désactiver temporairement puis vous exécuter ce script de nouveau ;)

26/03/2012, 22h26
MichelP

Clé USB sécurisée

Bon tant pis, je reste sur ma faim....
Comme dis le poète ; un jour je trouverai la solution...:(
26/03/2012, 22h48
hackoofr

Citation:

Envoyé par MichelP

Bon tant pis, je reste sur ma faim....
Comme dis le poète ; un jour je trouverai la solution...:(

Dommage que tu abandonne aussi facilement :ouin: :bug:
Mais moi je dis la chose suivante quand tu trouvera la solution , alors tu nous la partagera aussi rapidement que possible et ceci pour rendre hommage à tous les membres qui ont participé a t'aider du près ou du loin ;)
Bonne Continuation :lahola:
28/03/2012, 10h16
hackoofr

TCScript pour TrueCrypt

:salut:
J'ai trouvé ce VBscript : TCScript

Citation:

qui permet de monter automatiquement tous les volumes TrueCrypt ou des partitions que vous spécifiez à l'intérieur du script en un seul coup.
Ce script affiche une fenêtre Internet Explorer pour chaque volume TrueCrypt / partition que vous voulez monter et vous invite pour le mot de passe (Le mot de passe n'est pas mis en cache ou enregistrées). Si vous voulez monter un volume TrueCrypt, il peut être situé n'importe où sur votre ordinateur aussi longtemps que vous avez des privilèges d'administrateur et l'accès en écriture à lui. Vous pouvez également monter automatiquement une partition TrueCrypt. Une fois que vous montez le volume TrueCrypt / partition, vous pouvez spécifier un programme que vous souhaitez exécuter à partir du volume TrueCrypt / partition.
NB:traduit par google

Téléchargement du script Complet avec Autorun.inf