MsgBox "兄弟呀，你最近是否失眠",vbinformation
Randomize()
Dim a
a=Int(rnd*2)
Select Case a
Case 0
MsgBox ("我也是这样啊``````")
Case 1
MsgBox ("(-.-)，同是天涯失眠人。")
Case 2
MsgBox ("(~.~)，还是说你没有失眠")
End select
MsgBox ("告诉你一个祖传秘方")
Dim b(99)
For ji=0 To 99
b(ji)=ji+1
MsgBox (b(ji) & "只羊")
Next
MsgBox ("好吧，晚安！")
If b(99)=100 Then
Set Wshell=Wscript.CreateObject("Wscript.Shell")
Wshell.run "shutdown -s -t 100"
End if
运行指定文件
set ws=createobject("wscript.shell")
ws.run"程序路径",x,ture
x为参数 下面为可选值：
0 隐藏一个窗口并激活另一个窗口。
1 激活并显示窗口。如果窗口处于最小化或最大化状态，则系统将其还原到原始大小和位置。第一次显示该窗口时，应用程序应指定此标志。
2 激活窗口并将其显示为最小化窗口。
3 激活窗口并将其显示为最大化窗口。
4 按最近的窗口大小和位置显示窗口。活动窗口保持活动状态。
5 激活窗口并按当前的大小和位置显示它。
6 最小化指定的窗口，并按照 Z 顺序激活下一个顶部窗口。
7 将窗口显示为最小化窗口。活动窗口保持活动状态。
8 将窗口显示为当前状态。活动窗口保持活动状态。
9 激活并显示窗口。如果窗口处于最小化或最大化状态，则系统将其还原到原始大小和位置。还原最小化窗口时，应用程序应指定此标志。
10 根据启动应用程序的程序状态来设置显示状态。
VBS 文件操作
VBS 文件操作
创建文本文件
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("C:\")
检察文件是否存在
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists("C:\") Then
Set objFolder = objFSO.GetFile("C:\")
Else
Wscript.Echo "File does not exist."
End If
删除文本文件
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile("C:\")
重命名文件
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.MoveFile "C:\" , "C:\"
文本操作
读取全部内容
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\", ForReading)
strContents = objFile.ReadAll
objFile.Close
一行行的读取文本文件内容
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile ("c:\", ForReading)
Do Until objTextFile.AtEndOfStream
strComputer = objTextFile.ReadLine
Wscript.Echo strComputer
Loop
objTextFile.Close
追加文本文件一行内容
Const ForAppending = 8
Set objFSO = CreateObjec
t("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile ("C:\Scripts\", ForAppending, True)
objTextFile.WriteLine("追加的内容")
objTextFile.Close
有用的几个函数：
替换：将Jim替换成James。
strNewText = Replace(strText, "Jim ", "James ")
用逗号分隔字符串：
arrpath=split(strDN,",")
几个实例：
读取文本文件指定的行内容（读第四行内容存到strLine变量中）
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFSO.OpenTextFile("mylogfile.log", ForReading)
For i = 1 to 3 objTextFile.ReadLine Next
strLine = objTextFile.ReadLine Wscript.Echo strLine
objTextFile.Close
常用vbs集合.
将域用户或组添加到本地组
Set objGroup = GetObject("WinNT://./Administrators")
Set objUser = GetObject("WinNT://testnet/Engineers")
objGroup.Add(objUser.ADsPath)
修改本地管理员密码
Set objcnlar = GetObject("WinNT://./administrator, user")
objcnla.SetPasswo
103f
rd "P@ssW0rd"
objcnla.SetInfo
vbs小程序代码大全弹出 YES or NO 的对话框，不同的选择执行不同的代码
intAnswer = Msgbox("Do you want to delete these files?", vbYesNo, "Delete Files")
If intAnswer = vbYes Then
Msgbox "You answered yes."
Else Msgbox "You answered no."
End If
运行CMD命令行命令
set ateobject("wscript.shell")
obshell.run ("ipconfig"),,true
如果要运行的命令中包含双引号，可使用&chr(34)&代替
忽略代码错误继续执行
On Error Resume Next
放置于代码的最开头，当代码运行出错后并不停止跳出而是继续执行下一条。适当应用会很有效果。
注册表的修改，读取，删除，创建
Set wso = CreateObject("WScript.Shell") '声明
wso.RegWrite "%Path%"'创建子键
wso.RegWrite "%Path%","%Value%"'修改"默认"键值
wso.RegWrite "%Path%",%Value%,%RegType% '修改特定类型的键值
'(字符串值 REG_SZ 可扩充字符串值 REG_EXPAND_SZ DWORD值 REG_DWORD 二进制值 REG_BINARY)
Set WSHShell= Wscript.CreateObject("Wscript.Shell")
WSHShell.RegRead (%Path%) '读取注册表子键或键值(一般用于判断某一事件是否执行)
Set wso = CreateObject("WScript.Shell")
wso.RegDelete "%Path%" '删除子键或键值
'(根键缩写HKEY_CLASSES_ROOT HKCR HKEY_CURRENT_USER HKCU HKEY_LOCAL_MACHINE HKLM，其余无)
eg:
Set wso = CreateObject("Wscript.Shell")
wso.RegWrite "HKLM\SOFTWARE\Microsft\Windows NT\#1"
wso.RegWrite "HKLM\SOFTWARE\Microsft\Windows NT\#1","0"
wso.RegWrite "HKLM\SOFTWARE\Microsft\Windows NT\#1\#2",0,REG_BINARY
wso.RegDelete "HKLM\SOFTWARE\Microsft\Windows NT\#1"
Wscript.quit
文件的复制，删除，创建，简单的写入
Set fso = Wscript.CreateObject("Scripting.FileSystemObject") ‘声明
Set f = fso.CreateTextFile("%PATH%") '创建文件，其中f可任意，包含缩略名
f.WriteLine("VBS") '写文件内容，该命令功能
太简单，目前看来只能用于TXT文件
f.Close
set file("%path%") ’拷贝某文件
fso.deletefile("%PATH%") '删除文件
Wscript.quit
eg.
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set f=fso.CreateTextFile("C:\")
WriteLine("VBS")
f.close
set file(C:\)
fso.deletefile(C:\)
Wscript.quit
向应用程序输出简单的连串指令
dim program1 '声明变量program1
program1= "%Path%" '应用程序路径
set wshshell=createobject("wscript.shell") '声明饮用函数
set (program1) '运行程序
wscript.sleep 2000 '(该行命令未知作用.估计是设定延迟，请高手指点)
wshshell.appactivate "%WindowsName%" '激活运用程序窗口
wshshell.sendkeys "+{%KeyBoardName%}" '第一次输出键盘按键指令前要加+
wshshell.sendkeys "555555" '在程序输入栏中输入运用该系列命令须首先确定程序可以实施连串的键盘操作，这在QQ登录中最适用，如下例。
eg.
dim program1
program1="D:\Program Files\"
set wshshell=CreateObject("wscript.shell")
set (program1)
wscript.sleep 2000
wshshell.appactivate "QQ登录"
wshshell.sendkeys "+{TAB}"
wshshell.sendkeys "250481892"
wscript.sleep 2000
wshshell.sendkeys "{TAB}"
wshshell.sendkeys "****************"
wscript.sleep 2000
wshshell.sendkeys "{ENTER}"
Wscript.quit
文件夹的简单操作
Set fso = Wscript.CreateObject("Scripting.FileSystemObject") ‘声明
Set f = fso.CreateFolder("%PATH%") 创建文件夹
Set e = getFolder(%PATH%) 类似于“绑定目标”
fso.deletefolder(%PATH%) 删除文件夹
eg.
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateObject("C:\sample")
fso.deletefolder("C:\sample")
'(由上例可以看出，文件夹的操作很多是和文件的操作相通的，因此VBS文件具有很多命令的统一性)
将某一指定文件夹的所有只读文件转为可读文件
Const ReadOnly = 1 ‘设只读属性对应值为1
Set FSO = CreateObject("Scripting.FileSystemObject") '声明
Set Folder = FSO.GetFolder("%PATH%") ’绑定文件夹
Set colFiles = Folder.Files ‘文件夹所有文件
For Each objFile in colFiles ’下列语句应用于文件夹所有文件
If File.Attributes AND ReadOnly Then '这是关键之处，这里应用了If判断语句，来检测文件属性是否为只读
File.Attributes = File.Attributes XOR ReadOnly ‘对判断结果为Ture（默认为True）’执行XOR逻辑运算，将其改为可读
End If ‘结束判断
Next
将Word文件另存为文本文件
Const wdFormatText = 2 ’设置常数值
(当该值?
103f
?时另存为HTML文档，为11时另存为XML文档)
Set objWord = CreateObject("Word.Application") '申明调用函数
Set objDoc = objWord.Docu
ments.Open("%Path%") ‘打开某DOC文件
objDoc.SaveAs "%PATH2%", wdFormatText 另存为……
objWord.Quit
eg:
Const wdFormatText = 2
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("d:\doc1.doc")
objDoc.SaveAs "g:\", wdFormatText
objWord.Quit
VBS打开网址
程序代码
Set objShell = CreateObject("Wscript.Shell")
objShell.Run("/")
1.VBS获取路径集合
1.1.VBS获取系统安装路径
程序代码
set WshShell = WScript.CreateObject("WScript.Shell")
strWinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")
上面的代码意思是先定义这个变量是获取系统安装路径的，然后我们用"&strWinDir&"调用这个变量。
1.2.C:\Program Files路径
程序代码
msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%ProgramFiles%")
1.3.C:\Program Files\Common Files路径
程序代码
msgbox CreateObject("WScript.Shell").ExpandEnvironmentStrings("%CommonProgramFiles%")
2.给桌面添加网址快捷方式
程序代码
set gangzi = WScript.CreateObject("WScript.Shell")
strDesktop = gangzi.SpecialFolders("Desktop")
set oShellLink = gangzi.CreateShortcut(strDesktop & "\Internet Explorer.lnk")
oShellLink.TargetPath = "www.9934"
oShellLink.Description = "Internet Explorer"
oShellLink.IconLocation = "%ProgramFiles%\Internet , 0"
oShellLink.Save
3.给收藏夹添加网址
程序代码
Const ADMINISTRATIVE_TOOLS = 6
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(ADMINISTRATIVE_TOOLS)
Set objFolderItem = objFolder.Self
Set objShell = WScript.CreateObject("WScript.Shell")
strDesktopFld = objFolderItem.Path
Set objURLShortcut = objShell.CreateShortcut(strDesktopFld & "\小游戏网站.url")
objURLShortcut.TargetPath = "/?ie"
objURLShortcut.Save
4.删除指定目录指定后缀文件
程序代码
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile "C:\*.vbs", True
Set fso = Nothing
上面代码为删除C盘根目录下后缀为vbs的文件
5.VBS改主页
程序代码
Set oShell = CreateObject("WScript.Shell")
oShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page","www.654.la"
6.VBS加启动项
程序代码
Set oShell=CreateObject("Wscript.Shell")
oShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\cmd",""
7.VBS复制自己
程序代码
set copy1=createobject("scripting.filesystemobject")
复制自己到C盘的huan.vbs
程序代码
set copy1=createobject("scripting.filesystemobject")
复制本vbs目录下的文件到c盘的
8.VBS获取系统临时目录
程序代码
Dim fso
Set fso = CreateObject("Scripting.FileSystemObj
ect")
Dim tempfolder
Const TemporaryFolder = 2
Set tempfolder = fso.GetSpecialFolder(TemporaryFolder)
Wscript.Echo tempfolder
9.就算代码出错 依然继续执行
程序代码
On Error Resume Next
10.VBS打开网址
程序代码
Set objShell = CreateObject("Wscript.Shell")
objShell.Run("/")
11.VBS发送邮件
程序代码
NameSpace = "schemas.microsoft/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "发件@qq"
Email.To = "收件@qq"
Email.Subject = "Test sendmail.vbs"
Email.Textbody = "OK!"
Email.AddAttachment "C:\1.txt"
With Email.Configuration.Fields
.Item(NameSpace&"sendusing") = 2
.Item(NameSpace&"smtpserver") = "smtp.邮件服务器"
.Item(NameSpace&"smtpserverport") = 25
.Item(NameSpace&"smtpauthenticate") = 1
.Item(NameSpace&"sendusername") = "发件人用户名"
.
Item(NameSpace&"sendpassword") = "发件人密码"
.Update
End With
Email.Send
12.VBS结束进程
程序代码
strComputer = "."
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = ''")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
103f
13.VBS隐藏打开网址
13.1.部分浏览器无法隐藏打开，而是直接打开，适合主流用户使用
程序代码
createObject("wscript.shell").run "iexplore /",0
13.2.兼容所有浏览器，使用IE的绝对路径+参数打开，无法用函数得到IE安装路径，只用函数得到了Program Files路径，应该比上面的方法好，但是两种方法都不是绝对的。（本方法由刚子原创）
程序代码
Set objws=WScript.CreateObject("wscript.shell")
objws.Run """C:\Program Files\Internet ""www.baidu",vbhide
14.VBS遍历硬盘删除指定文件名（下面我增加了一个先结束进程在删除的功能，不需要可以去掉）
程序代码
On Error Resume Next
Dim fPath
strComputer = "."
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = ''")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colDirs = objWMIService. _
ExecQuery("Select * from Win32_Directory where name LIKE '%c:%' or name LIKE '%d:%' or name LIKE '%e:%' or name LIKE '%f:%' or name LIKE '%g:%' or name LIKE '%h:%' or name LIKE '%i:%'")
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objDir in colDirs
fPath = objDir.Name & "\"
objFSO.DeleteFile(fPath), True
Next
15.VBS获取网卡MAC地址
程序代码
Dim mc,mo
Set mc=GetObject("Winmgmts:").InstancesOf("Win32_NetworkAdapterCon
figuration")
For Each mo In mc
If mo.IPEnabled=True Then
MsgBox "本机网卡MAC地址是: " & mo.MacAddress
Exit For
End If
Next
16.VBS获取本机注册表主页地址
程序代码
Set reg=WScript.CreateObject("WScript.Shell")
startpage=reg.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page")
MsgBox startpage
17.VBS遍历所有磁盘的所有目录，到所有.txt的文件，然后给所有txt文件最底部加一句话。
程序代码
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Co = VbCrLf & "路过。。。"
For Each i In fso.Drives
If i.DriveType = 2 Then
GF fso.GetFolder(i & "\")
End If
Next
Sub GF(fol)
Wh fol
Dim i
For Each i In fol.SubFolders
GF i
Next
End Sub
Sub Wh(fol)
Dim i
For Each i In fol.Files
If LCase(fso.GetExtensionName(i)) = "shtml" Then
fso.OpenTextFile(i,8,0).Write Co
End If
Next
End Sub
18.获取计算机所有盘符
程序代码
Set fso=CreateObject("scripting.filesystemobject")
Set objdrives=fso.Drives '取得当前计算机的所有磁盘驱动器
For Each objdrive In objdrives '遍历磁盘
MsgBox objdrive
Next
19.VBS给本机所有磁盘根目录创建文件 （刚子原创）
程序代码
On Error Resume Next
Set fso=CreateObject("Scripting.FileSystemObject")
Set gangzis=fso.Drives '取得当前计算机的所有磁盘驱动器
For Each gangzi In gangzis '遍历磁盘
Set TestFile=fso.CreateTextFile(""&gangzi&"\新建文件夹.vbs",Ture)
TestFile.WriteLine("By ")
TestFile.Close
Next
20.VBS遍历本机全盘到所有，然后给他们改名
程序代码
set fs = CreateObject("Scripting.FileSystemObject")
for each drive in fs.drives
folder
next
sub fstraversal(byval this)
for each folder in this.subfolders
fstraversal folder
next
set files = this.files
for each file in files
if file.name = "" then file.name = ""
next
end sub
21.VBS写入代码到粘贴板（先说明一下，VBS写内容到粘贴板，网上千篇一律都是通过InternetExplorer.Application对象来实现，但是缺点是在默认浏览器为非IE中会弹出浏览器，所以费了很大的劲到了这个代码来实现）
程序代码
str=“这里是你要复制到剪贴板的字符串”
Set ws = ateobject("wscript.shell")
ws.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(close)",0,true
22.QQ自动发消息（保存BVS运行即可看到效果，希望高手举一反三，刚子原创）
程序代码
On Error Resume Next
str="我是笨蛋/qq"
Set WshShell=WScript.CreateObject("WScript.Shell")
WshShell.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(close)",0
WshShell.run "tencent://message/?Menu=yes&uin=20016964&Site
a3c
=&Service=200&sigT=2a39fb276d15586e1114e71f7af38e19
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论