這篇文章主要為大家展示了“常用VBS代碼有哪些”，內(nèi)容簡(jiǎn)而易懂，條理清晰，希望能夠幫助大家解決疑惑，下面讓小編帶領(lǐng)大家一起研究并學(xué)習(xí)一下“常用VBS代碼有哪些”這篇文章吧。

創(chuàng)新互聯(lián)建站云計(jì)算的互聯(lián)網(wǎng)服務(wù)提供商,擁有超過(guò)13年的服務(wù)器租用、成都移動(dòng)云計(jì)算中心、云服務(wù)器、網(wǎng)站空間、網(wǎng)站系統(tǒng)開(kāi)發(fā)經(jīng)驗(yàn)，已先后獲得國(guó)家工業(yè)和信息化部頒發(fā)的互聯(lián)網(wǎng)數(shù)據(jù)中心業(yè)務(wù)許可證。專業(yè)提供云主機(jī)、網(wǎng)站空間、域名與空間、VPS主機(jī)、云服務(wù)器、香港云服務(wù)器、免備案服務(wù)器等。

從系統(tǒng)開(kāi)始菜單中刪除此鏈接:

復(fù)制代碼 代碼如下:

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腳本實(shí)現(xiàn)整理磁盤(pán)碎片功能

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

計(jì)劃任務(wù)定時(shí)調(diào)用VBS腳本

復(fù)制代碼 代碼如下:

Option Explicit
On Error Resume Next

'生成列表的文件類型
Const sListFileType = "wmv,rm,wma"

'文件所在的相對(duì)路徑
Const sShowPath="."

'排序類型的常量定義
Const iOrderFieldFileName = 0
Const iOrderFieldFileExt = 1
Const iOrderFieldFileSize = 2
Const iOrderFieldFileType = 3
Const iOrderFieldFileDate = 4

'排序順逆的常量定義
const iOrderAsc = 0
const iOrderDesc = 1

'生成列表的文件數(shù)量
const iShowCount = 20


