'Based on original code by Cullen Johnson (Accept No Substitutes!) 'additional code snippets and ideas from ' Ryan Eschinger ' Patrick Chambet ' Tim Chovanak ' Alan Stokes ' Mark Burnett (incl. C.T. Mason) '----- 'Copyright Russ Cooper, 2001 Dim path Dim pathlist Dim value Dim i Dim WshShell Dim IIsObject Dim fso Dim vMailRootPath Dim vMailPath Dim vFTPRootPath Dim vIISSamplesPath Dim vIISADMPWDPath Const IIS_DATA_NO_INHERIT = 0 Const IIS_DATA_INHERIT = 1 Wscript.echo "This process may take a few minutes." 'Create a shell object Set WshShell = WScript.CreateObject("WScript.Shell") Set fso = WScript.CreateObject("Scripting.FileSystemObject") On error resume next value = "net stop " & chr(34) & "CISVC" & chr(34) WshShell.Run value, 0, true 'Remove FTP Service and Metabase Entries set IIsObject = GetObject("IIS://LocalHost/MSFTPSVC") if Err.Number <> &H80070003 then select case (err.number) case 0 err.clear set IIsObject = GetObject("IIS://LocalHost/MSFTPSVC/1/ROOT") if err.number <> &H80070003 then select case (err.number) case 0 vFTProotPath = IIsObject.Path set IIsObject = getObject("IIS://LocalHost/MSFTPSVC/1") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsFTPVirtualDir", "Root" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select end if err.clear set IIsObject = getObject("IIS://LocalHost/MSFTPSVC") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsFTPServer", "1" if err.number <> 0 then ReportError() err.clear IIsObject.SetInfo if err.number <> 0 then ReportError() err.clear set IIsObject = getObject("IIS://LocalHost/MSFTPSVC") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsFTPInfo", "Info" if err.number <> 0 then ReportError() err.clear IIsObject.SetInfo if err.number <> 0 then ReportError() err.clear value = "net stop " & chr(34) & "MSFTPSVC" & chr(34) WshShell.Run value, 0, true set IIsObject = getObject("IIS://LocalHost") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsFTPService", "MSFTPSVC" if err.number <> 0 then ReportError() err.clear IIsObject.SetInfo if err.number <> 0 then ReportError() err.clear case else ReportError() end select err.clear end if case else ReportError() end select end if err.clear set IIsObject = getObject("IIS://LocalHost/W3SVC/1/ROOT") if err.number <> 0 then select case (err.number) case &H80070003 case else ReportError() end select err.clear else set IIsObject = getObject("IIS://LocalHost/W3SVC/1/ROOT/IISADMPWD") if err.number <> 0 then select case (err.number) case &H80070003 case else ReportError() end select err.clear else vIISADMPWDPath = IIsObject.Path set IIsObject = getObject("IIS://LocalHost/W3SVC/1/ROOT") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsWebVirtualDir", "IISADMPWD" if err.number <> 0 then ReportError() err.clear IIsObject.SetInfo if err.number <> 0 then ReportError() err.clear end if set IIsObject = getObject("IIS://LocalHost/W3SVC/1/ROOT/IISSAMPLES") if err.number <> 0 then select case (err.number) case &H80070003 case else ReportError() end select err.clear else vIISSamplesPath = IIsObject.Path set IIsObject = getObject("IIS://LocalHost/W3SVC/1/ROOT") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsWebVirtualDir", "IISSAMPLES" if err.number <> 0 then ReportError() err.clear IIsObject.SetInfo if err.number <> 0 then ReportError() err.clear end if end if err.clear set IIsObject = getObject("IIS://LocalHost/W3SVC/1") if err.number <> 0 then ReportError() err.clear IIsObject.FrontPageWeb = 0 if err.number <> 0 then ReportError() err.clear IIsObject.SetInfo if err.number <> 0 then ReportError() err.clear 'Remove SMTP Service and Metabase entries set IIsObject = getObject("IIS://LocalHost/W3SVC/1/ROOT/Mail") if err.number <> &H80070003 then select case (err.number) case 0 vMailRootPath = IIsObject.Path case else ReportError() end select end if err.clear set IIsObject = GetObject("IIS://LocalHost/SMTPSVC/1") if err.number <> &H80070003 then select case (err.number) case 0 vMailPath = IIsObject.PickupDirectory vMailPath = left(vMailPath,len(vMailPath)-7) 'Remove SMTP Service Metabase Entries set IIsObject = getObject("IIS://LocalHost/SMTPSVC/1/Root") if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.Delete "IIsSmtpVirtualDir", "Mailbox" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select end if set IIsObject = getObject("IIS://LocalHost/SMTPSVC/1") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsSmtpVirtualDir", "User" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select end if set IIsObject = getObject("IIS://LocalHost/SMTPSVC/1") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsSmtpVirtualDir", "Sessions" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select err.clear end if set IIsObject = getObject("IIS://LocalHost/SMTPSVC/1") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsSmtpVirtualDir", "Root" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select end if set IIsObject = getObject("IIS://LocalHost/SMTPSVC/1") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsSmtpVirtualDir", "EventManager" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select end if set IIsObject = getObject("IIS://LocalHost/SMTPSVC/1") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsSmtpVirtualDir", "Domain" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select end if set IIsObject = getObject("IIS://LocalHost/SMTPSVC/1") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsSmtpVirtualDir", "DL" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select end if set IIsObject = getObject("IIS://LocalHost/SMTPSVC/1") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsSmtpVirtualDir", "Alias" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select end if set IIsObject = getObject("IIS://LocalHost/SMTPSVC") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsSmtpVirtualDir", "Info" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select end if set IIsObject = getObject("IIS://LocalHost/SMTPSVC") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsSmtpServer", "1" if err.number <> &H80070003 then select case (err.number) case 0 IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select err.clear end if value = "net stop " & chr(34) & "SMTPSVC" & chr(34) WshShell.Run value, 0, true set IIsObject = getObject("IIS://LocalHost/W3SVC/1/ROOT/Mail") if err.number <> &H80070003 then select case (err.number) case 0 set IIsObject = getObject("IIS://LocalHost/W3SVC/1/ROOT") if err.number <> 0 then ReportError() err.clear IIsObject.Delete "IIsWebVirtualDir", "Mail" if err.number <> 0 then ReportError() err.clear IIsObject.SetInfo if err.number <> 0 then ReportError() case else ReportError() end select err.clear end if case else ReportError() end select err.clear end if case else ReportError() end select end if 'Disable Parent Paths for all web directories UpdateAll "w3svc", "AspEnableParentPaths", False 'Remove unsafe script mappings for all web directories pathlist = FindData ("w3svc/ScriptMaps") for each path in pathlist set IIsObject = getobject(path) if err.number <> 0 then ReportError() err.clear value = IIsObject.get("ScriptMaps") if err.number <> 0 then ReportError() err.clear value = filter(value, ".cdx,", False, 1) value = filter(value, ".cer,", False, 1) value = filter(value, ".htr,", False, 1) value = filter(value, ".printer,", False, 1) value = filter(value, ".idc,", False, 1) value = filter(value, ".htw,", False, 1) value = filter(value, ".ida,", False, 1) value = filter(value, ".idq,", False, 1) value = filter(value, ".stm,", False, 1) value = filter(value, ".shtm,", False, 1) value = filter(value, ".shtml,", False, 1) IIsObject.Put "ScriptMaps", value if err.number <> 0 then ReportError() err.clear IIsObject.SetInfo if err.number <> 0 then ReportError() err.clear next err.clear 'Remove SMTP Service Registry Keys value = "" value = WshShell.RegRead ("HKLM\SYSTEM\CurrentControlSet\Services\SMTPSVC\DisplayName") if value = "Microsoft SMTP Service" then WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\SMTPSVC\Security\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\SMTPSVC\Performance\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\SMTPSVC\Parameters\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\SMTPSVC\Enum\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\SMTPSVC\" end if err.clear 'Remove FTP Service Registry Keys value = "" value = WshShell.RegRead ("HKLM\SYSTEM\CurrentControlSet\Services\MSFTPSVC\DisplayName") if value = "FTP Publishing Service" then WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\MSFTPSVC\Security\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\MSFTPSVC\Performance\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\MSFTPSVC\Parameters\Virtual Roots\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\MSFTPSVC\Parameters\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\MSFTPSVC\Enum\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\MSFTPSVC\" end if err.clear ' Remove registry keys associated with the RDS vulnerability WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\W3SVC\Parameters\ADCLaunch\RDSServer.DataFactory\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\W3SVC\Parameters\ADCLaunch\AdvancedDataFactory\" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Services\W3SVC\Parameters\ADCLaunch\VbBusObj.VbBusObjCls\" 'Set Jet Engine Sandbox Mode to 3 WshShell.RegWrite "HKLM\Software\Microsoft\Jet\4.0\engines\SandboxMode", 3, "REG_DWORD" WshShell.RegWrite "HKLM\Software\Microsoft\Jet\3.5\engines\SandboxMode", 3, "REG_DWORD" 'Disable NET Shares WshShell.RegWrite "HKLM\SYSTEM\CurrentControlSet\Services\LanManServer\Parameters\AutoShareServer", 0, "REG_DWORD" 'Disable 8.3 File Generation WshShell.RegWrite "HKLM\SYSTEM\CurrentControlSet\Control\FileSystem\NtfsDisable8dot3NameCreation", 1, "REG_DWORD" 'Disable OS/2 Subsystem value = "HKLM\SOFTWARE\Microsoft\OS" & chr(47) & "2 Subsystem for NT\" WshShell.RegDelete value & "1.0\os2.ini\" WshShell.RegDelete value & "1.0\config.sys\" WshShell.RegDelete value & "1.0\" WshShell.RegDelete value WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\Os2LibPath" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\SubSystems\Optional" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\SubSystems\Os2" WshShell.RegDelete "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\SubSystems\Posix" 'Hide Last Logon Name WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DontDisplayLastUserName", "1", "REG_SZ" 'Setting Logon Legal Notice WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\LegalNoticeCaption", "NTBugtraq Logon Warning", "REG_SZ" WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\LegalNoticeText", "This system requires authorization from the company prior to logon.", "REG_SZ" 'Removing Shutdown button from Logon Dialog WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\ShutdownWithoutLogon", "0", "REG_SZ" 'Restrict Anonymous Access WshShell.RegWrite "HKLM\SYSTEM\CurrentControlSet\Control\LSA\RestrictAnonymous", 1, "REG_DWORD" if fso.FolderExist(vMailRootPath) then fso.DeleteFolder vMailRootPath, true if fso.FolderExist(vMailPath) then fso.DeleteFolder vMailPath, true if fso.FolderExist(vFTPRootPath) then fso.DeleteFolder vFTPRootPath, true if fso.FolderExist(vIISSamplesPath) then fso.DeleteFolder vIISSamplesPath, true if fso.FolderExist(vIISADMPWDPath) then fso.DeleteFolder vIISADMPWDPath, true value = "net start " & chr(34) & "CISVC" & chr(34) WshShell.Run value, 0, true wscript.echo "Process completed" 'UpdateAll ' ' Parameters: ' root: starting point for search (e.g. w3svc, w3svc/1) ' objectParameter: Name of the value to manipulate ' newValue: new value to set ' 'This function sets a Metabase value everywhere it is referenced in a subtree Function UpdateAll (root, objectParameter, newvalue) On error resume next Dim path Dim pathlist Dim IIsObject pathlist = FindData (root & "/" & objectParameter) for each path in pathlist set IIsObject = getobject(path) if err.number <> 0 then wscript.echo "Error " & err.number & " at " & err.line end if err.clear value = IIsObject.get(objectParameter) if err.number <> 0 then wscript.echo "Error " & err.number & " at " & err.line end if err.clear IIsObject.Put ObjectParameter, (newvalue) if err.number <> 0 then wscript.echo "Error " & err.number & " at " & err.line end if err.clear value = IIsObject.get(objectParameter) if err.number <> 0 then wscript.echo "Error " & err.number & " at " & err.line end if err.clear IIsObject.SetInfo if err.number <> 0 then wscript.echo "Error " & err.number & " at " & err.line end if err.clear next End Function Sub ReportError() Dim ErrorDescription Select Case (Err.Number) Case &H80070003 ErrorDescription = "The path requested could not be found." Case &H80070005 ErrorDescription = "Access is denied for the requested path or property." Case &H80070094 ErrorDescription = "The requested path is being used by another application." Case Else ErrorDescription = Err.Description End Select WScript.Echo ErrorDescription WScript.Echo "ErrNumber: " & Err.Number & " (0x" & Hex(Err.Number) & ") at " & Err.Line End Sub Function SplitParam(ObjectPath) ' Note: Assume the string has been sanitized (no leading or trailing slashes) On Error Resume Next Dim SlashIndex Dim TempParam Dim ObjectPathLen SplitParam = "" ' Assume no parameter ObjectPathLen = Len(ObjectPath) ' Separate the path of the node from the parameter SlashIndex = InStrRev(ObjectPath, "/") If (SlashIndex = 0) Or (SlashIndex = ObjectPathLen) Then TempParam = ObjectPath ObjectPath = "" ' ObjectParameter is more important Else TempParam = ObjectPath ObjectPath = Left(ObjectPath, SlashIndex - 1) TempParam = Right(TempParam, Len(TempParam) - SlashIndex) End If SplitParam = TempParam If (Err.Number <> 0) Then ReportError () WScript.Echo "Error trying to Split the parameter from the object: " & ObjectPath WScript.Quit (Err.Number) End If End Function Function FindData (ObjectPath) On Error Resume Next Dim ObjectParameter Dim NewObjectparameter Dim IIsObjectPath Dim IIsObject Dim Path Dim PathList Dim I MachineName = "LocalHost" ObjectParameter = SplitParam(ObjectPath) If ObjectPath = "" Then IIsObjectPath = "IIS://" & MachineName Else IIsObjectPath = "IIS://" & MachineName & "/" & ObjectPath End If Set IIsObject = GetObject(IIsObjectPath) If (Err.Number <> 0) Then ReportError () WScript.Echo "Error trying to find data paths for the Object (GetObject Failed): " & ObjectPath WScript.Quit (Err.Number) End If ' Now, list out all the places where this property exists. PathList = IIsObject.GetDataPaths(ObjectParameter, IIS_DATA_INHERIT) If Err.Number <> 0 Then PathList = IIsObject.GetDataPaths(ObjectParameter, IIS_DATA_NO_INHERIT) If (Err.Number <> 0) Then ReportError () WScript.Echo "Error trying to get a path list (GetDataPaths Failed): " & ObjectPath WScript.Quit (Err.Number) End If FindData = PathList If UBound(PathList) < 0 Then WScript.Echo "Property " & ObjectParameter & " was not found at any node beneath " & ObjectPath Else For Each Path In PathList Path = Right(Path, Len(Path) - 6) Path = Right(Path, Len(Path) - InStr(Path, "/")) Next End If If (Err.Number <> 0) Then ReportError () WScript.Echo "Error listing the data paths (_newEnum Failed): " & ObjectPath WScript.Quit (Err.Number) End If End Function