网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的范文：

　

标题 常用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 + ("<table cellpadding=0 cellspacing=0 width=100%PageListTable""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>")
    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>"
    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 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>")
    sListFile = sListFile + cstr(arrFiles(j,3))
    sListFile = sListFile + ("</td>")
    sListFile = sListFile + ("<Td>")
    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
随便看

　

在线学习网范文大全提供好词好句、学习总结、工作总结、演讲稿等写作素材及范文模板，是学习及工作的有利工具。

　

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间：2025/5/28 19:58:43