中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名：www.cn-dos.net 论坛域名：www.cn-dos.net/forum
DOS，代表着自由开放与发展，我们努力起来，学习FreeDOS和Linux的自由开放与GNU精神，共同创造和发展美好的自由与GNU GPL世界吧！

游客: 注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »

中国DOS联盟论坛 » DOS批处理 & 脚本技术（批处理室） » CS反恐的优化→VBS版

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『楼主』: CS反恐的优化→VBS版

下载优化CS反恐

①设置屏幕”垂直同步“功能。
②锁定屏幕”刷新“频率。
③随机更换CD－Key。
④取消XP中对鼠标的加速。

好多菩提树，好多明镜台。本来好多物，好多的尘埃。

2007-4-30 15:33

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 2 楼』:

ÿ

Quote:

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

[ Last edited by baomaboy on 2008-3-24 at 11:40 PM ]

此帖被 +8 点积分

点击查看详情

好多菩提树，好多明镜台。本来好多物，好多的尘埃。

2007-4-30 15:35

flyinspace
银牌会员

积分 1206
发帖 517
注册 2007-3-25
状态离线

『第 3 楼』:

建议：做成一个网页的形式。。

这样才好用嘛：）

知，不觉多。不知，乃求知

2007-4-30 15:39

baomaboy
银牌会员

积分 1513
发帖 554
注册 2005-12-30
状态离线

『第 4 楼』:

Quote:

Originally posted by flyinspace at 2007-4-30 15:39:
建议：做成一个网页的形式。。

这样才好用嘛：）

呵呵我又不象flyinspace兄哪种语言都会，HTML很久不用了，而且懒了，对我而言那可是纯体力活，我现在写个VBS还弄个模版呢，以至于代码中会有多余的无用码，哪还有心尝试捡起HTML呢。zh159兄的HTML才N呢，找他做吧，^_^

好多菩提树，好多明镜台。本来好多物，好多的尘埃。

2007-4-30 15:52

zh159
金牌会员

积分 3687
发帖 1467
注册 2005-8-8
状态离线

『第 5 楼』:

收藏脚本，5.1有空再分析分析，看看能不能做个hta的

2007-4-30 15:58

beeny
初级用户

积分 136
发帖 49
注册 2007-1-4
状态离线

『第 6 楼』:

看到这些个代码就晕了·
你们学的时候是怎么学的给我个方法？

2007-6-24 15:05

slore
铂金会员

积分 5212
发帖 2478
注册 2007-2-8
状态离线

『第 7 楼』:

{E76B2350-59A0-4943-BCA7-81B2185F518F}不是固定的吧。。。
像这个我的就不是……

就加速和CDKEY可以用吧。

CDKEY也是有限个数＝。＝8个都冲突了怎么办呀……

2007-6-24 15:39

vivi
新手上路

积分 18
发帖 7
注册 2007-6-12
状态离线

『第 8 楼』:

好东西，谢谢楼主分享。收下了。

2007-6-24 16:18

78586862
初级用户

积分 25
发帖 14
注册 2006-10-28
状态离线

『第 9 楼』: 关于CS优化

你好，我想问一下，因为网吧的网上邻居都是隐藏起来或者禁止访问的，请问怎么样修改VBS代码才可以直接关闭掉显卡垂直同步呢？

2007-6-29 12:22

请注意：您目前尚未注册或登录，请您注册或登录以使用论坛的各项功能，例如发表和回复帖子等。

可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题

论坛跳转: