Const CheminDefault = "\\#SE3#\netlogon" Const FileDefaultLog = "C:\netinst\logs\logsregistrese3.txt" Const Chemindefaultclientlog = "C:\netinst\logs" Const Chemindefaultclient= "C:\netinst" Const Domain = "#DOMAIN#" Dim result,test,log Dim fonction Dim ret, testos Dim Wsh Dim ligne() Dim LireKey Dim chemin,cleverif Dim sArg, RegEx Dim fichier Const ForReading = 1, ForWriting = 2, ForAppending = 8 Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0 Dim fso, f, ts Const HKEY_USERS = &H80000003 Dim genre1, genre2, genre3, genre4, genre5, verif3 , verif2 Set sArg = WScript.Arguments Set Wsh = CreateObject("Wscript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") groupe = sArg(0) 'Lecture de l'argument If sArg.Count <> 1 Then MsgBox "Veuillez passer en paramètre le nom de l'utilisateur ." WScript.Quit End If log="" On Error Resume Next oUser = Wsh.ExpandEnvironmentStrings("%USERNAME%") oDomain = Wsh.ExpandEnvironmentStrings("%USERDOMAIN%") 'Lecture du chemin et de l'os KeyVer = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ProductName" PN = Wsh.RegRead(KeyVer) Err.Clear If PN = "" Then KeyVer = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName" PN = Wsh.RegRead(KeyVer) Err.Clear End If If PN = "" Then PN = "Microsoft Windows 98" End if 'cle du chemin vide ? ' CleReg = "HKEY_LOCAL_MACHINE\Software\Policies\Restrictions\Chemin" ' LireKey = Wsh.RegRead(CleReg) ' If LireKey = "" Then 'MsgBox "Il est impossible d'accéder aux informations de restriction (cle manquante)" ' LireKey = CheminDefault ' End If ' Err.clear 'cle de log vide ? 'CleLog = "HKEY_LOCAL_MACHINE\Software\Policies\Restrictions\CheminLog" 'LireKeyLog = Wsh.RegRead(CleLog) 'If LireKeyLog = "" Then ' LireKeyLog = CheminDefaultLog ' Err.clear 'End If 'ouverture et creation du fichier de log si necessaire 'cheminlog=Cstr(LireKeyLog) Err.clear 'Action en fonction de l'os If (PN = "Microsoft Windows 2000") Then testos = "2K" End If If (PN = "Microsoft Windows XP") Then testos = "XP" End If If (PN = "Microsoft Windows 98") Then testos = "98" End If If (PN = "Microsoft Windows Millenium") Then testos = "Me" End If If (PN = "Microsoft Windows NT") Then testos = "NT" End If If (PN = "Microsoft Windows 95") Then testos = "95" End If 'definition du chemin if (testos<>"XP")or (testos<>"2K") or (testos<>"NT") then oUser = groupe end if log = log & "VBS 1:" & now & "Login utilisateur: " & oUser & Chr(13)+Chr(10) chemin = CheminDefault & "\" & oUser & ".txt" chemin1= Cstr(chemin) 'logfile.writeline "VBS 2:" & chemin 'Test de la présence du fichier If Not fso.FileExists(chemin) Then log = log & "VBS 3:" & "Le fichier cherché n'est pas présent" & chemin Set fso = Nothing Set Wsh = Nothing WScript.Quit End If log = log & "VBS 4: OS détecté : " & PN & Chr(13)+ Chr(10) if ((groupe<>oUser) and (testos="XP" or testos="2K" or testos="NT")) then log = log & "Tentative d'acces au jeux d'autorisations de: " & groupe & Chr(13)+Chr(10) Wscript.quit end if if testos="XP" or testos="2K" or testos="NT" then Set objUserAccount = GetObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_UserAccount.Domain=""" & oDomain & """,Name=""" & oUser & """") If Err = 0 Then SID=objUserAccount.SID End If End if 'lecture du fichier Err.Clear Set f = fso.GetFile(chemin) Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault) Do While ts.AtEndOfStream <> True Err.clear ' MsgBox TextStreamTest,vbOkOnly + vbApplicationModal + 0,"lecture" increment = 0 TextStreamTest = ts.ReadLine 'Message en cas de rem ou REM ou # testtxte= TextStreamTest verif= InStr(Cstr(testtxte) , "@@@") If (verif = 0) Then log = log & "VBS 6:"& TextStreamTest & Chr(13)+Chr(10) else texteligne = TextStreamTest log = log & "VBS 6bis:"& TextStreamTest aligne = Split(texteligne, "@@@") 'cas XP ou tous ou type XP if ((testos="NT") or (testos="2K") or (testos="XP")) then increment = increment + 1 test=CasXP(Cstr(TextStreamTest),Cstr(testos),Cstr(SID),Cstr(groupe)) log = log & test & err.description & Chr(13)+Chr(10) end if err.clear 'OS type 98 ou 95 if ((testos="98") or (testos="ME") or (testos="95")) then increment = increment + 1 test= Reg(Cstr(TextStreamTest)) log = log & test & err.description & Chr(13)+Chr(10) end if err.clear if increment=0 then log = log & "Pas d'action effectuée ?" & Chr(13)+Chr(10) end if 'logfile.writeline increment & Chr(13)+Chr(10) 'if ((trim(aligne(0))="Type9x" or trim(aligne(0))="TOUS") and increment=0) then ' test= Reg(Cstr(TextStreamTest)) ' logfile.writeline "VBS 7: " & test & err.description ' increment = increment + 1 'end if 'err.clear 'if (testos=trim(aligne(0)) and increment=0) then ' test= "VBS 8bis: " & Reg(Cstr(TextStreamTest)) ' logfile.writeline "VBS 8: " & test & err.description 'end if End if 'fin de lecture du fichier err.clear Loop semaine_precedente = DateAdd("d", -7, now) ts.close 'MsgBox "test" if fso.FolderExists(Chemindefaultclient) then if fso.FolderExists(Chemindefaultclientlog) then if (fso.Fileexists(FileDefaultLog)) then Set infofile=fso.Getfile(FileDefaultLog) if infofile.DateCreated => semaine_precedente then set logfile = fso.OpenTextFile(FileDefaultLog,ForWriting,true) ' Msgbox "fichier ouvert mais ecrasé" logfile.write log logfile.close else set logfile = fso.OpenTextFile(FileDefaultLog,ForAppending,false) ' Msgbox "fichier ouvert pas ecrasé" logfile.write log logfile.close end if else set logfile = fso.CreateTextFile(FileDefaultLog,ForAppending,false) ' Msgbox "fichier créé" logfile.write log logfile.close end if end if end if 'MsgBox err.description & log Set fso = Nothing Set Wsh = Nothing WScript.Quit 'fonction d'action sur les os type 9x Function Reg(texteligne) Dim result aligne = Split(texteligne, "@@@") if ((trim(aligne(0))="98") or (trim(aligne(0))="Type9x") or (trim(aligne(0))="95") or(trim(aligne(0))="ME") or (trim(aligne(0))="TOUS")) then If (Trim(aligne(1)) = "ADD") Then ajoutcle = AddReg(Trim(aligne(2)), Trim(aligne(3)), Trim(aligne(4))) result = result & "VBS 13: " & ajoutcle & err.description End If If (Trim(aligne(1)) = "DEL") Then delkey = DelReg(Trim(aligne(2))) result = result & "VBS 14: " & delkey & err.description End If result = result & Chr(13)+Chr(10) Reg = result end if end function Function Adddll(groupe,texteligne,SID) Dim cleverif,result Dim objet cleverif = "HKEY_USERS\" & SID & "\Identities\username" ajoutcle= AddReg(cleverif,groupe,"REG_SZ") Err.clear Set objet = CreateObject("Restrict.Reg") resultdll = objet.Restrict(Cstr(trim(groupe)),Cstr(texteligne),Cstr(SID)) result = "DLL 0:" & resultdll & Err.description & Chr(13)+Chr(10) Set objet = nothing adddll = result end function function CasXP(texteligne,testos,SID,groupe) 'Dim aligne() Dim Wsh,TextStreamTest Dim RegEx,result Set Wsh = CreateObject("Wscript.Shell") TextStreamTest = texteligne aligne = Split(Cstr(texteligne),"@@@") if (trim(aligne(0)) = "TOUS" or trim(aligne(0)) = "TypeXP" or trim(aligne(0))=testos) then ' texteligneok = TextStreamTest cle = Trim(aligne(2)) cle1 = cle verif3 = InStr(cle1 , "EY_CURRENT_USER") ' verif2 = InStr(cle , "olicies") result = "VBS 23" if ((verif3>0) AND (SID<>"")) then 'verif de policies et de hkcu result = result & "VBS 24" Set RegEx = New RegExp RegEx.Pattern = "HKEY_CURRENT_USER" RegEx.IgnoreCase = True newreg = "HKEY_USERS\" & Cstr(SID) ReplaceTest = RegEx.Replace(TextStreamTest, newreg) result = result & "VBS 25" TextStreamTestnew = trim(ReplaceTest) '& trim(ReplaceTest) end if ' if (verif2<>0) then 'verif de policies result = result & "VBS 9 " cleverif = "HKEY_USERS\" & SID & "\Identities\username" ajoutcle=AddReg(cleverif,groupe,"REG_SZ") Err.clear ' Set objet = CreateObject("Restrict.Reg") 'resultdll = objet.Restrict(Cstr(trim(groupe)),Cstr(TextStreamTestnew),Cstr(SID)) resultdll=Adddll(Cstr(trim(groupe)),Cstr(TextStreamTestnew),Cstr(SID)) result = result & "Cas XP 10: Adddll" & TextStreamTestnew & resultdll & Err.description Set objet = nothing ' else ' test= Reg(TextStreamTest) ' result = result & "VBS 11" & test & err.description ' end if end if CasXP = result end function 'fonction d'ajout de cle Function AddReg(cle, valeur, genre) Dim CleReg, Cpt Dim valeurbis Dim valeurtxt Dim Wsh Set Wsh = CreateObject("Wscript.Shell") genre1 = CStr(genre) CleReg=cle On Error Resume Next 'Err.Number= 0 Err.clear 'initialisation de AddReg result ="" 'cle de type reg sz If (genre1 = "REG_SZ") Then Cpt = Wsh.RegRead(CleReg) valeurtxt = CStr(valeur) Wsh.RegWrite CleReg, valeurtxt, "REG_SZ" if err.number <>0 then result = result & "REG SZ Erreur dans l'ajout de cle" & Err.description & Chr(13)+Chr(10) else End if Err.Clear End If 'cle de type reg d_word If (genre1 = "REG_DWORD") Then Cpt = Wsh.RegRead(CleReg) Err.clear valeurbis = CLng(valeur) Wsh.RegWrite CleReg, valeurbis, "REG_DWORD" if err.number <>0 then result = CleReg & "REG_DWORD Erreur dans l'ajout de cle" & Err.description & Chr(13)+Chr(10) else End if Err.clear End If 'cle de type reg_binary If (genre1 = "REG_BINARY") Then Cpt = Wsh.RegRead(CleReg) valeurbis = CLng(valeur) Err.clear Wsh.RegWrite CleReg, valeurbis, "REG_BINARY" if err.number <>0 then result = CleReg & "REG_BINARY Erreur dans l'ajout de cle" & Err.description & Chr(13)+Chr(10) else End if Err.clear End If Err.clear Cpt = Wsh.RegRead(CleReg) If Err = 0 Then result = CleReg & Chr(13)+Chr(10) & "Succes" else result = result & CleReg & Chr(13)+Chr(10) & "Echec" end if Err.clear AddReg = result End Function 'Fonction de suppression de clé Function DelReg(cle) On Error Resume Next Dim CleReg, Cpt, Cpt1 Dim Wsh Dim verif, verif2, verif3,verif4 CleReg = cle Cpt1 = cle Err.clear Set Wsh = CreateObject("Wscript.Shell") result ="" 'verification cle de restriction ? ' verif2 = InStr(Cpt1, "Policies") ' verif4 = InStr(Cpt1, "policies") ' If ((verif2 = 0) or (verif4 = 0)) Then ' result=result & "VBS 15:" & Cpt1 & "test" & cle & "Suppression de cette clé interdite" & Chr(13)+Chr(10) & "echec" & Chr(13)+Chr(10) ' DelReg = result 'end if ' 'Exit Function 'Else 'verification cle du chemin ? verif3 = InStr(CleReg, "Y_LOCAL_MACHINE\Software\Policies\Restrictions\Chemin") If verif3 = 4 Then result=result & "VBS 16:" & cle & "Suppression de cette clé interdite" & Err.description & Chr(13)+Chr(10) DelReg = result Exit Function Else 'on verifie la présence de la clé CleReg = cle Cpt = Wsh.RegRead(CleReg) If Err <> 0 Then result=result & "VBS 17:" & cle & "Pas de clé à cet endroit:" & Err.description & Chr(13)+Chr(10) DelReg = result Err.clear Exit Function Else 'on supprime Err.Clear Wsh.RegDelete CleReg If Err <> 0 Then result=result & "VBS 18:" & cle & "Erreur de suppression de cle:" & Err.description & Chr(13)+Chr(10) DelReg = result 'else err.Clear End if Cpt = Wsh.RegRead(CleReg) If Err <> 0 Then result=result & Err.description & cle & " VBS 19" & Chr(13)+Chr(10) & "Succes" err.Clear DelReg = result else result=result & "Echec" & Chr(13)+Chr(10) end if Err.clear 'fin DelReg = result ' End If End If End If End Function