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
| Set w=CreateObject("WScript.Shell")
Set ObjFso = CreateObject("Scripting.FileSystemObject")
pathl = Len(WScript.ScriptFullName) - Len(WScript.ScriptName)
Scriptpath = Mid(WScript.ScriptFullName, 1, pathl)
DirF = ScriptPath & "Dir.txt"
IF ObjFso.FileExists(DirF) Then
ObjFso.DeleteFile(DirF)
End If
S=B("Choisissez un dossier")
If IsNull(S) Then
MsgBox "Sélection invalide"
Else
go=w.run("cmd.exe /c dir """ & S & "\*."" /-B /AD > """ & DirF & """", 0, true)
Set tso = ObjFso.OpenTextFile(DirF,1)
while not tso.AtEndOfStream
StrTemp = tso.readline
VVal0 = InStrRev(StrTemp, "\")
NomUsr = Mid(StrTemp, VVal0 + 1, Len(StrTemp) - VVal0)
Commande = "Net Share " & Chr(34) & S & "\" & NomUsr & Chr(34) & "=" & StrTemp
go=w.run(Commande)
Commande = "Cacls " & Chr(34) & S & "\" & StrTemp & Chr(34) &" /t /c /g " & NomUsr & ":c"
go=w.run(Commande)
Wend
tso.close
End If
IF ObjFso.FileExists(DirF) Then
ObjFso.DeleteFile(DirF)
End If
Function B(Msg)
On Error Resume Next
Dim a,f,i,w
Set a=WScript.CreateObject("Shell.Application")
Set f=a.BrowseForFolder(&H0&,Msg,&h1&)
B=f.ParentFolder.ParseName(f.Title).Path
If Err.Number<>0 Then
B=Null
If f.Title="Desktop" Then B=w.SpecialFolders("Desktop")
i=InStr(f.Title, ":")
If i>0 Then B=Mid(f.Title,i-1,2) & "\"
End If
End Function |
