当前位置: 首页 > 图文教程 > 脚本技术 > VBScript > 常用VBS代码 值得一看

VBScript
VBS中SendKeys的基本应用
VBScript教程 第十四课在VBScript中使用对象
VBScript教程 第十三课 VBScript与窗体
VBScript教程 第十二课VBScript页面的简单样例
VBScript教程 第十一课深入VBScript
VBScript教程 第十课 VBScript编码约定
VBScript教程 第九课VBScript过程
VBScript教程 第八课 使用循环语句
VBScript教程 第七课使用条件语句
VBScript教程 第六课VBScript运算符
VBscript教程 第五课 VBScript常数
VBScript教程 第四课VBScript变量
VBScript教程 第三课VBScript数据类型
VBScript教程 第二课在HTML页面中添加VBscript代码
VBScript教程 第一课什么是VBScript
VBScript的入门学习资料
VBScript语法速查及实例说明
MsgBox函数语言参考
VBS教程：正则表达式简介 -后向引用
VBS教程：正则表达式简介 -选择与编组

No. « 1 2 3 4 »

技术文章搜索

关键字

VBScript 中的 常用VBS代码 值得一看

出处:互联网   整理: 软晨网（RuanChen.com）   发布: 2010-01-10   浏览: 231 ::
收藏到网摘: n/a

代码有点乱啊，大家可以自己整理下啊。 从系统开始菜单中删除此链接:
复制代码 代码如下:

Windows Registry Editor Version 5.00
[HKEY_CLASSES_ROOT\CLSID\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}]
@=-
"InfoTip"=-
[HKEY_CLASSES_ROOT\CLSID\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}\DefaultIcon]
@=-
[HKEY_CLASSES_ROOT\CLSID\{2559a1f6-21d7-11d4-bdaf-00c04f60b9f0}\Instance\InitPropertyBag]
"Command"=-
"Param1"=-

VBS脚本实现整理磁盘碎片功能
Set WshShell = WScript.CreateObject("WScript.Shell")
Dim fso, d, dc
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
For Each d in dc
If d.DriveType = 2 Then
Return = WshShell.Run("defrag " & d & " -f", 1, TRUE)
End If
Next
Set WshShell = Nothing
计划任务定时调用VBS脚本
复制代码 代码如下:

Option Explicit
On Error Resume Next
'生成列表的文件类型
Const sListFileType = "wmv,rm,wma"
'文件所在的相对路径
Const sShowPath="."
'排序类型的常量定义
Const iOrderFieldFileName = 0
Const iOrderFieldFileExt = 1
Const iOrderFieldFileSize = 2
Const iOrderFieldFileType = 3
Const iOrderFieldFileDate = 4
'排序顺逆的常量定义
const iOrderAsc = 0
const iOrderDesc = 1
'生成列表的文件数量
const iShowCount = 20

'显示的日期格式函数
Function Cndate2(date1,intDateStyle)
dim strdate,dDate1
strdate=cstr(date1)
If Isdate(strdate) Then
If Left(cstr(strdate),1)="0" Then
dDate1=Cdate("20"+cstr(strdate))
else
dDate1=Cdate(strdate)
End If
Else
dDate1=Now()
End If
Select case intDateStyle
Case 1:
Cndate2 = Cstr(Year(dDate1))+"-"+Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))
Case 2:
Cndate2 = Cstr(Month(dDate1))+"-"+Cstr(Day(dDate1))
Case 3:
Cndate2 = Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日"
Case 4:
Cndate2 = Cstr(year(dDate1))+"年"+ Cstr(Month(dDate1))+"月"+Cstr(Day(dDate1))+"日"
End Select
End Function

