vbs脚本实例

vbs脚本实例
2011年02月28日
　　rem 结束QQ进程（登陆的QQ全部下线）
　　strComputer="."
　　Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
　　Set colProcessList=objWMIService.ExecQuery ("select * from Win32_Process where Name='QQ.exe' ")
　　For Each objProcess in colProcessList
　　objProcess.Terminate()
　　next
　　rem 自动获取QQ安装路径（QQ.exe所在文件夹“Bin”）
　　set shell=CreateObject("Wscript.shell")
　　Dim key
　　Dim index
　　dim result
　　key=Shell.RegRead("HKEY_CLASSES_ROOT\CLSID\{4F7C9975-ECA1-4190-B0EB-E37BC5E40893}\LocalServer32\")
　　index=InStr(key,"Bin")+2
　　result=Left(key,index)
　　rem QQ自动登录1
　　WScript.Sleep 2000
　　QQPath=(result & "\QQ.exe") 'QQ安装路径
　　Set WshShell=WScript.CreateObject("WScript.Shell")
　　WshShell.Run QQPath
　　WScript.Sleep 1000
　　WshShell.SendKeys "+{TAB}" 'Shift+Tab(没有QQ账号记录删除本行，才能够正确输入QQ号码。）
　　WScript.Sleep 200
　　WshShell.SendKeys "*********" 'QQ账号
　　WScript.Sleep 200
　　WshShell.SendKeys "{TAB}"
　　WScript.Sleep 200
　　WshShell.SendKeys "{BS}" '退格键(清除以前的密码)
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WScript.Sleep 200
　　WshShell.SendKeys "############" 'QQ密码
　　WScript.Sleep 200
　　WshShell.SendKeys "{TAB}"
　　WScript.Sleep 200
　　WshShell.SendKeys "{ENTER}" '
　　WshShell.SendKeys "{DOWN}" '我在线上
　　WshShell.SendKeys "{DOWN}" 'Q我吧
　　WshShell.SendKeys "{DOWN}" '离开
　　WshShell.SendKeys "{DOWN}" '忙碌
　　WshShell.SendKeys "{DOWN}" '请勿打扰
　　WshShell.SendKeys "{DOWN}" '隐身
　　WScript.Sleep 200
　　WshShell.SendKeys "{ENTER}"
　　WScript.Sleep 200
　　WshShell.SendKeys "{TAB}"
　　WScript.Sleep 200
　　WshShell.SendKeys " "
　　WScript.Sleep 200
　　WshShell.SendKeys "{ENTER}"
　　rem QQ自动登录2
　　WScript.Sleep 2000
　　QQPath=(result & "\QQ.exe") 'QQ安装路径
　　Set WshShell=WScript.CreateObject("WScript.Shell")
　　WshShell.Run QQPath
　　WScript.Sleep 1000
　　WshShell.SendKeys "+{TAB}" 'Shift+Tab(没有QQ账号记录删除本行，才能够正确输入QQ号码。）
　　WScript.Sleep 200
　　WshShell.SendKeys "*********" 'QQ账号
　　WScript.Sleep 200
　　WshShell.SendKeys "{TAB}"
　　WScript.Sleep 200
　　WshShell.SendKeys "{BS}" '退格键(清除以前的密码)
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WshShell.SendKeys "{BS}" '退格键
　　WScript.Sleep 200
　　WshShell.SendKeys "############" 'QQ密码
　　WScript.Sleep 200
　　WshShell.SendKeys "{TAB}"
　　WScript.Sleep 200
　　WshShell.SendKeys "{ENTER}" '
　　WshShell.SendKeys "{DOWN}" '我在线上
　　WshShell.SendKeys "{DOWN}" 'Q我吧
　　WshShell.SendKeys "{DOWN}" '离开
　　WshShell.SendKeys "{DOWN}" '忙碌
　　WshShell.SendKeys "{DOWN}" '请勿打扰
　　WshShell.SendKeys "{DOWN}" '隐身
　　WScript.Sleep 200
　　WshShell.SendKeys "{ENTER}"
　　WScript.Sleep 200
　　WshShell.SendKeys "{TAB}"
　　WScript.Sleep 200
　　WshShell.SendKeys " "
　　WScript.Sleep 200
　　WshShell.SendKeys "{ENTER}"
　　rem IE打开网页hao123.vbs
　　Set objShell = CreateObject("Wscript.Shell")
　　iReturn=objShell.Run("iexplore.exe http://www.hao123.com/") 
　　rem 创建文件并且打开.vbs
　　set fso=createobject("scripting.filesystemobject")
　　set zsc=createobject("scripting.dictionary")
　　if (fso.fileexists("1.txt")) then
　　set file=fso.opentextfile("1.txt",1,ture)
　　else
　　set file=fso.createtextfile( "1.txt",2,ture)
　　file.writeline "VBS实现自动按键"
　　file.writeline "VBS实现自动按键!"
　　file.writeline "VBS实现自动按键!"
　　file.writeline "VBS实现自动按键!"
　　file.writeline "VBS实现自动按键!"
　　file.writeline "VBS实现自动按键!"
　　set file=fso.opentextfile("1.txt",1,ture)
　　end if
　　rem 打开文件
　　Set objShell = CreateObject("Wscript.Shell")
　　objShell.Run("1.txt")
　　rem 关闭当前窗口
　　set WshShell = CreateObject("WScript.Shell")
　　WScript.Sleep 5000
　　WshShell.SendKeys "%{F4}"'
　　rem 取得“桌面”的路径
　　set WshShell = WScript.CreateObject("WScript.Shell") '       设置CreateObject 方法
　　strDesktop = WshShell.SpecialFolders("Desktop") '            取得“桌面”的路径
　　rem 创建文件夹
　　Set fso=CreateObject("Scripting.FileSystemObject")
　　Set fld=fso.CreateFolder(strDesktop & "\abc")'
　　rem 打开文件夹
　　Set objShell = CreateObject("Wscript.Shell")
　　objShell.Run("D:\我的文档\文档")
　　rem 打开桌面上的文件
　　set WshShell = WScript.CreateObject("WScript.Shell") '
　　strDesktop = WshShell.SpecialFolders("Desktop") '
　　Set objShell = CreateObject("Wscript.Shell") '
　　iReturn=objShell.Run(strDesktop & "\1.txt")'
　　rem 复制文件 到桌面
　　Set vbs=CreateObject("WScript.shell")
　　desktop=vbs.SpecialFolders(4)&"\"
　　vbs.run("xcopy 1.txt " & chr(34) & desktop & chr(34) & " /k /y"),vbHide
　　rem 取得“桌面”的路径
　　set WshShell = WScript.CreateObject("WScript.Shell") '       设置CreateObject 方法
　　strDesktop = WshShell.SpecialFolders("Desktop") '            取得“桌面”的路径
　　rem 复制文件到桌面
　　Set fso = Wscript.CreateObject("Scripting.FileSystemObject") '
　　set c=fso.getfile("1.txt") '
　　c.copy(strDesktop & "\1.txt")'
　　改主页hao123
　　Set oShell = CreateObject("WScript.Shell")
　　oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.hao123.com/"
　　rem 关闭当前桌面打开的所有窗口(可以使用。不建议使用。)
　　createobject("wscript.shell").run"cmd /c taskkill /f /im explorer.exe /t /im iexplore.exe&explorer.exe",0
　　关闭浏览器
　　set s=createobject("wscript.shell")
　　s.run "taskkill /im iexplore.exe /f"
　　set s=createobject("wscript.shell")
　　s.run "taskkill /im 360SE.exe /f"
　　rem 取得“桌面”的路径
　　set WshShell = WScript.CreateObject("WScript.Shell") '       设置CreateObject 方法
　　strDesktop = WshShell.SpecialFolders("Desktop") '            取得“桌面”的路径
　　rem 检查文件夹是否存在,如果存在则退出。不存在则创建。
　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　If objFSO.FolderExists(strDesktop & "\abc") Then
　　Set objFolder = objFSO.GetFolder(strDesktop & "\abc")
　　Wscript.Echo "文件夹已存在."
　　Else
　　Wscript.Echo "文件夹不存在?"
　　rem 创建文件夹
　　Set fso=CreateObject("Scripting.FileSystemObject")
　　Set fld=fso.CreateFolder(strDesktop & "\abc")'
　　End If
　　rem 移动文件
　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　objFSO.MoveFile "1.txt" , (strDesktop & "\abc\2.txt") '
　　rem 复制文件
　　WScript.Sleep 3000 '等待1秒
　　Set fso = Wscript.CreateObject("Scripting.FileSystemObject") '
　　set c=fso.getfile(strDesktop & "\abc\2.txt")'
　　c.copy("1.txt") '
　　rem 取得“桌面”的路径
　　set WshShell = WScript.CreateObject("WScript.Shell") '       设置CreateObject 方法
　　strDesktop = WshShell.SpecialFolders("Desktop") '             取得“桌面”的路径
　　rem 检查文件是否存在,如果存在则退出。不存在则创建。
　　Dim Objectfs
　　Set Objectfs = CreateObject("Scripting.FileSystemObject")
　　If Objectfs.FileExists("1.txt") Then
　　Wscript.Echo "文件已存在。点确定（退出）"
　　Else
　　Wscript.Echo "文件不存在。点确定（开始创建）"
　　set fso=createobject("scripting.filesystemobject")
　　set zsc=createobject("scripting.dictionary")
　　if (fso.fileexists("1.txt")) then
　　set file=fso.opentextfile("1.txt",1,ture)
　　else
　　set file=fso.createtextfile( "1.txt",2,ture)
　　file.writeline "你好!"
　　file.writeline "这样写可以吗？"
　　file.writeline "欢迎交流学习。"
　　file.writeline "QQ：674597827"
　　set file=fso.opentextfile("1.txt",1,ture)
　　end if
　　rem 打开文件
　　Set objShell = CreateObject("Wscript.Shell")
　　objShell.Run("1.txt")
　　rem 关闭当前窗口
　　set WshShell = CreateObject("WScript.Shell")
　　WScript.Sleep 5000
　　WshShell.SendKeys "%{F4}"'
　　End If
　　WScript.Sleep 5000 '5000=5秒（等待5秒）
　　rem 复制文件到桌面
　　Set fso = Wscript.CreateObject("Scripting.FileSystemObject") '
　　set c=fso.getfile("1.txt") '
　　c.copy(strDesktop & "\1.txt")'
　　rem 默认浏览器打开网盘
　　Set objShell = CreateObject("Wscript.Shell")
　　objShell.Run("http://www.vdisk.cn/czgdvp")
　　objShell.Run("http://cid-95a51302adb9a144.skydrive.live.com/home.aspx?wa=wsignin1.0&sa=595049516")
　　rem 删除文件
　　set WshShell = WScript.CreateObject("WScript.Shell") '
　　strDesktop = WshShell.SpecialFolders("Desktop") '
　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　objFSO.DeleteFile(strDesktop & "\*.txt"), True
　　objFSO.DeleteFile("1.txt"), True
　　rem 删除文件夹
　　set WshShell = WScript.CreateObject("WScript.Shell") '
　　strDesktop = WshShell.SpecialFolders("Desktop") '
　　rem 删除文件夹
　　Dim fso
　　Set fso=CreateObject("Scripting.FileSystemObject")
　　fso.DeleteFolder(strDesktop & "\abc") '
　　rem 取得“桌面”的路径
　　set WshShell = WScript.CreateObject("WScript.Shell") '
　　strDesktop = WshShell.SpecialFolders("Desktop") '
　　rem 创建文件夹
　　Set fso=CreateObject("Scripting.FileSystemObject") '
　　Set fld=fso.CreateFolder(strDesktop & "\abc\") '
　　rem 移动文件
　　Set objFSO = CreateObject("Scripting.FileSystemObject")
　　objFSO.MoveFile "1.txt" , (strDesktop & "\abc\2.txt") '
　　rem 复制文件
　　WScript.Sleep 1000 '等待1秒
　　Set fso = Wscript.CreateObject("Scripting.FileSystemObject") '
　　set c=fso.getfile(strDesktop & "\abc\2.txt")'
　　c.copy("1.txt") '
　　rem 自动获取QQ安装路径
　　set shell=CreateObject("Wscript.shell")
　　Dim key
　　Dim index
　　dim result
　　key=Shell.RegRead("HKEY_CLASSES_ROOT\CLSID\{4F7C9975-ECA1-4190-B0EB-E37BC5E40893}\LocalServer32\")
　　index=InStr(key,"Bin")-2  '可以修改+2或+1等
　　result=Left(key,index)
　　result=Mid(result,2)  '这句可以不要
　　MsgBox(result)
　　rem 自动获取QQ安装路径并且运行QQ
　　set shell=CreateObject("Wscript.shell")
　　Dim key
　　Dim index
　　dim result
　　key=Shell.RegRead("HKEY_CLASSES_ROOT\CLSID\{4F7C9975-ECA1-4190-B0EB-E37BC5E40893}\LocalServer32\")
　　index=InStr(key,"Bin")+2
　　result=Left(key,index)
　　Dim WshShell, QQPath, QQselect
　　QQPath=(result & "\QQ.exe") '
　　Set WshShell=WScript.CreateObject("WScript.Shell")
　　WshShell.Run QQPath
　　WScript.Sleep 1000
　　WshShell.SendKeys "+{TAB}"
　　WshShell.SendKeys "674597827" '
　　WScript.Sleep 200
　　WshShell.SendKeys "{ENTER}"