• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    常用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% 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 + ("nbsp;/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.count1 then
    VOL_PROD_KEY =InputBox("使用说明(OEM版无效):"vbCrvbCr" 本脚本程序将修改当前 Windows 的序列号。请先使用算号器算出匹配当前 Windows 的序列号,复制并粘贴到下面空格中。"vbCrvbCr"输入序列号(默认为 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
    上一篇:利用WScript.Shell对象隐藏cmd命令行运行框的实现代码
    下一篇:进程监控实现代码[vbs+bat]
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

    常用VBS代码 值得一看 常用,VBS,代码,值得,一看,