'顯示的日期格式函數(shù)
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 + ("

")
sListFile = sListFile + ("")
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 + ("")
sListFile = sListFile + ("")
sListFile = sListFile + ("")
sListFile = sListFile + ("")
iCount = iCount+1
end if
next
sListFile = sListFile + "

") sListFile = sListFile + ("名稱") sListFile = sListFile + ("	") sListFile = sListFile + ("媒體") sListFile = sListFile + ("	") sListFile = sListFile + ("大小") sListFile = sListFile + ("	") sListFile = sListFile + ("類型") sListFile = sListFile + ("	") sListFile = sListFile + ("更新時(shí)間") sListFile = sListFile + ("
") sListFile = sListFile + ("" & arrFiles(j,0) &"") If datediff("h",arrFiles(j,4),now)<=24 then sListFile = sListFile + "" end if sListFile = sListFile + "	" sListFile = sListFile + ("") '根據(jù)文件名規(guī)則,生成中文提示 select case left(arrFiles(j,0),3) case "sc2": sListFile = sListFile + "四川衛(wèi)視 " case "sd2": sListFile = sListFile + "山東衛(wèi)視 " case "gd2": sListFile = sListFile + "廣東衛(wèi)視 " case "gx2": sListFile = sListFile + "廣西衛(wèi)視 " 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 + ("	") 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 + ("	") sListFile = sListFile + cstr(arrFiles(j,3)) sListFile = sListFile + ("	") sListFile = sListFile + (Cndate2(arrFiles(j,4),4)) sListFile = sListFile + ("

"
ListFile = sListFile
End Function

'生成調(diào)用文件的過(guò)程
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")

'比較調(diào)用文件與文件夾的最后修改時(shí)間
If f.DateLastModified<>f_js.DateLastModified then
sUpdateContent = ListFile(sListFileType,iOrderFieldFileDate,iOrderDesc,iShowCount)
Set f_js_write = fso.CreateTextFile("list.js", True)
'JS調(diào)用就加上下面這對(duì)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()

可以代替網(wǎng)通寬帶登陸器的一段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 "用戶上網(wǎng)登陸"
WshShell.SendKeys "自己的賬號(hào){TAB}"
WshShell.SendKeys "自己的密碼"
WScript.Sleep 2000
WshShell.SendKeys "{ENTER}"

利用VBS腳本創(chuàng)建快捷方式

我們以"QQ Aqing增強(qiáng)包參數(shù)配置器"為例子,講述如何利用VBS腳本創(chuàng)建快捷方式.代碼如下:

代碼:

set WshShell = Wscript.CreateObject("Wscript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
set oShellLink = WshShell.CreateShortcut(strDesktop & "\QQ Aqing增強(qiáng)包參數(shù)配置器.lnk")
'創(chuàng)建一個(gè)快捷方式對(duì)象,其在桌面上顯示的名字為"QQ Aqing增強(qiáng)包參數(shù)配置器"
oShellLink.TargetPath = "C:\Program Files\Tencent\QQ\Aqing.exe"
'設(shè)置快捷方式的執(zhí)行路徑
oShellLink.WindowStyle = 1
oShellLink.Hotkey = "Ctrl+Alt+e" '設(shè)置快捷方式的快捷鍵
oShellLink.IconLocation = "E:\Picture\Aqing.ico" '設(shè)置快捷方式的圖標(biāo)路徑
oShellLink.Description = "QQ Aqing增強(qiáng)包參數(shù)配置器" '設(shè)置快捷方式的描述
oShellLink.WorkingDirectory = strDesktop
oShellLink.Save

將上述代碼保存為"CreateShortcut.vbs"(不含引號(hào)).雙擊CreateShortcut.vbs,就會(huì)將QQ Aqing增強(qiáng)包參數(shù)配置器的快捷方式建立到桌面上.

用這種方法建立的快捷方式的較大優(yōu)點(diǎn)是:快捷方式的圖標(biāo)可以根據(jù)自己的喜好進(jìn)行更改

用VBS腳本發(fā)送email!
[code]
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "null_vbt@163.com"
objEmail.To = "null_vbt@163.com"
objEmail.Subject = "這封郵件是由VBS腳本發(fā)送"
objEmail.Textbody = "如果你收到這封郵件，就表示測(cè)試成功！"
objEmail.Send

利用vbs腳本編寫(xiě)Windows XP/2003序列號(hào)更改器

復(fù)制代碼 代碼如下:

ON ERROR RESUME NEXT

Dim VOL_PROD_KEY
if Wscript.arguments.count<1 then
VOL_PROD_KEY =InputBox("使用說(shuō)明(OEM版無(wú)效)："&vbCr&vbCr&" 本腳本程序?qū)⑿薷漠?dāng)前 Windows 的序列號(hào)。請(qǐng)先使用算號(hào)器算出匹配當(dāng)前 Windows 的序列號(hào)，復(fù)制并粘貼到下面空格中。"&vbCr&vbCr&"輸入序列號(hào)(默認(rèn)為 XP VLK)：","Windows XP/2003 序列號(hào)更換工具","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 修改成功。請(qǐng)檢查系統(tǒng)屬性。"
end if

if err <> 0 then
Wscript.echo "修改失??！請(qǐng)檢查輸入的 CD-KEY 是否與當(dāng)前 Windows 版本相匹配。"
Err.Clear
end if

Next

將上面的代碼復(fù)制到文本里面,然后另存為.vbs文件,然后直接運(yùn)行這個(gè)文件就可以了。

可升級(jí)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


一段對(duì)比刪除文件的VBS腳本!（用游戲更新的時(shí)候可以用到哦，希望大家靈活應(yīng)用）dim sdir,ddir
'遠(yuǎn)程目錄
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) &"文件夾不存在，請(qǐng)確認(rèn)！",64
exit function
end if
if not(Fso.folderexists(ddir)) then
msgbox chr(34) &ddir &"""文件夾不存在，請(qǐng)確認(rèn)！",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

以上是“常用VBS代碼有哪些”這篇文章的所有內(nèi)容，感謝各位的閱讀！相信大家都有了一定的了解，希望分享的內(nèi)容對(duì)大家有所幫助，如果還想學(xué)習(xí)更多知識(shí)，歡迎關(guān)注創(chuàng)新互聯(lián)行業(yè)資訊頻道！

分享名稱：常用VBS代碼有哪些-創(chuàng)新互聯(lián)
URL標(biāo)題：http://weahome.cn/article/dpijsd.html