Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WinVer = WshSHell.Environment("Process")
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)
InsFullName = FSO.BuildPath(InsPath ,FileName)
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:fty1995@163.com"
InsTitle="优化CS反恐"
InsAnswer="优化CS反恐"
RegPath1="HKEY_CLASSES_ROOT\CLSID\{208D2C60-3AEA-1069-A2D7-08002B30309D}\shell\CS_CDKey_Video_Optimize\"
RegValue1="优化CS反恐(&Y)"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\CLSID\{208D2C60-3AEA-1069-A2D7-08002B30309D}\shell\CS_CDKey_Video_Optimize\command\"
RegValue2="wscript.exe "&InsFullName
RegForm2="REG_SZ"
RegPath3="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4D36E96E-E325-11CE-BFC1-08002BE10318}\0000\MODES\"
IF FileFullName <> InsFullName then
intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到网上邻居右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从网上邻居右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - "+ QQ)
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.popup _
"添加脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
end if
If intAnswer = vbNo Then
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
WshSHell.popup _
"删除脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"删除注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - "+ Copyright, 0 + 64
End If
If intAnswer = vbCancel Then
end if
ELSE
WshSHell.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Video\{E76B2350-59A0-4943-BCA7-81B2185F518F}\0000\PruningMode",1,"REG_DWORD"'''隐藏不能显示的视频模式
SafeRefurbish=WshSHell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Hardware Profiles\Current\System\CurrentControlSet\Control\VIDEO\{E76B2350-59A0-4943-BCA7-81B2185F518F}\0000\DefaultSettings.VRefresh")
SafeXR=WshSHell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Hardware Profiles\Current\System\CurrentControlSet\Control\VIDEO\{E76B2350-59A0-4943-BCA7-81B2185F518F}\0000\DefaultSettings.XResolution")
SafeYR=WshSHell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Hardware Profiles\Current\System\CurrentControlSet\Control\VIDEO\{E76B2350-59A0-4943-BCA7-81B2185F518F}\0000\DefaultSettings.YResolution")
SRStr="1152,864\1088,612\1024,768\960,600\800,600\640,480"
SRSArr=split(SRStr,"\")
Call pmtb
Call lockrf
Call changecdkey
If WinVer("OS") = "Windows_NT" Then
Call MouseQuicken
end if
Sub pmtb()
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
oReg.GetBinaryValue HKEY_LOCAL_MACHINE,"SYSTEM\CurrentControlSet\Control\Video\{E76B2350-59A0-4943-BCA7-81B2185F518F}\0000", "D3D_60461791", strValue
If IsNull(strValue) Then
xptb="未知状态"
else
if int(strValue(0))=64 then
xptb="开启状态"
elseif int(strValue(0))=71 then
xptb="关闭状态"
elseif int(strValue(0))=146 then
xptb="程序控制"
else
xptb="未知状态"
end if
end if
intAnswer = MsgBox(" 当前状态："&xptb&chr(10)&chr(10)&"【是】开启屏幕“垂直同步”功能。"&chr(10)&chr(10)&"【否】关闭屏幕“垂直同步”功能。"&chr(10)&chr(10)&"【消】程序控制“垂直同步”功能。",vbQuestion + vbYesNoCancel,"测试于 CeForce 7300 GT - "&QQ)
If intAnswer = vbYes Then
D3D=1199655232
end if
If intAnswer = vbNo Then
D3D=138504007
end if
If intAnswer = vbCancel Then
D3D=1620202130
end if
WshSHell.RegWrite "HKLM\SYSTEM\CurrentControlSet\Control\Video\{E76B2350-59A0-4943-BCA7-81B2185F518F}\0000\D3D_60461791",D3D,"REG_BINARY"
End Sub
Sub lockrf()
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
oReg.GetStringValue HKEY_LOCAL_MACHINE,"SYSTEM\CurrentControlSet\Control\Class\{4D36E96E-E325-11CE-BFC1-08002BE10318}\0000\MODES\"&SafeXR&","&SafeYR,"Mode1",strRunCommand
If IsNull(strRunCommand) Then
Lk="未锁定"
Elseif WshSHell.RegRead(RegPath3&SafeXR&","&SafeYR&"\Mode1")<>"" then
Lk="已锁定"
else
Lk="未锁定"
End If
intAnswer = MsgBox(" 当前状态："&SafeXR&"*"&SafeYR&" "&SafeRefurbish&"HZ ("&Lk&")"&Chr(10)&Chr(10)&"【是】将屏幕刷新率锁定在当前状态："&SafeRefurbish&"HZ，(锁定刷新)"&Chr(10)&Chr(10)&"【否】退出游戏，将取消对屏幕刷新率锁定。(取消锁定) ", vbQuestion + vbYesNoCancel, "知道为什么你打CS头晕想吐吗? - "+ QQ)
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath3&SafeXR&","&SafeYR&"\Mode1",SafeRefurbish&"-"&SafeRefurbish&","&SafeRefurbish&"-"&SafeRefurbish,"REG_SZ"
For i=0 To UBound(SRSArr)
SRJArr=split(SRSArr(i),",")
if int(SRJArr(0)) < int(SafeXR) then
WshSHell.RegWrite RegPath3&SRSArr(i)&"\Mode1",SafeRefurbish&"-"&SafeRefurbish&","&SafeRefurbish&"-"&SafeRefurbish,"REG_SZ"
end if
Next
end if
If intAnswer = vbNo Then
WshSHell.RegDelete RegPath3&SafeXR&","&SafeYR&"\Mode1"
For i=0 To UBound(SRSArr)
SRJArr=split(SRSArr(i),",")
if int(SRJArr(0)) < int(SafeXR) then
WshSHell.RegDelete RegPath3&SRSArr(i)&"\"
end if
Next
End If
If intAnswer = vbCancel Then
end if
End Sub
Sub changecdkey()
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
oReg.GetStringValue HKEY_CURRENT_USER,"Software\Valve\CounterStrike\Settings","Key",strRunCommand
If IsNull(strRunCommand) Then
oReg.SetStringValue HKEY_CURRENT_USER,"Software\Valve\CounterStrike\Settings","Key",CDKey_New
CDKey_Old = WshSHell.RegRead("HKEY_CURRENT_USER\Software\Valve\CounterStrike\Settings\Key")
Else
CDKey_Old = strRunCommand
End If
if CDKey_Old="" then CDKey_Old=" 空值 "
intAnswer = MsgBox(" 当前CD-Key："&CDKey_Old&Chr(10)&Chr(10)&"【是】随机更换反恐序列号，(更换CD-Key)"&Chr(10)&Chr(10)&"【否】清空注册反恐序列号。(清空CD-Key)", vbQuestion + vbYesNoCancel, "当你打CS时有主机拒绝你的CDKey时 - "+ QQ)
If intAnswer = vbYes Then
CDKey_Old = WshSHell.RegRead("HKEY_CURRENT_USER\Software\Valve\CounterStrike\Settings\Key")
Do
CrKey=CDKey_New
WshSHell.RegWrite "HKEY_CURRENT_USER\Software\Valve\CounterStrike\Settings\Key",CrKey,RegForm1
Loop Until CrKey <> CDKey_Old
end if
If intAnswer = vbNo Then
WshSHell.RegWrite "HKEY_CURRENT_USER\Software\Valve\CounterStrike\Settings\Key",""
End If
If intAnswer = vbCancel Then
end if
End Sub
Sub MouseQuicken()
if WshSHell.RegRead("HKEY_CURRENT_USER\Software\Valve\CounterStrike\Settings\Key") = 1 then
MQ="全力加速"
else
MQ="取消加速"
end if
intAnswer = MsgBox(" 当前状态："&MQ&Chr(10)&Chr(10)&"【是】取消XP中CS鼠标加速。"&Chr(10)&Chr(10)&"【否】恢复XP中CS鼠标加速。", vbQuestion + vbYesNoCancel, "当你习惯于Win9X的鼠标速度时 - "+ QQ)
If intAnswer = vbYes Then
WshSHell.RegWrite "HKEY_CURRENT_USER\Control Panel\Mouse\MouseSpeed","0","REG_SZ"
WshSHell.RegWrite "HKEY_CURRENT_USER\Control Panel\Mouse\MouseThreshold1","0","REG_SZ"
WshSHell.RegWrite "HKEY_CURRENT_USER\Control Panel\Mouse\MouseThreshold2","0","REG_SZ"
ETLog
End If
If intAnswer = vbNo Then
WshSHell.RegWrite "HKEY_CURRENT_USER\Control Panel\Mouse\MouseSpeed","1","REG_SZ"
WshSHell.RegWrite "HKEY_CURRENT_USER\Control Panel\Mouse\MouseThreshold1","6","REG_SZ"
WshSHell.RegWrite "HKEY_CURRENT_USER\Control Panel\Mouse\MouseThreshold2","10","REG_SZ"
ETLog
End If
If intAnswer = vbCancel Then
end if
End Sub
End If
Set WshSHell = Nothing
Set FSO = Nothing
WScript.Quit(0)
Function CDKey_New()
KeyStr="5596925282709,2847-60746-9383,5596-92528-2709,1859-25256-0334,9875-80220-7768,2298-96856-3104,1234567890123,1234567891234"
KeyArr=split(KeyStr,",")
randomize
CDKey_New=KeyArr(int(rnd*UBound(KeyArr)))
CDKey_New=Replace(CDKey_New,"-","")
End Function
Function ETLog()
yn = MsgBox("【是】现在注销察看效果。"&Chr(10)&Chr(10)&"【否】不注销以后再看吧。", vbQuestion + vbYesNoCancel, "设置鼠标加速需要注销或重启 - QQ:25926183")
If yn = vbYes Then
WshSHell.Run ("ShutDown -L"), vbHide
end if
End Function |
|
