' ---------------------------------------------------------- ' Script d'affichage explicite des fichiers ADM ' Syntaxe: ' showadm[.vbs] ' Ce script fait appel à un Contrôle ActiveX de chargement ' et déchargemenr de ruche (jcb.ocx) ' ' JC BELLAMY © 2003 ' ---------------------------------------------------------- On Error resume next Const SW_HIDE=0 Const SW_SHOWNORMAL=1 Const HKEY_USERS = &H80000003 Const navOpenInNewWindow = &H1 Const navNoHistory = &H2 Const navNoReadFromCache = &H4 Const navNoWriteToCache = &H8 Const navAllowAutosearch = &H10 Const navBrowserBar = &H20 Const navHyperlink = &H40 Const xlDiagonalDown = 5 Const xlDiagonalUp = 6 Const xlEdgeLeft = 7 Const xlEdgeTop = 8 Const xlEdgeBottom = 9 Const xlEdgeRight =10 Const xlContinous = 1 Const xlThin = 2 Const xlThick = 4 Const xlDouble =&HFFFFEFE9 Const xlAutomatic =&HFFFFEFF7 Const xlInsideVertical = 11 Const xlNone =&HFFFFEFD2 Const xlUnderlineStyleNone =&HFFFFEFD2 Const xlCenter =&HFFFFEFF4 Const xlBottom =&HFFFFEFF5 Const xlContext =&HFFFFEC76 Const xlSolid = 1 Const msoFalse = 0 Const msoScaleFromTopLeft = 0 Const xlR1C1 =&HFFFFEFCA ColorBack="""#FFFFD8""" ColorBorderL = """#66CCCC""" ColorBorderD = """#006666""" ' ================== couleurs EXCEL ================== Black = 1 Brown = 53 OliveGreen = 52 DarkGreen = 51 DarkGreenBlue = 49 DarkBlue = 11 Indigo = 55 Grey80 = 56 DarkRed = 9 Orange = 46 LightBrown = 12 Green = 10 GreenBlue = 14 Blue = 5 GrayBlue = 47 Gray50 = 16 Red = 3 LightOrange = 45 LimeGreen = 43 MarineGreen = 50 WaterGreen = 42 LightBlue = 41 Violet = 13 Gray40 = 48 Pink = 7 Gold = 44 Yellow = 6 BrigthGreen = 4 Turquoise = 8 SkyBlue = 33 Plum = 54 Grey25 = 15 SalmonPink = 38 Brown = 40 LightYellow = 36 LightGreen = 35 LightTurquoise= 34 MediumBlue = 37 Lavender = 39 White = 2 ColorBGTitre=DarkBlue ColorFGTitre=White ColorBGCategory=Blue ColorFGCategory=White ColorBGStrat1=Turquoise ColorFGStrat1=Black ColorBGStrat2=SkyBlue ColorFGStrat2=Black ColorBGComment=DarkBlue ColorFGComment=White FGCatSel="white" FGCatSelLink="white" FGCatSelVisited="white" FGCatSelActive="white" FGCatSelHover="white" BGCatSel="blue" BGCatSelLink="blue" BGCatSelVisited="blue" BGCatSelActive="blue" BGCatSelHover="black" FGCatNotSel="blue" FGCatNotSelLink="blue" FGCatNotSelVisited="blue" FGCatNotSelActive="blue" FGCatNotSelHover="white" BGCatNotSel=ColorBack BGCatNotSelLink=ColorBack BGCatNotSelVisited=ColorBack BGCatNotSelActive=ColorBack BGCatNotSelHover="black" BGProgressON="blue" BGProgressOFF=ColorBack FGStratON="white" FGStratONLink="lightblue" FGStratONVisited="lightblue" FGStratONActive="lightblue" FGStratONHover="lightblue" BGStratON="red" FGStratOFF="black" FGStratOFFLink="blue" FGStratOFFVisited="blue" FGStratOFFActive="blue" FGStratOFFHover="blue" BGStratOFF=ColorBack ForReading=1 ForWriting=2 ForAppending=8 TristateUseDefault = -2 'Ouvre le fichier avec la valeur par défaut du système. TristateTrue = -1 'Ouvre le fichier comme de l'Unicode. TristateFalse = 0 'Ouvre le fichier comme de l'ASCII. quote=chr(34) LevelMax=0 ADMClass=array("machine","user") DisplayADMClass=array("Machine","Utilisateur") KeyClass=Array("HKEY_LOCAL_MACHINE","HKEY_CURRENT_USER") nClass=UBound(ADMClass)-LBound(ADMClass)+1 Dim stack(),TabLine(),TabCat() Dim CurLevel,Root,CurParent,CurPolicy,CurPart,CurValue,CatIndex,CatIndexPrec Dim MasterKeyCat,MasterKeyPol,Line0 Dim nItem,NL,FlagColor,NLprev,NLLast NLLast=1 Set net = Wscript.CreateObject("WScript.Network") Set shell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") Set dictVar = WScript.CreateObject("Scripting.Dictionary") computer=Ucase(net.ComputerName) user=UCase(net.UserName) jcbCOM="jcb.tools" TestCOMExists jcbCOM,"jcb.ocx" TestCOMExists "COMCTL.ListViewCtrl","comctl32.ocx" TestCOMExists "Excel.Application","" Set tools = wscript.CreateObject(jcbCOM,"event_") KeyAppli="HKEY_LOCAL_MACHINE\SOFTWARE\jcb\showadm\" ' =================== Version de l'OS =================== ' Certaines clefs (et fonctionnalités) n'existent que sous XP KeyVer="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\" XP=false PN=ReadKey(keyver,"ProductName","") If PN="Microsoft Windows XP" Then XP=true Titre="Stratégies définies dans les fichiers ADM de " & Computer ficInit = GetPath() & "showadm.html" ficLog = GetPath() & "showadm.log" ficVBS = GetPath() & "runreg.vbs" ' =================== Création du 2ème VBS ================================== Set tv = fso.CreateTextFile(ficVBS, True) tv.writeline "set Args = Wscript.arguments" tv.writeline "if args.count<2 then wscript.quit" tv.writeline "Set shell = WScript.CreateObject(""WScript.Shell"")" tv.writeline "Set net = Wscript.CreateObject(""WScript.Network"")" tv.writeline "SelectedKey=args(0) & ""\"" & args(1)" tv.writeline "p=instrrev(SelectedKey,""\"")" tv.writeline "SelectedKey=left(SelectedKey,p-1)" tv.writeline "KeyMem=""HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey""" tv.writeline "Shell.RegWrite keyMem, SelectedKey" tv.writeline "Computer=Ucase(net.ComputerName)" tv.writeline "Set ProcessSet=GetObject(""winmgmts:{impersonationLevel=impersonate}!//"" & Computer).InstancesOf(""Win32_process"")" tv.writeline "for each Process in ProcessSet" tv.writeline " If InStr(1,Process.Name, ""regedit.exe"", vbTextCompare)>0 Then" tv.writeline " result=Process.terminate(0)" tv.writeline " exit for" tv.writeline " End If" tv.writeline " next" tv.writeline "Shell.Run ""REGEDIT"",1,false" tv.close dim ficadm(),ficadmdef ficadmdef=array("system.adm","inetres.adm","conf.adm") nfadm=0 nfadmdef=3 ' =================== Préparation du 1er formulaire HTML =================== Set ts = fso.CreateTextFile(ficInit, True) ts.writeline header ts.writeline TitreHTML ts.writeline ScriptBtn ts.writeline "