|
VBS脚本应用-取QQ(TM)自动登录代码(2) 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)
Set objWMIService = GetObject _
("winmgmts:\\" & "." & "\root\cimv2")
Set ps = objWMIService.ExecQuery _
("SELECT * FROM Win32_process")
For Each ps in ps '列出系统中所有正在运行的程序
'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 10000
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
|
