2007年10月9日 星期二

刪除組策略

'功能:禁止在臨時目錄%temp%\*.*、%ietemp%\Content.IE5\*.*及其它指定路徑中運行指定的後綴名
'如果與某個遊戲不兼容時,也就是某個遊戲會自動生成執行文件到被禁的目錄,請把路徑加到白名單中
'程序本身已兼容夢幻西遊、大話西遊更新,並自動取系統的臨時目錄和IE臨時目錄加入黑名單列表。
' - 浩月.net 編寫

On Error Resume Next
ungpedit()

Function ungpedit() '刪除策略
On Error Resume Next
'------------------------------------------------------------------------↓禁止運行默認路徑
keypath="SOFTWARE\Policies\Microsoft\Windows\Safer\CodeIdentifiers\0\Paths"
'------------------------------------------------------------------------↓開放運行默認路徑
keyfile="SOFTWARE\Policies\Microsoft\Windows\Safer\CodeIdentifiers\262144\Paths"
'------------------------------------------------------------------------↓刪除注冊表項
delreg(keypath)
delreg(keyfile)
Set WshShell = WScript.CreateObject("WScript.Shell")
'------------------------------------------------------------------------↓結束指定進程
exitprocess("explorer.exe")
'------------------------------------------------------------------------↓更新組策略
WshShell.Run ("gpupdate /force"),0
'------------------------------------------------------------------------↓刷新桌面
WshShell.Run ("RunDll32.exe USER32.DLL,UpdatePerUserSystemParameters")
End Function

Function exitprocess(exename)'結束指定進程,可以是程序名或程序路徑
strComputer="."
Set objWMIService = GetObject ("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery ("SELECT * FROM Win32_process")
For Each objItem in colItems
if objitem.ExecutablePath<>"" then '=========================先判斷命令路徑是否符合
if instrs(objitem.ExecutablePath,exename) = False then '命令路徑符合就結束
objItem.Terminate()
else
if instrs(objitem.Name,exename) = False then '命令路徑不符合時判斷程序名
objItem.Terminate()
end if
end if
else
if instrs(objitem.Name,exename) = False then '命令路徑為空時直接判斷程序名是否符合
objItem.Terminate()
end if
end if
Next
End Function

Function instrs(patrn, strng) '搜索指定字符是否存在
Dim regEx, retVal
Set regEx = New RegExp
regEx.Pattern = patrn
regEx.IgnoreCase = True ' 是否區分大小寫。
retVal = regEx.Test(strng)
If retVal Then
instrs = False
Else
instrs = True
End If
End Function

Function Str2Hex(ByVal strHex) '返回16進制字符串
Dim sHex,tempnum
For i = 1 To Len(strHex)
sHex = sHex & Hex(Asc(Mid(strHex,i,1)))
Next
Str2Hex = sHex
End Function

Function delreg(strkeypath) '刪除注冊表子項,只限為HKLM根路徑。最後不能為"\" 07-05-12 浩月.net添加
const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
For Each subkey In arrSubKeys
oReg.DeleteKey HKEY_LOCAL_MACHINE, strKeyPath&"\"&subkey
Next
End Function

沒有留言: