欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

常用VBS代码 值得一看

程序员文章站 2022-07-04 20:49:53
从系统开始菜单中删除此链接: 复制代码 代码如下: windows registry editor version 5.00 [hkey_classes_root\clsi...
从系统开始菜单中删除此链接:
复制代码 代码如下:

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 = "null_vbt@163.com"
objemail.to = "null_vbt@163.com"
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