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 |
programmer un script pour verrouiller clef USB
Répondre avec citation
Envoyé par MichelP
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 
alors si vous avez des soucis avec le copier coller ou bien du l'éditeur Notepad vous pouvez alors l'éditez sous
Partager