[Summary view] [Print] [Text view]

   1  Const CheminDefault = "\\#SE3#\netlogon"
   2  Const FileDefaultLog = "C:\netinst\logs\logsregistrese3.txt"
   3  Const Chemindefaultclientlog = "C:\netinst\logs"
   4  Const Chemindefaultclient= "C:\netinst"
   5  Const Domain = "#DOMAIN#"
   6  
   7  
   8  Dim result,test,log
   9  Dim fonction
  10  Dim ret, testos
  11  Dim Wsh
  12  Dim ligne()
  13  Dim LireKey
  14  Dim chemin,cleverif
  15  Dim sArg, RegEx
  16  
  17  Dim fichier
  18  Const ForReading = 1, ForWriting = 2, ForAppending = 8
  19  Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
  20  Dim fso, f, ts
  21  Const HKEY_USERS = &H80000003
  22  Dim genre1, genre2, genre3, genre4, genre5, verif3 , verif2
  23  
  24  Set sArg = WScript.Arguments
  25  Set Wsh = CreateObject("Wscript.Shell")
  26  Set fso = CreateObject("Scripting.FileSystemObject")
  27  
  28  groupe = sArg(0)
  29  
  30  'Lecture de l'argument
  31  If sArg.Count <> 1 Then
  32      MsgBox "Veuillez passer en paramètre le nom de l'utilisateur ."
  33      WScript.Quit
  34  End If
  35   log=""
  36  On Error Resume Next
  37  oUser = Wsh.ExpandEnvironmentStrings("%USERNAME%")
  38  oDomain = Wsh.ExpandEnvironmentStrings("%USERDOMAIN%")
  39  
  40  
  41  'Lecture du chemin et de l'os
  42  
  43           KeyVer = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ProductName"
  44          PN = Wsh.RegRead(KeyVer)
  45       Err.Clear         
  46           If PN = "" Then
  47           KeyVer = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName"
  48           PN = Wsh.RegRead(KeyVer)
  49       Err.Clear
  50           End If
  51           If PN = "" Then
  52           PN = "Microsoft Windows 98"
  53           End if
  54  
  55  'cle du chemin vide ?
  56     '     CleReg = "HKEY_LOCAL_MACHINE\Software\Policies\Restrictions\Chemin"
  57      '    LireKey = Wsh.RegRead(CleReg)
  58       '   If LireKey = "" Then
  59         'MsgBox "Il est impossible d'accéder aux informations de restriction (cle manquante)"
  60        '  LireKey = CheminDefault
  61         ' End If
  62    '      Err.clear
  63      
  64  'cle de log vide ?
  65  'CleLog = "HKEY_LOCAL_MACHINE\Software\Policies\Restrictions\CheminLog"
  66  'LireKeyLog = Wsh.RegRead(CleLog)
  67  'If LireKeyLog = "" Then
  68  '       LireKeyLog = CheminDefaultLog
  69   '      Err.clear
  70      
  71  'End If
  72    'ouverture et creation du fichier de log si necessaire
  73    'cheminlog=Cstr(LireKeyLog)
  74    Err.clear
  75  
  76  
  77  
  78  
  79   'Action en fonction de l'os
  80          If (PN = "Microsoft Windows 2000") Then
  81          testos = "2K"
  82  
  83          End If
  84          If (PN = "Microsoft Windows XP") Then
  85          testos = "XP"
  86          End If
  87  
  88          If (PN = "Microsoft Windows 98") Then
  89          testos = "98"
  90          End If
  91  
  92          If (PN = "Microsoft Windows Millenium") Then
  93          testos = "Me"
  94          End If
  95  
  96          If (PN = "Microsoft Windows NT") Then
  97          testos = "NT"
  98         End If
  99  
 100          If (PN = "Microsoft Windows 95") Then
 101          testos = "95"
 102          End If
 103  
 104  'definition du chemin
 105  if (testos<>"XP")or (testos<>"2K") or (testos<>"NT") then
 106  oUser = groupe
 107  end if
 108  log = log & "VBS 1:" & now & "Login utilisateur: " & oUser  & Chr(13)+Chr(10)
 109  chemin = CheminDefault & "\" & oUser & ".txt"
 110  chemin1= Cstr(chemin)
 111  'logfile.writeline "VBS 2:" & chemin
 112  
 113  'Test de la présence du fichier
 114        If Not fso.FileExists(chemin) Then
 115        log = log & "VBS 3:" & "Le fichier cherché n'est pas présent" & chemin
 116        Set fso = Nothing
 117        Set Wsh = Nothing
 118        WScript.Quit
 119        End If
 120  
 121  log = log & "VBS 4: OS détecté : " & PN  & Chr(13)+ Chr(10)
 122  
 123  if ((groupe<>oUser) and (testos="XP" or testos="2K" or testos="NT")) then
 124  log = log & "Tentative d'acces au jeux d'autorisations de: " & groupe & Chr(13)+Chr(10)
 125  Wscript.quit
 126  end if
 127  
 128  if testos="XP" or testos="2K" or testos="NT" then
 129  
 130  Set objUserAccount = GetObject("Winmgmts:{impersonationlevel=impersonate}!root/cimv2:Win32_UserAccount.Domain=""" & oDomain & """,Name=""" & oUser & """")
 131  
 132  If Err = 0 Then
 133      SID=objUserAccount.SID
 134  End If
 135  End if
 136  
 137  
 138  
 139  'lecture du fichier
 140  Err.Clear
 141  Set f = fso.GetFile(chemin)
 142  Set ts = f.OpenAsTextStream(ForReading, TristateUseDefault)
 143  
 144  Do While ts.AtEndOfStream <> True
 145     Err.clear
 146   ' MsgBox TextStreamTest,vbOkOnly + vbApplicationModal + 0,"lecture"
 147     increment = 0
 148     TextStreamTest = ts.ReadLine
 149     'Message en cas de rem ou REM ou #
 150     testtxte= TextStreamTest
 151     
 152     verif= InStr(Cstr(testtxte) , "@@@")
 153  If (verif = 0) Then
 154         log = log & "VBS 6:"& TextStreamTest & Chr(13)+Chr(10)
 155  else
 156     texteligne = TextStreamTest
 157     log = log & "VBS 6bis:"& TextStreamTest
 158     aligne = Split(texteligne, "@@@")
 159  
 160  
 161    'cas XP ou tous ou type XP
 162      if ((testos="NT") or (testos="2K") or (testos="XP")) then
 163      increment = increment + 1
 164      test=CasXP(Cstr(TextStreamTest),Cstr(testos),Cstr(SID),Cstr(groupe))
 165      log = log &  test & err.description & Chr(13)+Chr(10)
 166      end if
 167  err.clear
 168  
 169   'OS type 98 ou 95
 170      if ((testos="98") or (testos="ME") or (testos="95")) then
 171      increment = increment + 1
 172               test=  Reg(Cstr(TextStreamTest))
 173               log = log & test & err.description & Chr(13)+Chr(10)
 174      end if
 175      err.clear
 176      if increment=0 then
 177      log = log & "Pas d'action effectuée ?" & Chr(13)+Chr(10)
 178      end if
 179  'logfile.writeline increment & Chr(13)+Chr(10)
 180  'if ((trim(aligne(0))="Type9x" or trim(aligne(0))="TOUS") and increment=0) then
 181  '         test= Reg(Cstr(TextStreamTest))
 182  '         logfile.writeline "VBS 7: " & test & err.description 
 183  '         increment = increment + 1
 184  'end if
 185  'err.clear
 186  'if (testos=trim(aligne(0)) and increment=0) then
 187  '         test= "VBS 8bis: " & Reg(Cstr(TextStreamTest))
 188  '         logfile.writeline "VBS 8: " & test & err.description 
 189  'end if
 190  
 191  End if
 192  'fin de lecture du fichier
 193  err.clear
 194  Loop
 195       semaine_precedente = DateAdd("d", -7, now)
 196  
 197  ts.close
 198  'MsgBox "test"
 199  if fso.FolderExists(Chemindefaultclient) then
 200  
 201      if fso.FolderExists(Chemindefaultclientlog) then
 202               if (fso.Fileexists(FileDefaultLog)) then
 203                     Set    infofile=fso.Getfile(FileDefaultLog)
 204                             if infofile.DateCreated => semaine_precedente then
 205                              set logfile = fso.OpenTextFile(FileDefaultLog,ForWriting,true)
 206                         '     Msgbox "fichier ouvert mais ecrasé"
 207                              logfile.write log
 208                            logfile.close    
 209                            else
 210                             set logfile = fso.OpenTextFile(FileDefaultLog,ForAppending,false)
 211                          '   Msgbox "fichier ouvert pas ecrasé"
 212                             logfile.write log
 213                            logfile.close    
 214                            end if
 215  
 216                  else
 217                          set logfile = fso.CreateTextFile(FileDefaultLog,ForAppending,false)
 218                      '    Msgbox "fichier créé"
 219                          logfile.write log
 220                            logfile.close    
 221          end if
 222      end if
 223  end if
 224  'MsgBox  err.description & log
 225  Set fso = Nothing
 226  Set Wsh = Nothing
 227  WScript.Quit
 228  
 229  'fonction d'action sur les os type 9x
 230  
 231  Function Reg(texteligne)
 232  Dim result
 233    aligne = Split(texteligne, "@@@")
 234  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
 235  If (Trim(aligne(1)) = "ADD") Then
 236            ajoutcle = AddReg(Trim(aligne(2)), Trim(aligne(3)), Trim(aligne(4)))
 237            result = result &  "VBS 13: " & ajoutcle & err.description
 238            End If
 239  
 240  If (Trim(aligne(1)) = "DEL") Then
 241            delkey = DelReg(Trim(aligne(2)))
 242            result = result & "VBS 14: " & delkey & err.description
 243            End If
 244  result =  result & Chr(13)+Chr(10)
 245  Reg = result
 246  end if
 247  end function
 248  
 249  Function Adddll(groupe,texteligne,SID)
 250  Dim cleverif,result
 251  Dim objet
 252      
 253               cleverif = "HKEY_USERS\" & SID & "\Identities\username"
 254               ajoutcle= AddReg(cleverif,groupe,"REG_SZ")
 255               Err.clear
 256               Set objet = CreateObject("Restrict.Reg")
 257               resultdll = objet.Restrict(Cstr(trim(groupe)),Cstr(texteligne),Cstr(SID))
 258               result = "DLL 0:" & resultdll & Err.description & Chr(13)+Chr(10)
 259           
 260  Set objet = nothing
 261  adddll = result
 262  end function
 263  
 264  function CasXP(texteligne,testos,SID,groupe)
 265  'Dim aligne()
 266  Dim Wsh,TextStreamTest
 267  Dim RegEx,result
 268  Set Wsh = CreateObject("Wscript.Shell")
 269  
 270  TextStreamTest = texteligne
 271  aligne = Split(Cstr(texteligne),"@@@")
 272  
 273  if  (trim(aligne(0)) = "TOUS" or trim(aligne(0)) = "TypeXP" or trim(aligne(0))=testos) then
 274  
 275          ' texteligneok = TextStreamTest
 276          cle = Trim(aligne(2))
 277           cle1 = cle
 278           verif3 = InStr(cle1 , "EY_CURRENT_USER")
 279          ' verif2 = InStr(cle , "olicies")
 280           result = "VBS 23"
 281           if ((verif3>0) AND (SID<>"")) then
 282           'verif de policies et de hkcu
 283              result = result & "VBS 24"
 284              Set RegEx = New RegExp
 285              RegEx.Pattern = "HKEY_CURRENT_USER"
 286              RegEx.IgnoreCase = True
 287              newreg = "HKEY_USERS\" & Cstr(SID)
 288              ReplaceTest = RegEx.Replace(TextStreamTest, newreg)
 289              result = result & "VBS 25"
 290                  TextStreamTestnew = trim(ReplaceTest)
 291             
 292                '& trim(ReplaceTest)
 293           end if
 294         
 295          '  if (verif2<>0) then
 296            'verif de policies
 297                result = result & "VBS 9 "
 298              cleverif = "HKEY_USERS\" & SID & "\Identities\username"
 299              ajoutcle=AddReg(cleverif,groupe,"REG_SZ")
 300              Err.clear
 301             ' Set objet = CreateObject("Restrict.Reg")
 302              'resultdll = objet.Restrict(Cstr(trim(groupe)),Cstr(TextStreamTestnew),Cstr(SID))
 303              resultdll=Adddll(Cstr(trim(groupe)),Cstr(TextStreamTestnew),Cstr(SID))
 304              result = result & "Cas XP 10: Adddll" & TextStreamTestnew & resultdll & Err.description
 305               Set objet = nothing
 306            '  else
 307            '      test= Reg(TextStreamTest)
 308            '      result = result & "VBS 11" & test & err.description
 309           '   end if
 310  end if 
 311  CasXP = result
 312  end function
 313  
 314  'fonction d'ajout de cle
 315  Function AddReg(cle, valeur, genre)
 316  
 317            Dim CleReg, Cpt
 318            Dim valeurbis
 319            Dim valeurtxt
 320            Dim Wsh
 321            Set Wsh = CreateObject("Wscript.Shell")
 322            genre1 = CStr(genre)
 323            CleReg=cle
 324            On Error Resume Next
 325            'Err.Number= 0
 326            Err.clear
 327  'initialisation de AddReg
 328            result =""
 329  'cle de type reg sz
 330            If (genre1 = "REG_SZ") Then
 331                Cpt = Wsh.RegRead(CleReg)
 332                valeurtxt = CStr(valeur)
 333                Wsh.RegWrite CleReg, valeurtxt, "REG_SZ"
 334                if err.number <>0 then
 335                result = result & "REG SZ Erreur dans l'ajout de cle" & Err.description & Chr(13)+Chr(10)
 336                else
 337                 End if
 338                Err.Clear
 339            End If
 340  'cle de type reg d_word
 341            If (genre1 = "REG_DWORD") Then
 342             
 343                Cpt = Wsh.RegRead(CleReg)
 344                Err.clear
 345                valeurbis = CLng(valeur)
 346                Wsh.RegWrite CleReg, valeurbis, "REG_DWORD"
 347                if err.number <>0 then
 348                result = CleReg & "REG_DWORD Erreur dans l'ajout de cle" & Err.description & Chr(13)+Chr(10)
 349                else
 350                End if
 351                Err.clear
 352            End If
 353  'cle de type reg_binary
 354            If (genre1 = "REG_BINARY") Then
 355               
 356                Cpt = Wsh.RegRead(CleReg)
 357                valeurbis = CLng(valeur)
 358                Err.clear
 359                Wsh.RegWrite CleReg, valeurbis, "REG_BINARY"
 360                if err.number <>0 then
 361                result = CleReg & "REG_BINARY Erreur dans l'ajout de cle"  & Err.description & Chr(13)+Chr(10)
 362                else
 363                 End if
 364                Err.clear
 365            End If
 366  
 367        Err.clear
 368            Cpt = Wsh.RegRead(CleReg)
 369            If Err = 0 Then
 370            result = CleReg & Chr(13)+Chr(10) &  "Succes"
 371            else
 372        result = result &  CleReg & Chr(13)+Chr(10) &  "Echec"
 373            end if
 374            Err.clear
 375            AddReg = result
 376  End Function
 377  
 378  'Fonction de suppression de clé
 379  Function DelReg(cle)
 380  
 381            On Error Resume Next
 382            Dim CleReg, Cpt, Cpt1
 383            Dim Wsh
 384            Dim verif, verif2, verif3,verif4
 385            CleReg = cle
 386            Cpt1 = cle
 387            Err.clear
 388            Set Wsh = CreateObject("Wscript.Shell")
 389            result =""
 390  'verification cle de restriction ?
 391          '  verif2 = InStr(Cpt1, "Policies")
 392           ' verif4 = InStr(Cpt1, "policies")
 393           ' If ((verif2 = 0) or (verif4 = 0)) Then
 394          '  result=result &  "VBS 15:" & Cpt1 & "test" & cle & "Suppression de cette clé interdite" & Chr(13)+Chr(10) & "echec" & Chr(13)+Chr(10) 
 395           ' DelReg = result
 396  'end if          '
 397  'Exit Function
 398            'Else
 399  
 400  'verification cle du chemin ?
 401            verif3 = InStr(CleReg, "Y_LOCAL_MACHINE\Software\Policies\Restrictions\Chemin")
 402            If verif3 = 4 Then
 403            result=result & "VBS 16:" & cle & "Suppression de cette clé interdite" & Err.description & Chr(13)+Chr(10)
 404            DelReg = result
 405            Exit Function
 406            Else
 407  
 408  'on verifie la présence de la clé
 409            CleReg = cle
 410            Cpt = Wsh.RegRead(CleReg)
 411            If Err <> 0 Then
 412            result=result & "VBS 17:" & cle & "Pas de clé à cet endroit:" & Err.description & Chr(13)+Chr(10)
 413            DelReg = result
 414            Err.clear
 415            Exit Function
 416       
 417            Else
 418  'on supprime
 419            Err.Clear
 420            Wsh.RegDelete CleReg
 421            If Err <> 0 Then
 422            result=result & "VBS 18:" & cle & "Erreur de suppression de cle:" & Err.description & Chr(13)+Chr(10)
 423            DelReg = result
 424            'else
 425            err.Clear
 426            
 427            End if
 428  
 429            Cpt = Wsh.RegRead(CleReg)
 430            If Err <> 0 Then
 431            result=result & Err.description & cle & " VBS 19" & Chr(13)+Chr(10) & "Succes"
 432            err.Clear
 433            DelReg = result
 434            else 
 435            result=result & "Echec" & Chr(13)+Chr(10)
 436            end if
 437  
 438            Err.clear
 439  'fin
 440            DelReg = result
 441           ' End If
 442            End If
 443            End If
 444  End Function
 445  
 446