Function ListFile(strFiletype,intCompare,intOrder,intShowCount)
Dim sListFile
Dim fso, f, f1, fc, s,ftype,fcount,i,j,k
Dim t1,t2,t3,t4,t5
Dim iMonth,iDay
sListFile = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(sShowPath)
Set fc = f.Files
fcount = fc.count
redim arrFiles(fcount,5)
redim arrFiles2(fcount,5)
i=0
'排序
For Each f1 in fc
ftype = right(f1.name,len(f1.name)-instrrev(f1.name,"."))
arrFiles(i,0) = f1.name
arrFiles(i,1) = ftype
arrFiles(i,2) = f1.size
arrFiles(i,3) = f1.type
arrFiles(i,4) = f1.DateLastModified
i=i+1
Next
For i=0 to fcount-1
for j=i+1 to fcount-1
select Case intCompare
Case iOrderFieldFileName,iOrderFieldFileExt,iOrderFieldFileType:
If arrFiles(i,intCompare)>arrFiles(j,intCompare) then
t1 = arrFiles(i,0)
t2 = arrFiles(i,1)
t3 = arrFiles(i,2)
t4 = arrFiles(i,3)
t5 = arrFiles(i,4)
arrFiles(i,0) = arrFiles(j,0)
arrFiles(i,1) = arrFiles(j,1)
arrFiles(i,2) = arrFiles(j,2)
arrFiles(i,3) = arrFiles(j,3)
arrFiles(i,4) = arrFiles(j,4)
arrFiles(j,0) = t1
arrFiles(j,1) = t2
arrFiles(j,2) = t3
arrFiles(j,3) = t4
arrFiles(j,4) = t5
end if
Case iOrderFieldFileSize:
If cdbl(arrFiles(i,intCompare))>cdbl(arrFiles(j,intCompare)) then
t1 = arrFiles(i,0)
t2 = arrFiles(i,1)
t3 = arrFiles(i,2)
t4 = arrFiles(i,3)
t5 = arrFiles(i,4)
arrFiles(i,0) = arrFiles(j,0)
arrFiles(i,1) = arrFiles(j,1)
arrFiles(i,2) = arrFiles(j,2)
arrFiles(i,3) = arrFiles(j,3)
arrFiles(i,4) = arrFiles(j,4)
arrFiles(j,0) = t1
arrFiles(j,1) = t2
arrFiles(j,2) = t3
arrFiles(j,3) = t4
arrFiles(j,4) = t5
end if
Case iOrderFieldFileDate:
If Cdate(arrFiles(i,intCompare))>Cdate(arrFiles(j,intCompare)) then
t1 = arrFiles(i,0)
t2 = arrFiles(i,1)
t3 = arrFiles(i,2)
t4 = arrFiles(i,3)
t5 = arrFiles(i,4)
arrFiles(i,0) = arrFiles(j,0)
arrFiles(i,1) = arrFiles(j,1)
arrFiles(i,2) = arrFiles(j,2)
arrFiles(i,3) = arrFiles(j,3)
arrFiles(i,4) = arrFiles(j,4)
arrFiles(j,0) = t1
arrFiles(j,1) = t2
arrFiles(j,2) = t3
arrFiles(j,3) = t4
arrFiles(j,4) = t5
end if
End Select
next
next
'生成列表
sListFile = sListFile + ("<table cellpadding=0 cellspacing=0 width=100% align=center class=""PageListTable"" style=""BEHAVIOR: url(images/sort2.htc); "">")
sListFile = sListFile + ("<THEAD><Tr class=PageListTitleTr><Td class=PageListTitleTd>")
sListFile = sListFile + ("名称")
sListFile = sListFile + ("</td><Td class=PageListTitleTd>")
sListFile = sListFile + ("媒体")
sListFile = sListFile + ("</td><Td class=PageListTitleTd>")
sListFile = sListFile + ("大小")
sListFile = sListFile + ("</td><Td class=PageListTitleTd>")
sListFile = sListFile + ("类型")
sListFile = sListFile + ("</td><Td class=PageListTitleTd ID=updatetime>")
sListFile = sListFile + ("更新时间")
sListFile = sListFile + ("</td></Tr></THEAD>")
dim iLoopStart,iLoofEnd,iLoopStep
If intOrder = 0 then
iLoopStart = 0
iLoofEnd = fcount-1
iLoopStep = 1
Else
iLoopStart = fcount-1
iLoofEnd = 0
iLoopStep = -1
End if
dim iCount,sTDStyleClass
iCount = 1
For j=iLoopStart to iLoofEnd Step iLoopStep
If instr(strFiletype,arrFiles(j,1))>0 and iCount<=intShowCount then
sTDStyleClass = "PageListTd"+Cstr((iCount mod 2)+1)
sListFile = sListFile + ("<Tr class=PageListTr><Td class="+sTDStyleClass+">")
sListFile = sListFile + ("<img src=images/"+arrFiles(j,1)+".gif align=absbottom><img src=b.gif width=2 height=0><a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">" & arrFiles(j,0) &"</a>")
If datediff("h",arrFiles(j,4),now)<=24 then
sListFile = sListFile + "<img src=images/new.gif align=absmiddle>"
end if
sListFile = sListFile + "</td><Td class="+sTDStyleClass+">"
sListFile = sListFile + ("<a href=" & sShowPath & "/" & CStr(arrFiles(j,0)) &">")
'根据文件名规则,生成中文提示
select case left(arrFiles(j,0),3)
case "sc2":
sListFile = sListFile + "<font color=#AA0000>四川卫视 "
case "sd2":
sListFile = sListFile + "<font color=#00AA00>山东卫视 "
case "gd2":
sListFile = sListFile + "<font color=#0000AA>广东卫视 "
case "gx2":
sListFile = sListFile + "<font color=#AAAA00>广西卫视 "
end select
'日期显示
If isnumeric(left(right(arrFiles(j,0),8),2)) then
iMonth = cint(left(right(arrFiles(j,0),8),2))
iDay = cint(left(right(arrFiles(j,0),6),2))
sListFile = sListFile + cstr(iMonth)+"月" + cstr(iDay)+"日"
sListFile = sListFile + ("</a></td><Td class="+sTDStyleClass+" align=right>")
Else
response.write arrFiles(j,0)
end if
If arrFiles(j,2)>1024*1024 then
sListFile = sListFile + cstr(round(arrFiles(j,2)/1024/1024))
sListFile = sListFile + ("MB")
else
sListFile = sListFile + cstr(round(arrFiles(j,2)/1024))
sListFile = sListFile + ("KB")
end if
sListFile = sListFile + (" </td>")
sListFile = sListFile + ("<Td class="+sTDStyleClass+">")
sListFile = sListFile + cstr(arrFiles(j,3))
sListFile = sListFile + ("</td>")
sListFile = sListFile + ("<Td class="+sTDStyleClass+">")
sListFile = sListFile + (Cndate2(arrFiles(j,4),4))
sListFile = sListFile + ("</td>")
sListFile = sListFile + ("</Tr>")
iCount = iCount+1
end if
next
sListFile = sListFile + "</table>"
ListFile = sListFile
End Function
'生成调用文件的过程
Sub ShowFileListContent()
Dim tUpdatetime,sUpdateContent
Dim fso,f,f_js,f_js_write
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(sShowPath)
Set f_js = fso.GetFile("list.js")
'比较调用文件与文件夹的最后修改时间
If f.DateLastModified<>f_js.DateLastModified then
sUpdateContent = ListFile(sListFileType,iOrderFieldFileDate,iOrderDesc,iShowCount)
Set f_js_write = fso.CreateTextFile("list.js", True)
'JS调用就加上下面这对document.write
' f_js_write.Write ("document.write('")
f_js_write.Write (sUpdateContent)
' f_js_write.Write ("')")
f_js_write.Close
End If
End Sub
Call ShowFileListContent()
可以代替网通宽带登陆器的一段vbs脚本
Dim WshShell, iexplorePath, iexploreselect
iexplorePath="c:\Progra~1\Intern~1\iexplore.exe"
Set WshShell=WScript.CreateObject("WScript.Shell")
WshShell.Run iexplorePath
WScript.Sleep 2000
WshShell.AppActivate "用户上网登陆"
WshShell.SendKeys "自己的账号{TAB}"
WshShell.SendKeys "自己的密码"
WScript.Sleep 2000
WshShell.SendKeys "{ENTER}"
利用VBS脚本创建快捷方式
我们以"QQ Aqing增强包参数配置器"为例子,讲述如何利用VBS脚本创建快捷方式.代码如下:
代码:
set WshShell = Wscript.CreateObject("Wscript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
set oShellLink = WshShell.CreateShortcut(strDesktop & "\QQ Aqing增强包参数配置器.lnk")
'创建一个快捷方式对象,其在桌面上显示的名字为"QQ Aqing增强包参数配置器"
oShellLink.TargetPath = "C:\Program Files\Tencent\QQ\Aqing.exe"
'设置快捷方式的执行路径
oShellLink.WindowStyle = 1
oShellLink.Hotkey = "Ctrl+Alt+e" '设置快捷方式的快捷键
oShellLink.IconLocation = "E:\Picture\Aqing.ico" '设置快捷方式的图标路径
oShellLink.Description = "QQ Aqing增强包参数配置器" '设置快捷方式的描述
oShellLink.WorkingDirectory = strDesktop
oShellLink.Save
将上述代码保存为"CreateShortcut.vbs"(不含引号).双击CreateShortcut.vbs,就会将QQ Aqing增强包参数配置器的快捷方式建立到桌面上.
用这种方法建立的快捷方式的最大优点是:快捷方式的图标可以根据自己的喜好进行更改
用VBS脚本发送email!
[code]
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "[email protected]"
objEmail.To = "[email protected]"
objEmail.Subject = "这封邮件是由VBS脚本发送"
objEmail.Textbody = "如果你收到这封邮件，就表示测试成功！"
objEmail.Send

利用vbs脚本编写Windows XP/2003序列号更改器
复制代码 代码如下:

ON ERROR RESUME NEXT
Dim VOL_PROD_KEY
if Wscript.arguments.count<1 then
VOL_PROD_KEY =InputBox("使用说明(OEM版无效)："&vbCr&vbCr&" 本脚本程序将修改当前 Windows 的序列号。请先使用算号器算出匹配当前 Windows 的序列号，复制并粘贴到下面空格中。"&vbCr&vbCr&"输入序列号(默认为 XP VLK)：","Windows XP/2003 序列号更换工具","11111-11111-11111-11111-11111")
if VOL_PROD_KEY="" then
Wscript.quit
end if
else
VOL_PROD_KEY = Wscript.arguments.Item(0)
end if
VOL_PROD_KEY = Replace(VOL_PROD_KEY,"-","") 'remove hyphens if any
for each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")
result = Obj.SetProductKey (VOL_PROD_KEY)
if err = 0 then
Wscript.echo "您的 Windows CD-KEY 修改成功。请检查系统属性。"
end if
if err <> 0 then
Wscript.echo "修改失败！请检查输入的 CD-KEY 是否与当前 Windows 版本相匹配。"
Err.Clear
end if
Next

将上面的代码复制到文本里面,然后另存为.vbs文件,然后直接运行这个文件就可以了。
可升级Key:
MRX3F-47B9T-2487J-KWKMF-RPWBY
QC986-27D34-6M3TY-JJXP9-TBGMD
CM3HY-26VYW-6JRYC-X66GX-JVY2D
DP7CM-PD6MC-6BKXT-M8JJ6-RPXGJ
F4297-RCWJP-P482C-YY23Y-XH8W3
HH7VV-6P3G9-82TWK-QKJJ3-MXR96
HCQ9D-TVCWX-X9QRG-J4B2Y-GR2TT

一段对比删除文件的VBS脚本!（用游戏更新的时候可以用到哦，希望大家灵活应用）dim sdir,ddir
'远程目录
sdir="\\192.168.1.1\vbs\zz\"
'本地目录
ddir="c:\c"
function comparefile(sdir,ddir)
dim Fso,dFol,dfs,sf1,f1
set Fso=CreateObject("Scripting.FileSystemObject")
if not(Fso.folderexists(sdir)) then
msgbox chr(34) &sdir &chr(34) &"文件夹不存在，请确认！",64
exit function
end if
if not(Fso.folderexists(ddir)) then
msgbox chr(34) &ddir &"""文件夹不存在，请确认！",64
exit function
end if
if right(sdir,1)<>"\" then sdir=sdir &"\"
set dFol=fso.getfolder(ddir)
set dfs=dfol.files
for each f1 in dfs
if fso.fileexists(sdir & f1.name) then
set sf1=fso.GetFile(sdir & f1.name)
if f1.DateLastModified <>sf1.DateLastModified or f1.size<>sf1.size then
f1.delete
end if
else
f1.Delete(true)
end if
next
dim fols
set fols=dfol.subfolders
for each f1 in fols
if not fso.folderexists(sdir &f1.name) then
f1.delete true
else
comparefile sdir & f1.name,f1.path
end if
next
end function
comparefile sdir,ddir