绿色兵团 » QQ技术交流 » 利用VBS脚本让QQ永远在线

wd102185 发表于 2010-2-1 12:07

利用VBS脚本让QQ永远在线

[i=s] 本帖最后由 王世玉 于 2010-4-25 20:56 编辑 [/i]

让QQ"永远"运行
自从QQ出现了等级制度之后，现在有不少人都开始了疯狂挂级，希望在联机状态下始终运行QQ，即便被人关闭也能自动启动登录，而且还要防止因异常错误而退出。其实这些事情我们可以使用两个VBS脚本来实现这一目的。

1.QQ自动登录脚本
set fso = Wscript.createObject("Scripting.FileSystemObject")
Set f = fso.createTextFile("QQ自动登录.bat",true)
f.WriteLine "@echo off" & vbcrlf
for each ps in getobject("winmgmts:\\\\.\\root\\cimv2:win32_process").instances_ \'列出系统中所有正在运行的程序
if lcase(ps.name)="qq.exe" or lcase(ps.name)="tm.exe" then \'检测是否QQ或TM
QQCMD=ps.commandline \'提取QQ程序的命行
tmp=Replace(QQCMD,chr(34),space(1))
UIN1=instr(tmp,"QQUIN:")+6
if not len(UIN1)=0 then
QQUIN=mid(tmp,UIN1,instr(UIN1,tmp,space(1))-UIN1) \'取QQ号码.
QQ=QQ+1
QQNUM=QQNUM & "QQ号码" & QQ & ":" & vbtab & QQUIN & vbcrlf
f.WriteLine "ECHO QQ号码:" & QQUIN
f.WriteLine "ECHO 命令行:" & QQCMD
f.WriteLine QQCMD & vbcrlf
end if
end if
next
if not len(QQ)=0 then
MSGBOX "已经成功提取以下QQ号码的自动登录命令行" & vbcrlf & vbcrlf & QQNUM & vbcrlf & "具体请查看当前目录下的<QQ自动登录.bat>文件",0,"QQ自动
登录命令提取脚本 BY chenall QQ:XXXXXX"
else
msgbox "提取QQ自动登录命令失败,请查看QQ或TM是否正在运行.",0,"QQ自动登录命令提取脚本 BY chenall QQ:XXXXXX"
f.close
set f = fso.getfile("QQ自动登录.bat")
f.delete
end if
将这些代码存储为"*.vbs"文件。然后将所有需要自动登录的QQ号码全部登录，再在一个QQ上点击"菜单"→"一键切换到TM"。此后运行该VBS脚本，会发现在当前目录下生成了一个"QQ自动登陆.bat"的文件，运行该文件即可自动登录所有QQ号码。
小提示：代码中的"XXXXXX"代表你的QQ号。

2.QQ防止关闭脚本
dim QQUIN
for each ps in getobject("winmgmts:\\\\.\\root\\cimv2:win32_process").instances_ \'列出系统中所有正在运行的程序
if lcase(ps.name)="qq.exe" or lcase(ps.name)="tm.exe" then \'检测是否QQ或TM
AppPath=ps.commandline \'提取QQ程序的命行
tmp=Replace(AppPath,chr(34),space(1))
UIN1=instr(tmp,"QQUIN:")+6
QQUIN=mid(tmp,UIN1,instr(UIN1,tmp,space(1))-UIN1) \'取QQ号码.
end if
next
if len(QQUIN)=0 then
msgbox "系统中没有运行QQ或TM程序,请重新启动QQ或TM,登陆后再使用一键换切换一下QQ或TM程序,再运行本脚本"
else
do \'循环检测
myqqin=chkuin(QQUIN) \'检测上面提取出来的QQ号码是否有在本机打开
if not myqqin then \'如果没有运行则,重新运行QQ程序并登录
runapp(AppPath) \'
wscript.sleep 10000 \'等待10秒
else
wscript.sleep 5000 \'等待5秒
end if
loop \'返回继续检测
end if

function RunApp(AppPath)
dim obj
set obj = createobject("WScript.Shell")
obj.exec(AppPath)
end function

function chkuin(QQUIN)
for each ps in getobject("winmgmts:\\\\.\\root\\cimv2:win32_process").instances_
if lcase(ps.name)="qq.exe" or lcase(ps.name)="tm.exe" then
AppPatht=ps.commandline
\'by chenall qq 368178720
tmp=Replace(AppPatht,chr(34),space(1))
UIN1=instr(tmp,"QQUIN:")+6
QQUINTMP=mid(tmp,UIN1,instr(UIN1,tmp,space(1))-UIN1)
if QQUINTMP=QQUIN then chkuin=true end if
end if
next
end function
将以上代码存储为"*.vbs"文件。而后登录QQ，一键切换到TM，再运行VBS脚本。此后，即使关闭了TM/QQ，它也会自动启动并登录至网络。经在Windows XP SP2系统上测试，完全有效。

卡顶车 发表于 2010-2-2 10:57

有点难啊看不懂:L

wd102185 发表于 2010-2-2 12:42

咋没人 顶啊

党魁 发表于 2010-2-2 13:00

不行啊
运行不了~~~

li90122008 发表于 2010-2-2 14:12

额。。。看不懂

q789q77 发表于 2010-2-4 13:31

网吧也可以啊？

31177778 发表于 2010-2-7 12:26

怎么实现啊

bingfeng 发表于 2010-3-31 15:12

看看了!!!!

tianxiaweigong 发表于 2010-4-19 10:10

不知道行不.先顶了在说吧

wl5238125 发表于 2010-4-19 21:26

代码有错误，改正下

vanvanren 发表于 2010-4-19 22:00

支持下
辛苦

guizhuwu24 发表于 2010-4-25 16:28

先顶再检查，嘿嘿嘿~~·

qhz520 发表于 2010-4-29 00:21

嗯 支持下

fengyujulong 发表于 2010-4-29 13:01

收藏了  感谢

a87913124 发表于 2010-4-29 22:50

要是真的，QQ就不值钱了啊

流年 发表于 2010-5-2 22:42

还以为真的可以呢

454667272 发表于 2010-5-3 09:22

顶，，不知道是否可行。。

douforster 发表于 2010-5-3 11:14

先看看是什么,有没用用用再说。

guizhuwu24 发表于 2010-5-3 13:48

看不懂啊…………

370811024 发表于 2010-6-9 10:29

晕，错误啊

查看完整版本: 利用VBS脚本让QQ永远在线