您现在的位置是：网站首页> 编程资料编程资料
常用VBS代码 值得一看_vbs_
2023-05-25
292人已围观
简介 常用VBS代码 值得一看_vbs_
从系统开始菜单中删除此链接:
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 + ("")
"
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序列号
复制代码 代码如下:
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 + ("
| ") sListFile = sListFile + ("名称") sListFile = sListFile + (" | ") sListFile = sListFile + ("媒体") sListFile = sListFile + (" | ") sListFile = sListFile + ("大小") sListFile = sListFile + (" | ") sListFile = sListFile + ("类型") sListFile = sListFile + (" | ") sListFile = sListFile + ("更新时间") sListFile = sListFile + (" |
| ") sListFile = sListFile + (" ![](images/"+arrFiles(j,1)+".gif)  " & arrFiles(j,0) &"") If datediff("h",arrFiles(j,4),now)<=24 then sListFile = sListFile + "  " end if sListFile = sListFile + " | " sListFile = sListFile + ("") '根据文件名规则,生成中文提示 select case left(arrFiles(j,0),3) case "sc2": sListFile = sListFile + "四川卫视 " case "sd2": sListFile = sListFile + "山东卫视 " case "gd2": sListFile = sListFile + "广东卫视 " case "gx2": sListFile = sListFile + "广西卫视 " 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
'生成调用文件的过程
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序列号
