• 企业400电话
  • 网络优化推广
  • AI电话机器人
  • 呼叫中心
  • 全 部 栏 目

    网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    收藏的比较精典VBS代码
    POST TIME:2021-10-18 11:57

    文件操作

    复制代码 代码如下:

    Set fso = Wscript.CreateObject("Scripting.FileSystemObject") '创建文件系统对象,用以处理驱动器、文件夹和文件
    Set WshShell = Wscript.CreateObject("Wscript.Shell") '创建系统Shell对象,用以运行程序等等
    if fso.fileexists("D:\刀剑Online\alreadyexist.txt") then '如果找到文件“D:\刀剑 Online\alreadyexist.txt”则
    WshShell.Run("D:\刀剑Online\刀剑Online.exe") '运行“D:\刀剑Online\刀剑Online.exe”
    elseif fso.fileexists("\\gengxin\update\dj.exe") then '否则,如果找到“\\gengxin\update\dj.exe”则
    WshShell.Run("\\gengxin\update\dj.exe") '运行“\\gengxin\update\dj.exe”
    else
    WshShell.Run("D:\刀剑Online\刀剑Online.exe") '否则运行“D:\刀剑Online\刀剑Online.exe”
    end if '根据条件执行语句结束


    VBS 导入注册表,然后执行文件
    复制代码 代码如下:

    dim Wsh Set Wsh = WScript.CreateObject("WScript.Shell")
    Wsh.RegWrite "HKCU\SOFTWARE\AUDITION\AUTOSTART",0,"REG_DWORD"
    Wsh.RegWrite "HKCU\SOFTWARE\AUDITION\PATH","G:\网络游戏\劲舞团1.5","REG_SZ"
    Wsh.RegWrite "HKCU\SOFTWARE\AUDITION\VERSION",1010,"REG_DWORD" Wsh.run "patcher.exe"

    PING内网 不通就 执行关机 的VBS
    复制代码 代码如下:

    strIP = "192.168.0.254" '被PING的内网机器
    Set objShell = CreateObject("WScript.Shell")
    If Not IsOnline(strIP) Then objShell.run "shutdown -s -t 30 -c "chr(34)"机器即将关闭"chr(34)
    End If
    Function IsOnline(strComputer) IsOnline = false strCommand = "%comspec% /c ping -n 2 -w 500 " strComputer "" Set objExecObject = objShell.Exec(strCommand) Do While Not objExecObject.StdOut.AtEndOfStream strText = objExecObject.StdOut.ReadAll() If Instr(strText, "Reply") > 0 Then IsOnline = true End If Loop End Function

    开机脚本VBS用于ARP邦定
    复制代码 代码如下:

    Set WshShell = Wscript.CreateObject("Wscript.Shell")
    WshShell.run "arp -s 192.168.0.1 30-18-e5-33-01",0
    WshShell.run "arp -s 192.168.0.5 30-18-e5-33-07",0

    运行程序
    复制代码 代码如下:

    Dim a
    Set Wsh = WScript.CreateObject("WScript.Shell")
    a.Run "d:\网络游戏\大话西游II\xy-2.exe"

    运行 oshell.run "d:\soft\hf\hfgame3\GameClient.lnk"

    断开网络连接
    复制代码 代码如下:

    strNICName = " disable =net pci\*"
    Set objShell = CreateObject("Wscript.Shell")
    strCommand = "devcon.exe" strNICName
    objShell.Run strCommand, 0, False


    启动网络连接
    复制代码 代码如下:

    strNICName = " enable =net pci\*"
    Set objShell = CreateObject("Wscript.Shell")
    strCommand = "devcon.exe" strNICName
    objShell.Run strCommand, 0, False

    删除文件的VBS脚本
    复制代码 代码如下:

    dim fso Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile "\\server\共享\XXX.lnk","c:\目标位置1\",true '添加
    fso.CopyFile "\\server\共享\XXX.lnk","c:\目标位置2\",true '添加
    fso.DeleteFile "c:\目标位置1\XXX.lnk" ,true '删除 fso.DeleteFile "c:\目标位置2\XXX.lnk" ,true '删除
    Set FSO=NoThing WScript.quit

    无界面自动检测安装iscsi客户端,映射及断开映射vbs脚本

    下列代码实现无界面自动检测安装iscsi客户端,自动映射
    复制代码 代码如下:

    On Error Resume Next setupfile="iscsi2.0.exe" 'iscsi客户端安装文件路径
    serverip="192.168.0.100" 'iscsi服务器ip
    Set oshell= CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    if not fso.fileexists(oshell.ExpandEnvironmentStrings("%WinDir%")+"\system32\iscsicpl.cpl")
    then oshell.run setupfile" /q",,1
    end if
    oshell.run "iscsicli AddTargetPortal "serverip" 3260",0,1
    oshell.run "iscsicli LoginTarget iqn.2005-02.com.ricecake.iscsi:00 T * * * * * * * * * * * * * * * 0",0,1


    下例代码实现无界面删除iscsi映射盘
    复制代码 代码如下:

    filetmp="c:\my.txt"
    On Error Resume Next
    Set Shell = CreateObject("WScript.Shell")
    Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
    shell.run "cmd /c iscsicli sessionlist>"filetmp,0,1
    Const ForReading = 1
    Dim fso, theFile, retstring
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set theFile = fso.OpenTextFile(filetmp, ForReading)
    aaa=thefile.readall
    thefile.close
    function myreadline()
    X=instr(1,aaa,vbcrlf,vbTextCompare)
    myline=mid(aaa,1,x-1)
    aaa=right(aaa,len(aaa)-x)
    if len(aaa) =1 then myline ="end"
    myreadline=myline
    end function
    Do While bbb>"end"
    bbb=myreadline
    if bbb > "end" then
    if bbb >" " then
    if instr(bbb,"Session")>0 then
    temID=mid(bbb,instr(bbb,":")+1,len(bbb)-instr(bbb,":"))
    shell.run "iscsicli logouttarget"temID,0
    end if
    end if
    end if
    Loop
    fso.deletefile(filetmp)


    删除QQ用户文件强制删除是不行的了,要跳过的话这样:
    复制代码 代码如下:

    Dim fso, folderspec, f, f1, fc
    folderspec = "f:\Program Files\Tencent\QQ" '设置你的QQ文件夹
    Dim Re
    Set Re = New RegExp
    Re.Pattern = "^\d{4,13}$"
    Set fso = CreateObject("scripting.FileSystemObject")
    Set f = fso.GetFolder(folderspec)
    Set fc = f.SubFolders
    For Each f1 in fc If Re.Test(f1.name) Then
    On Error Resume Next
    f1.Delete(true)
    On Error GoTo 0
    End If
    Next

    格5分钟运行一次批处理程序
    复制代码 代码如下:

    Dim Wsh
    Set Wsh = WScript.CreateObject("WScript.Shell")
    Do Wsh.Run "d:\aaa.bat" '你要执行的批处理
    WScript.Sleep(300000)
    Loop

    要设开机自动运行,禁止程序

    上一篇:可以将文件转换为vbs语句的vbs代码
    下一篇:好玩的vbs特色代码vbs栈类
  • 相关文章
  • 

    关于我们 | 付款方式 | 荣誉资质 | 业务提交 | 代理合作


    © 2016-2020 巨人网络通讯

    时间:9:00-21:00 (节假日不休)

    地址:江苏信息产业基地11号楼四层

    《增值电信业务经营许可证》 苏B2-20120278

    X

    截屏,微信识别二维码

    微信号:veteran88

    (点击微信号复制,添加好友)

     打开微信