vb常用代码
修改本地管理员密码
Set objcnlar = GetObject("WinNT://./administrator, user")
objcnla.SetPassword "P@ssW0rd"
objcnla.SetInfo
弹出 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 obshell=wscript.createobject("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 c=fso.getfile("%path%") ’拷贝某文件
c.copy("%PATH2%") '拷贝文件到指定地点
fso.deletefile("%PATH%") '删除文件
Wscript.quit
eg.
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set f=fso.CreateTextFile("C:\Sample.txt")
WriteLine("VBS")
f.close
set e=fso.getfile(C:\Sample.txt)
e.copy("D:\Sample.txt")
fso.deletefile(C:\Sample.txt)
Wscript.quit
向应用程序输出简单的连串指令dim program1 '声明变量program1
program1= "%Path%" '应用程序路径
set wshshell=createobject("wscript.shell") '声明饮用函数
set oexec=wshshell.exec(program1) '运行程序
wscript.sleep 2000 '(该行命令未知作用.估计是设定延迟，请高手指点)
wshshell.appactivate "%WindowsName%" '激活运用程序窗口
wshshell.sendkeys "+{%KeyBoardName%}" '第一次输出键盘按键指令前要加+
wshshell.sendkeys "555555" '在程序输入栏中输入运用该系列命令须首先确定程序可以实施连串的键盘操作，这在QQ登录中最适用，如下例。
eg.
dim program1
program1="D:\Program Files\Tencent\coralQQ.exe"
set wshshell=CreateObject("wscript.shell")
set oexec=wshshell.exec(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%) 类似于“绑定目标”
e.copy("%PATH2%") 复制文件夹
fso.deletefolder(%PATH%) 删除文件夹
eg.
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateObject("C:\sample")
f.copy("D:\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 ’设置常数值
(当该值为8时另存为HTML文档，为11时另存为XML文档)
Set objWord = CreateObject("Word.Application") '申明调用函数
Set objDoc = objWord.Documents.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:\doc1.txt", wdFormatText
objWord.Quit
rem 获取MAC：
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colNicConfigs = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True")
For Each objNicConfig In colNicConfigs
msgbox "本机 MAC：" & objNicConfig.MACAddress,64,"MAC"
next
'绑定ARP最好用WshShell.Run "ARP -S................" 。
改ip、dnsrem 改ip、dns
Netsh interface ip Set Dns Name=本地连接 Source=static addr=192.168.0.1
Set shell = Wscript.createobject("wscript.shell")
a = shell.run ("route change 0.0.0.0 mask 0.0.0.0 192.168.0.254",0)
'gw为网关地址.mac为物理地址.dns为DNS地址
gw="192.168.0.254"
mac="00-0e-0c-7f-53-db"
dns="192.168.0.1"
Set objShell = CreateObject("WScript.Shell")
objShell.Run "arp -s "+gw+" "+mac
objShell.Run "Netsh interface ip Set Dns Name=本地连接 Source=static addr="&dns
改ip、dnsSet shell = Wscript.createｏｂｊｅｃｔ("wscript.shell")
a = shell.run ("route change 0.0.0.0 mask 0.0.0.0 192.168.0.254",0)
gw为网关地址.mac为物理地址
gw="192.168.0.254"
mac="00-0e-0c-7f-53-db"
Set objShell = CreateObject("WScript.Shell")
objShell.Run "arp -s "+gw+" "+mac
改ip、dns-修正Option Explicit
Dim objWMIService,colItems,objItem,objAddress,IPAddress,Arrstrnum,strnum
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objItem in colItems
For Each objAddress in objItem.IPAddress
If objAddress <> "" then
IPAddress = objAddress
Exit For
End If
Next
Next
Arrstrnum = Split(objAddress,".",-1)
strnum = Right("000"&Arrstrnum(3),3)
'On Error Resume Next
Dim serverip,oshell,fso
serverip="192.168.0.106"
Set oshell= CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.fileexists(oshell.ExpandEnvironmentStrings("%WinDir%")+"\system32\iscsicpl.cpl") Then
oshell.run "iscsicli AddTargetPortal "&serverip&" 3260",0,1
oshell.run "iscsicli LoginTarget "&strnum&" T * * * * * * * * * * * * * * * 0",0,1
End If
'最好还是根据机器名来处理，因为机器名是唯一的，而一台机器可能有几个IP。而且用机器名的话脚本会简单很多。
导入注册表'导入注册表
Dim WShell
Set WShell = WScript.CreateObject("WScript.Shell")
WShell.Run "regedit /s 指定的注册表文件.reg",0,true
WShell.Run "iexplore
http://www.mcse.org.cn"
创建文件夹Set objFSO = CreateObject("Scripting.FileSystemObject")
ParentFolder = "D:\333\"
set objShell = CreateObject("Shell.Application")
set objFolder = objShell.NameSpace(ParentFolder)
If objFSO.FolderExists("D:\333\Desktop") Then
...
else
objFolder.NewFolder "Desktop"
End If
改名vb'批量改桌面的某一快捷方式的名子,请问VBS如何写
'其实批量你只有让每台机执行到那个脚本就好了，改桌面的某一快捷方式的名字的脚本：
On Error Resume Next
set wshshell=wscript.createObject("wscript.shell")
wshshell.run ("%comspec% /c ren a.lnk b.lnk"),0,True
rem 网吧修改机器名ip网关
'-----------------------------------------------------------------------------------
Const Setmpnum="N"
Const Setname="Y-" '计算机名前缀
Const Setip="192.168.1.0" 'IP地址前缀,192.168.x.x
Const Setyan="255.255.255.0" '子网掩码
'-----------------------------------------------------------------------------------
'以下程序最好不要更改:
'<Main> 主程序开始
'提示输入计算机编号
Dim ID,Name
ID = inputbox("请输入此计算机的数字编号","男孩女孩网吧")
if ID>0 and ID<10 then
Name="0" & ID
elseif ID>=10 and ID<255 then
Name=ID
elseif ID>=255 then
Msgbox "输入无效--脚本退出",48,"错误提示"
else
WScript.Quit
end if
'调用WMI修改IP,子网掩码,计算机名,IPX网络号
wmitoip(Name)
'将信息写入注册表
voidWriteIPToReg(Name)
'关闭计算机
'voidShutDown()
'<Main End>主程序结束
'生成CDKEY
Function getcskey(j)
Dim fso,ts,count
Set fso=CreateObject("Scripting.FileSystemObject")
if fso.fileexists(".\cdkey.txt") then
Set ts=fso.OpenTextFile(".\cdkey.txt",1)
for count=1 to Name
ts.skipline
next
getcskey=trim(ts.ReadLine)
else
Msgbox("读取CD-KEY错误-未找到CDkey.txt")
end if
end function
'调用WMI修改IP,子网掩码,计算机名,IPX网络号
sub wmitoip(ab)
strComputer="."
Set objWMIService=GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colNetAdapters=objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
strIPAddress=Array(setip & ab)
strSubnetMask=Array(setyan)
For Each objNetAdapter in colNetAdapters
errEnable=objNetAdapter.EnableStatic(strIPAddress, strSubnetMask)
Next
Set objWMIService=GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colComputers=objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
For Each objComputer in colComputers
ObjComputer.Rename(setname & ab)
Next
Set objWMIService=GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colComputers=objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
Set objNetworkSettings=objWMIService.Get("Win32_NetworkAdapterConfiguration")
objNetworkSettings.SetIPXVirtualNetworkNumber(ab)
end sub
'将信息写入注册表
sub voidWriteIPToReg(ab)
Dim WshShell
'生成CDKEY
cskey=getcskey(Name)
Set WshShell=WScript.CreateObject("WScript.Shell")
'美萍机号
if Setmpnum="Y" then WshShell.RegWrite"HKLM\Software\Mpsoft\Smenu\computernum",ab,"REG_SZ"
'CD-KEY
WshShell.RegWrite"HKCU\Software\Valve\CounterStrike\Settings\key",cskey,"REG_SZ"
Set Wshell=Nothing
End sub
Dim WSH,System,ComputerName,User,WorkGroup,Cskey
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = WScript.CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")
OPName=WSH.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName")
CSKEY=Wsh.RegRead("HKCU\Software\Valve\CounterStrike\Settings\key")
ComputerName= + WshNetwork.ComputerName
User= + WshNetwork.UserName
Buf = "操作系统:" + OPName + vbCrLf
Buf = Buf + "计算机名:" + ComputerName + vbCrLf
Buf = Buf + "工作组名:" + WorkGroup + vbCrLf
Buf = Buf + "IP 地 址:" + IPAddress + vbCrLf
Buf = Buf + "使用网关:" + Gateway + vbCrLf
Buf = Buf + "子网掩码:" + Setyan + vbCrLf
Buf = Buf + "DNS域 名:" + NameServer + vbCrLf
Buf = Buf + "CS-CDKey:" + CSKey + vbCrLf
Buf = Buf + "系统用户:" + User + vbcrLf
Buf = Buf + "" + vbCrLf
Buf = Buf + "" + vbCrLf
Buf = Buf + "提示:脚本程序设置完毕--请你仔细检查一遍" + vbCrLf
Buf = Buf + "" + vbCrLf
MSGBox Buf,0,"设置报告"
'关闭计算机
sub voidShutDown()
Set WshShell=WScript.CreateObject("WScript.Shell")
WshShell.Run"rundll32.exe user.exe,ExitWindows",0,False
Set Wshell=Nothing
End sub
网络共享映射dim WshNetwork
Set WshNetwork = WScript.CreateObject("WScript.Network")
If fso.DriveExists("X:") Then
WSHNetwork.RemoveNetworkDrive "X:",True,True
WSHNetwork.MapNetworkDrive "X:", "\\server\共享$"
else
WSHNetwork.MapNetworkDrive "X:", "\\server\共享$"
end if
Set WshNetwork = Nothing
WScript.quit
rem 映射-访问共享机时要输入用户名
dim WshNetwork,WSH
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set Wsh = WScript.CreateObject("WScript.Shell")
If fso.DriveExists("X:") Then
WSHNetwork.RemoveNetworkDrive "X:",True,True
WSHNetwork.MapNetworkDrive "X:", "[url=file://\\server\]\\server\[/url]共享$",true,"这里改成你的用户名"，"这里改成你的密码"
else
WSHNetwork.MapNetworkDrive "X:", "[url=file://\\server\]\\server\[/url]共享$",true,"这里改成你的用户名"，"这里改成你的密码"
end if
Wsh.run "X:\"
Set Wsh = Nothing
Set WshNetwork = Nothing
WScript.quit
延时执行Set oshell= CreateObject("WScript.Shell")
wscript.sleep 300000
oshell.run "1.bat"