none
VBS 脚本应用 RRS feed

  • 问题

  •  

    更新完毕 欢迎大家交流自己喜欢的vbs脚本。。

     

    1.改变本机网络相关信息

     

     

    \'注意:
    \'本程序中使用了Scripting.FileSystemObject对象
    \'有的杀毒软件可能禁用该对象
    Dim ComputerName       \'定义计算机名
    Dim WorkGroup        \'定义工作组
    Dim IPAddress        \'定义IP地址
    Dim Gateway        \'定义网关
    Dim NetMask        \'定义子网掩码
    Dim NameServer       \'定义DNS
    Dim CSCDKey           \'定义反恐CDKey
    Dim WSH              \'定义WScript.Shell对象
    Dim FSO            \'定义Scripting.FileSystemObject对象
    Dim OPName            \'定义操作系统名
    Dim IPFile,CDKeyFile,WinNTFile      \'定义反恐CDKey和IP地址的文件对象
    Dim IPList,CDKeyList,WinNtCFG      \'定义网络配置文件
    Dim Meteor
    Dim ComputerNameNum,IPAddressFormat,ComputerNameFormat  \'定义其他变量
    Dim Buf,NamePart,IPPart,i,j
    OPName = "Microsoft Windows 9x"     \'设置默认为Microsoft Windows 9x

    IPList = "killer.cfg"      \'设置网络设置配置文件, ###可自定义###
    CDKeyList = "CSCDKEY.TXT"     \'反恐CDKEY列表文件文件,###可自定义###
    WinNTCFG = "WinNT.cfg"

    ComputerNameNum = 0

    \'ON Error Resume Next
    Set FSO = CreateObject("Scripting.FileSystemObject")  \'创建文件系统对象
    Set WSH = WScript.CreateObject("WScript.Shell")   \'创建WScript.Shell对象
    IF NOT FSO.FileExists(IPList) THEN
    MSGBox "    没有发现IP地址列表文件:"&IPList&vbCrLf&"未改动任何设置",48,"xp工作站设置程序"
    WScript.Quit
    END IF
    IF NOT FSO.FileExists(CDKeyList) THEN
    MSGBox "    没有发现反恐CDKey列表文件:"&CDKeyList&vbCrLf&"未改动任何设置",48,"xp工作站设置程序"
    WScript.Quit
    END IF

    ComputerName = Trim(InputBox("请输入工作站计算机名:","xp工作站设置程序"))
    IF LEN(ComputerName)=2 THEN ComputerName="0"+ComputerName
    IF LEN(ComputerName)=1 THEN ComputerName="00"+ComputerName
    IF ComputerName = "" THEN
    MSGBox "计算机名没有输入,未改动任何设置!",48,"xp工作站设置程序"
    WScript.Quit
    END IF
    Set IPFile = FSO.OpenTextFile(IPList)    \'打开IP地址的列表文件
    j=0
    \'下面开始解释IP地址的列表文件,从中获取设置
    While Not IPFile.AtEndOfStream and IPAddress = ""

    Buf=Trim(IPFile.ReadLine)
    If Mid(Buf,1,1) = "#" Then
      Execute Mid(Buf,2)
    ElseIf Mid(Buf,1,2) = "//" Then
    ElseIf Buf = "" then
    Else
      j=j+1
      If InStr(Buf,"=") Then
       NamePart= Mid(buf,1,InStr(Buf,"=")-1)
       IPPart=Mid(buf,InStr(Buf,"=")+1)
      else
       NamePart=buf
       IPPart=buf
      End If
      ComputerNum=ComputerNum+1
      if UCase(ComputerName)=UCase(Replace(ComputerNameFormat,"?",NamePart)) then
       Buf=Replace(IPAddressFormat,"?",IPPart)
       IPAddress=mid(buf,1,Instr(buf,"(")-1)&eval(replace(mid(buf,Instr(buf,"(")+1,len(buf)-1),")",""))
      end if
    end if
    Wend
    if IPAddress = "" then
    Msgbox  "计算机名不存在,可能是输入有误,未改动任何设置!",48,"xp工作站设置程序"
    WScript.Quit
    end if
    IPFile.Close        \'关闭IP地址的列表文件
    Set CDKeyFile = FSO.OpenTextFile(CDKeyList)    \'打开IP地址的列表文件
    for i=0 to ComputerNum
    CDKeyFile.SkipLine
    next
    if CDKeyFile.AtEndOfStream then
    Msgbox "反恐CDKey数目不够,未改动任何设置!",48,"xp工作站设置程序"
    WScript.Quit
    end if
    CSCDKey = Trim(CDKeyFile.ReadLine)
    CDKeyFile.Close

    \'下面获取操作系统名,Win9x系统中无此键,将产生错误,从而保留默认值
    OPName=WSH.RegRead("HKEY_LOCAL_MACHINE\\SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\ProductName")

    \'下面改注册表
    if OPName = "Microsoft Windows 9x" then

    \'Win9x系统下执行
    WSH.RegWrite "HKEY_CURRENT_USER\\Software\\Valve\\CounterStrike\\Settings\\KEY",CSCDKey,"REG_SZ"  \'注册反恐CDKEY
    WSH.RegWrite "HKEY_CURRENT_USER\\Software\\Valve\\HALF-LIFE\\Settings\\KEY",CSCDKey,"REG_SZ"  \'注册半条命CDKEY
    \'可在此处添加其他注册项
    \'下列设置取消,可消除行首“\'”注释标志取用
    WSH.RegWrite "HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Control\\ComputerName\\ComputerName\\ComputerName",ComputerName,"REG_SZ"
    WSH.RegWrite "HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Services\\VxD\\VNETSUP\\ComputerName",ComputerName,"REG_SZ"
    WSH.RegWrite "HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Services\\VxD\\VNETSUP\\Workgroup",WorkGroup,"REG_SZ"
    WSH.RegWrite "HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Services\\Class\\NetTrans\\0001\\IPAddress",IPAddress,"REG_SZ"
    WSH.RegWrite "HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Services\\Class\\NetTrans\\0001\\IPMask",NetMask,"REG_SZ"
    WSH.RegWrite "HKEY_LOCAL_MACHINE\\System\\CurrentControlSet\\Services\\Class\\NetTrans\\0001\\DefaultGateway",GateWay,"REG_SZ"

    else
    \'Win2k&XP系统下执行
    \'可在此处添加其他注册项

    WSH.RegWrite "HKEY_CURRENT_USER\\Software\\Valve\\CounterStrike\\Settings\\KEY",CSCDKey,"REG_SZ" \'注册反恐CDKEY
    \'WSH.RegWrite "HKEY_CURRENT_USER\\Software\\Valve\\HALF-LIFE\\Settings\\KEY",CSCDKey,"REG_SZ" \'注册半条命CDKEY
    \'删除一些恢复设置的注册项
    \'WSH.RegDelete "HKEY_LOCAL_MACHINE\\SYSTEM\\ControlSet001\\Control\\BackupRestore\\KeysNotToRestore\\"
    \'WSH.RegDelete "HKEY_LOCAL_MACHINE\\SYSTEM\\ControlSet002\\Control\\BackupRestore\\KeysNotToRestore\\"
    \'Wsh.RegDelete ""
    \'Wsh.RegDelete ""

    set WinNTFile = FSO.OpenTextFile(WinNTCFG)
    buf = WinNTFile.readall
    buf = replace(buf,"[COMPUTERNAME]",ComputerName)
    buf = replace(buf,"[WORKGROUP]",WorkGroup)
    buf = replace(buf,"[IPADDRESS]",CRegM(IPAddress))
    buf = replace(buf,"[GATEWAY]",CRegM(Gateway))
    buf = replace(buf,"[NETMASK]",CRegM(NetMask))
    buf = replace(buf,"[NAMESERVER]",NameServer)
    buf = replace(buf,"[CSCDKEY]",CSCDKey)
    Winntfile.close
    set WinNTFile = FSO.CreateTextFile("NetSettings.reg")
    WinNtFile.Write buf
    Winntfile.close
    WSH.Run "Regedit NetSettings.reg",0,true
    set WinNTFile = FSO.GetFile("NetSettings.reg")
    WinNTFile.Delete
    end if

    if ComputerName<200 then
    if ComputerName<16 then
    Meteor="19654494997d0"+hex(ComputerName)
    else
    Meteor="19654494997d"+hex(ComputerName)
    end if
    else
    if ComputerName-200<16 then
    Meteor="6F7O11YD459B0"+hex(ComputerName-200)
    else
    Meteor="6F7O11YD459B"+hex(ComputerName-200)
    end if
    end if
    WSH.RegWrite "HKEY_LOCAL_MACHINE\\Software\\InterServ\\Meteor\\Serial",Meteor,"REG_SZ"

    Buf =       "操作系统:" + OPName + vbCrLf
    Buf = Buf + "计算机名:" + ComputerName + vbCrLf
    Buf = Buf + "工作组名:" + WorkGroup + vbCrLf
    Buf = Buf + "IP 地 址:" + IPAddress + vbCrLf
    Buf = Buf + "使用网关:" + Gateway + vbCrLf
    Buf = Buf + "子网掩码:" + NetMask + vbCrLf
    Buf = Buf + "域名解析:" + NameServer + vbCrLf
    Buf = Buf + "CS CDKey:" + CSCDKey + vbCrLf
    Buf = Buf + "流星蝴蝶:" + Meteor+ vbCrLf
    Buf = Buf + "计算机号:" + Cstr(j)
    MSGBox Buf,64,"xp工作站设置程序运行报告"
    Set FSO=NoThing
    Set WSH=NoThing
    function CRegM(key)
    dim MultiSZ
    MultiSZ = "hex(7):"
    for  i= 1 to len(key)
    MultiSZ = MultiSZ + hex(asc(mid(key,i))) + ",00,"
    next
    MultiSZ = MultiSZ + "00,00,00,00"
    CRegM=MultiSZ
    end function

     

    2.列举进程和进程文件路径

     

    'ipa=inputbox("您要查看哪台机子的进程"&chr(13)&chr(10)&chr(13)&chr(10)&" 192.168.1.*  ","进程查看器之vbs版")
    'if ipa = "" then wscript.quit
    'strComputer = "192.168.1."&ipa
    '如果要查看远程机子的进程,请把以上三句的单引号并删除下面一行
    strComputer = "."

    Set objWMIService = GetObject _
        ("winmgmts:\\" & strComputer & "\root\cimv2")
     
    Set colItems = objWMIService.ExecQuery _
      ("SELECT * FROM Win32_process")
    For Each objItem in colItems
     if objitem.ExecutablePath<>"" then
      strTXT=strTXT&objItem.Name&" | "&objitem.ExecutablePath&chr(10)&chr(13)
     end if
    Next
    msgbox strtxt
     
    3. 文件夹对比删除
     

    Dim Fso,wsh,BasicFod,DestFod,flnum,fdnum,t1,t2,tm
    Set WSH = WScript.CreateObject("WScript.Shell")
    Set Fso = CreateObject("Scripting.FileSystemObject")


    flnum=0
    fdnum=0
    t1 = timer()


    BasicFod="d:\aaa" '你要对比的样本文件夹
    DestFod="d:\bbb"  '要删除文件的目标文件夹
    ScanDel(DestFod)


    t2 = timer()
    tm=cstr(int(( (t2-t1)*10000 )+0.5)/10)


    Set wsh=NoThing
    Set Fso=NoThing
    msgbox "比较完毕,删除 "&flnum&" 个文件,删除 "&fdnum& "个文件夹。"& vbCrLf &"耗时 "&tm&" 毫秒",64,"执行完毕"
    WScript.quit


    Sub ScanDel(Dfd)
    'on error resume next
    Set Dfolder=Fso.Getfolder(Dfd)
    Set files=Dfolder.files
    For Each file In files
    Bfile = lcase(Replace(lcase(cstr(file)),DestFod,BasicFod))
    If Not Fso.FileExists(Bfile) Then
    file.Delete(True)
    flnum = flnum + 1
    End If
    Next
    Set subfolders=Dfolder.subfolders
    For Each subfolder In subfolders
    Bsubfolder = lcase(Replace(lcase(cstr(subfolder)),DestFod,BasicFod))
    If Not Fso.FolderExists(Bsubfolder) Then
    subfolder.Delete(True)
    fdnum = fdnum + 1
    Else
    ScanDel(subfolder)
    End If
    Next
    End Sub

     
    4.删除时排除指定文件或文件夹
     

    ''''''''''''''说明''''''''''''
    '黑火制作,送给需要的朋友。
    '配置文件“Listfile.ini”的格式如下:
    '要删除什么(文件|目录)=要执行删除的文件夹=排除1;排除2;排除3............
    '配置文件可以有多行,以便对多个目录进行操作。
    '配置文件里以“/”开头的行为注释行。
    '排除多个内容时,使用分号“;”进行分隔。
    '↓↓↓ 配置文件例子:↓↓↓
    '/配置文件开始
    '目录=D:\=System Volume Information;网络游戏;单机游戏;小游戏
    '目录=C:\Program Files=qq;WinRAR
    '文件=D:\网络游戏=文件1.exe;文件2.exe
    '/配置文件结束
    '''''''''''''说明完''''''''''''

    Function InGroup(strGroup,CName)
    dim Group1,Group2,GroupArr1,GroupArr2
    Group1="NET117;NET118"       '这里是A类的机器名
    Group2="NET004;NET120;124"     '这里是B类的机器名
    GroupArr1=Split(Group1,";")
    GroupArr2=Split(Group2,";")
    InGroup = False
    If strGroup = "A类" Then
        If InArray(GroupArr1,CName) Then
            InGroup = True
        End If
    End If
    If strGroup = "B类" Then
        If InArray(GroupArr2,CName) Then
            InGroup = True
        End If
    End If
    End Function

    Dim WshNetwork,computer
    Set WshNetwork = WScript.CreateObject("WScript.Network")
    computer = WshNetwork.ComputerName

    Dim Fso,Listfile,objListfile
    Listfile = ""           '设置配置文件路径,如果配置文件和脚本放在一起,请保持原样

    If Listfile = "" Then Listfile = "Listfile.ini"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set objListfile = Fso.OpenTextFile(Listfile,1)
    If Err Then
        err.Clear
        Msgbox "没有找到配置文件 "&Listfile,16,"错误"
        WScript.quit
    End If
    On Error GoTo 0

    Dim flnum,fdnum,t1,t2,tm
    flnum=0
    fdnum=0
    t1 = timer()

    Dim Myline,LineArr,ListArr,appGroupArr
    Do While objListfile.AtEndOfStream <> True
        Myline = LCase(Replace(objListfile.ReadLine,"==","="))
        If Left(Myline,1) = "/" Then
        'objListfile.SkipLine
        ElseIf CheckLine(Myline) = 3 Then 
            LineArr = Split(Myline,"=")
            If InGroup(LineArr(0),computer) Then
                ListArr = Split(LineArr(3),";")
                If LineArr(1) = "目录" Then DelFolder LineArr(2),ListArr
         If LineArr(1) = "目录" Then CreFolder LineArr(2),ListArr
                If LineArr(1) = "文件" Then DelFile LineArr(2),ListArr
            End if
        End If
    Loop

    t2 = timer()
    tm=cstr(int(( (t2-t1)*10000 )+0.5)/10)

    MsgBox "扫描完毕,共删除 "&fdnum&" 个目录, "&flnum& "个文件。"& vbCrLf &"耗时 "&tm&" 毫秒",64,"执行完毕"
    '不需要显示报告的话,注释掉上面这一行

    Set Fso=NoThing
    WScript.quit

    Sub DelFolder(Folder,ListArr)
    Dim objFolder,subFolders,subFolder
        Set objFolder=Fso.Getfolder(Folder)
        Set subFolders=objFolder.subFolders
        For Each subFolder In subFolders
        If Not InArray(LIstArr,LCase(subFolder.name)) Then
         On Error Resume Next
            subfolder.Delete(True)
            If Err Then
                err.Clear
                Msgbox "不能删除目录,请检查 "&subFolder,16,"错误"
            Else
            flnum = flnum + 1
            End If
            On Error GoTo 0
        End If
        Next
    End Sub

    Sub DelFile(Folder,ListArr)
    Dim objFolder,Files,File
        Set objFolder=Fso.Getfolder(Folder)
        Set Files=objFolder.Files
        For Each File In Files
        If Not InArray(LIstArr,LCase(File.name)) Then
         On Error Resume Next
            File.Delete(True)
            If Err Then
                err.Clear
                Msgbox "不能删除文件,请检查 "&File,16,"错误"
            Else 
            fdnum = fdnum + 1
            End If
            On Error GoTo 0
        End If
        Next
    End Sub

    Function CheckLine(strLine)
    Dim LineRegExp,Matches
    Set LineRegExp = New RegExp
    LineRegExp.Pattern = ".=."
    LineRegExp.Global = True
    Set Matches = LineRegExp.Execute(strLine)
    CheckLine = Matches.count
    End Function

    Function InArray(Myarray,StrIn)
    Dim StrTemp
    InArray = True
    For Each StrTemp In Myarray
        If StrIn = StrTemp Then
            Exit Function
            Exit For
        End If
    Next
    InArray = False
    End Function

    Sub CreFolder(path,arrFodName)
    Dim Strpath,StrTemp
    If Right(path,1)<>"\" Then path = path&"\"
    For Each StrTemp In arrFodName
    Strpath = path & StrTemp
        If Not Fso.FolderExists(Strpath) Then
            Fso.CreateFolder(Strpath)
        End If
    Next
    End Sub

    2008年12月17日 5:44
    版主

全部回复

  • 5. 终止指定进程

     

    strComputer="."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colProcessList=objWMIService.ExecQuery ("select * from Win32_Process where Name='notepad.exe' ")
    'notepad.exe是记事本进程
    For Each objProcess in colProcessList 
    objProcess.Terminate()
    Next 
     
    6.显示自动启动的服务
     
    for each sc in getobject("winmgmts:\\.\root\cimv2:win32_service").instances_
    if sc.startmode="Auto" then
    srtTXT=srtTXT&"服务名称:"&sc.name&"|进程名称:"&sc.pathname&chr(10)&chr(13)
    end if
    next
    wscript.echo srtTXT
     
    7.显示正在运行的服务
     
    for each sc in getobject("winmgmts:\\.\root\cimv2:win32_service").instances_
    if sc.state="Running" then
    srtTXT=srtTXT&"服务名称:"&sc.name&"|进程名称:"&sc.pathname&chr(10)&chr(13)
    end if
    next
    wscript.echo srtTXT
     
    8.禁止指定程序的运行
     
    strComputer="."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    'winrar.exe是测试禁止的进程
    do
    Set colProcessList=objWMIService.ExecQuery ("select * from Win32_Process where Name='winrar.exe' ")
    For Each objProcess in colProcessList 
    objProcess.Terminate()
    Next
    wscript.sleep 500
    loop
     
    9.复制删除文件
     
    dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile "c:\\pskill.vbs","c:\\test\\",true
    fso.DeleteFile "c:\\pskill.vbs" ,true
    Set FSO=NoThing
    WScript.quit
     
    10 显示ip地址和计算机名
     
    Set WshNetwork = WScript.CreateObject("WScript.Network")
    cName = WshNetwork.ComputerName '取本机计算机名
    msgbox "计算机名:"&cName&chr(10)&chr(13)&"本机IP:"&GetIP(".")
     
    Function GetIP(ComputerName) '取本机IP
    Dim objWMIService,colItems,objItem,objAddress
    Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
    For Each objItem in colItems
        For Each objAddress in objItem.IPAddress
            If objAddress <> "" then
                GetIP = objAddress
                Exit For
            End If
        Next
    Next
    End Function
     
    11 取本地硬件信息
     
    '检测到计算机的主板,CPU(包括主频),内存,硬盘,显卡,网卡等相关信息
    特别适合在局域网内用来察看和管理内部计算机的硬件配置情况
    On Error Resume Next
    temp=0
    set wshshell=wscript.createObject("wscript.shell")
    '启动WMI服务(没有这个服务就不行)
    wshshell.run ("%comspec% /c regsvr32 /s scrrun.dll"),0,True
    wshshell.run ("%comspec% /c sc config winmgmt start= auto"),0,True
    wshshell.run ("%comspec% /c net start winmgmt"),0
    '用一个文本来记录硬件信息
    Set WshNetwork = WScript.CreateObject("WScript.Network")
    computername=WshNetwork.ComputerName
     
    set fso=createObject("scripting.filesystemObject")
    tempfilter="c:\"& computername &".txt"
    '这里是硬件信息纪录的存放位置,可以是网络共享路径(需有写入权限)
    set tempfile=fso.createtextfile(tempfilter)
     
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    '主板
    set board =objwmiservice.execQuery("select * from win32_baseboard")
    for each item in board
    board2=board2&"主板:" & item.Product
    next
    'CPU
    set cpu =objwmiservice.execQuery("select * from win32_processor")
    for each item in cpu
    cpu2= cpu2&"CPU:" & item.Name
    next
    '内存
    Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory",,48)
    For Each objItem in colItems
    a=objitem.capacity
    temp=temp+objitem.capacity
    n=n+1
    Next
    memory=temp/1048576
    if n=1 then
    memory2= "内存: " & n & "条" &a&"M"
    else
    memory2= "内存: " & n & "条" &a&"M"&" 总计"&memory&"M"
    end if
    '硬盘
    set disk =objwmiservice.execQuery("select * from win32_diskdrive")
    for each item in disk
    disk2= disk2&"硬盘: " & item.Model&" "
    next
     
    '显卡
    set video =objwmiservice.execQuery("select * from win32_videocontroller",,48)
    for each item in video
    video2= video2&"显卡: " & item.Description
    next
    '网卡
    Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapter",,48)
    For Each objItem in colItems
    if (left(objItem.NetConnectionID,4)="本地连接") then
    lanname=lanname&objItem.Name
    end if
    Next
    lan2="网卡: " & lanname
     
    tempfile.writeline(board2)
    tempfile.writeline(cpu2)
    tempfile.writeline(memory2)
    tempfile.writeline(disk2)
    tempfile.writeline(video2)
    tempfile.writeline(lan2)

    运行此VB之后会在你所设置的目录内生成一个以机器名命名的文本文件
    如下:
    主板:GA-8TRX330
    CPU:Intel(R) Celeron(R) CPU 2.10GHz
    内存: 1条256M
    硬盘: ST3120022A
    显卡: RADEON 9550 Secondary
    网卡: Realtek RTL8139 Family PCI Fast Ethernet NIC
    2008年12月17日 6:25
    版主
  • 12 载入指定目录种的exe和reg

     

    ‘自动运行指定目录的所有指定后缀的文件,程序中为运行EXE和导入REG注册表文件
    Option Explicit
    Dim Folder
    Folder = "c:\test" '设置你要执行的文件夹
    Dim Wsh,fso
    Set Wsh = WScript.CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim f,fc,f1,ext
    Set f = fso.GetFolder(Folder)
    Set fc = f.Files
    For Each f1 in fc
    ext = LCase(fso.GetExtensionName(f1))
    Select Case ext
    Case "exe"
    'msgbox f1
    wsh.run f1,,true
    Case "reg"
    'msgbox "Regedit /s "& f1,,true
    wsh.run "Regedit /s "& f1,,true
    end Select
    Next
     

    Set fso=NoThing
    Set Wsh = Nothing
    WScript.quit
     
    13 扫描远程主机是否有指定进程
     
    Option Explicit
    On Error Resume Next
    Dim intStartingAddress,intEndingAddress,strSubnet,strComputer,ProName
    Dim objShell,strCommand,objExecObject,strText
     
    intStartingAddress = 247 '设置起始IP
    intEndingAddress = 251 '设置结束IP
    strSubnet = "192.168.1." '设置IP段前缀
    ProName = "clsmn.exe" '你要检查的进程名,注意大小写
     
    Dim Wsh,fso,logfile
    Set Wsh = WScript.CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set logfile = fso.OpenTextFile("扫描记录.txt",2,True)
    logfile.Writeline time&" 开始扫描"
    logfile.WriteBlankLines(1)
    Dim i
    For i = intStartingAddress to intEndingAddress
    strComputer = strSubnet & i
    Set objShell = CreateObject("WScript.Shell")
    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
    If Not CheckPro(strComputer,ProName) Then
    Doit(strComputer)
    End If
    End If
    Loop
    Next
    logfile.WriteBlankLines(1)
    logfile.Writeline time&" 扫描结束"
    logfile.close
    Msgbox "扫描结束",64,"扫描结束"
    WScript.quit
     

    Function CheckPro(strComputer,ProName)
    Dim objWMIService,colProcesses,objProcess
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process")
    CheckPro = False
    For Each objProcess in colProcesses
    If objProcess.Name = ProName Then
    CheckPro = True
    Exit For
    End If
    Next
    End Function
     
    Sub Doit(strComputer)
    logfile.Writeline "注意 "&strComputer&" 状态异常 "&time
    Wsh.popup "注意 "&strComputer&" 状态异常",5
    End Sub
    14 写入注册表后再运行指定程序

    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"
     
    15 '隔5分钟运行一次批处理程序
    Dim Wsh
    Set Wsh = WScript.CreateObject("WScript.Shell")
    Do
    Wsh.Run "d:\\aaa.bat" '你要执行的批处理
    WScript.Sleep(300000)
    Loop
     
     
    16 将域用户或租添加到本地组
    Set objGroup = GetObject(WinNT://./Administrators)
    Set objUser = GetObject(WinNT://testnet/Engineers)
    objGroup.Add(objUser.ADsPath)
     
     
    17 修改本地管理员密码
    Set objcnlar = GetObject(WinNT://./administrator, user)
    objcnla.SetPassword P@ssW0rd
    objcnla.SetInfo

     

    2008年12月17日 6:28
    版主
  • 18  注册表的修改,读取,删除,创建

     

    Set wso = CreateObject(WScript.Shell) '声明
    wso.RegWrite %Path% '创建子键
    wso.RegWrite %Path%,%Value% '修改默认键值
    wso.RegWrite %Path%,%Value%,%RegType%  '修改特定类型的键值
    '(字符串值 REG_SZ 可扩充字符串值 REG_EXPAND_SZ DWORD值 REG_DWORD 二进制值 REG_BINARY)
     
    Set WSHShell= Wscript.CreateObject(Wscript.Shell)
    WSHShell.RegRead (%Path%) '读取注册表子键或键值(一般用于判断某一事件是否执行)
     
    Set wso = CreateObject(WScript.Shell)
    wso.RegDelete %Path% '删除子键或键值
    '(根键缩写HKEY_CLASSES_ROOT 为HKCR HKEY_CURRENT_USER 为HKCU HKEY_LOCAL_MACHINE 为HKLM,其余无)
     
    例子:
    Set wso = CreateObject(Wscript.Shell)
    wso.RegWrite HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1
    wso.RegWrite HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1,0
    wso.RegWrite HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1\\#2,0,REG_BINARY
    wso.RegDelete HKLM\\SOFTWARE\\Microsft\\Windows NT\\#1
    Wscript.quit
     
     
    19 '文件的复制,删除,创建,简单的写入

    Set fso = Wscript.CreateObject(Scripting.FileSystemObject) ‘声明
    Set f = fso.CreateTextFile(%PATH%) '创建文件,其中f可任意,包含缩略名
    f.WriteLine(VBS) '写入文件一行内容,该命令功能太简单,目前看来只能用于TXT文件
    f.Close '关闭打开的文件
    set c=fso.getfile(%path%) ’拷贝某文件
    c.copy(%PATH2%) \'拷贝文件到指定地点
    fso.deletefile(%PATH%) \'删除文件
     
    例子:
    Set fso = Wscript.CreateObject(Scripting.FileSystemObject)
    Set f=fso.CreateTextFile("C:\\Sample.txt")
    f.WriteLine(VBS)
    f.close
    set e=fso.getfile(C:\\Sample.txt)
    e.copy(D:\\Sample.txt)
    fso.deletefile(C:\\Sample.txt)
    Wscript.quit
     
     
     
    20 向应用程序输出简单的连串指令

    dim program1 '声明变量program1
    program1= %Path% '应用程序路径
    set wshshell=createobject(wscript.shell) '声明引用函数
    set oexec=wshshell.exec(program1) '运行程序
    wscript.sleep 2000 '延迟2000毫秒
    wshshell.appactivate %WindowsName% '指定要激活的程序窗口标题
    wshshell.sendkeys +{%KeyBoardName%} '第一次输出键盘按键指令前要加+
    wshshell.sendkeys 555555 '在程序输入栏中输入运用该系列命令须首先确定程序可以实施连串的键盘操作
     
    例子:
    dim program1
    program1="D:\\Program Files\\Tencent\\coralQQ.exe"
    set wshshell=CreateObject(wscript.shell)
    set oexec=wshshell.exec(program1)
    wscript.sleep 2000
    wshshell.appactivate "QQ登录"
    wshshell.sendkeys +{TAB}
    wshshell.sendkeys 250481892
    wscript.sleep 2000
    wshshell.sendkeys {TAB}
    wshshell.sendkeys ****************
    wscript.sleep 2000
    wshshell.sendkeys {ENTER}
    Wscript.quit
     
     
    21 文件夹的简单操作

    Set fso = Wscript.CreateObject(Scripting.FileSystemObject) ‘声明
    Set f = fso.CreateFolder(%PATH%) '创建文件夹
    Set e = getFolder(%PATH%) '类似于“绑定目标”
    e.copy(%PATH2%) '复制文件夹
    fso.deletefolder(%PATH%) '删除文件夹
     
    例子:
    Set fso = Wscript.CreateObject(Scripting.FileSystemObject)
    Set f = fso.CreateObject("C:\\sample")
    f.copy("D:\\sample")
    fso.deletefolder("C:\\sample")
    '(由上例可以看出,文件夹的操作很多是和文件的操作相通的,因此VBS文件具有很多命令的统一性)
     
     
    22将某一指定文件夹的所有只读文件转为可读文件

    Const ReadOnly = 1 ‘设只读属性对应值为1
     
    Set FSO = CreateObject(Scripting.FileSystemObject) \'声明
    Set Folder = FSO.GetFolder(%PATH%) ’绑定文件夹
    Set colFiles = Folder.Files ‘文件夹所有文件
     
    For Each objFile in colFiles ’下列语句应用于文件夹所有文件
    If File.Attributes AND ReadOnly Then '这是关键之处,这里应用了If判断语句,来检测文件属性是否为只读
       File.Attributes = File.Attributes XOR ReadOnly '对判断结果为Ture(默认为True)’执行XOR逻辑运算,将其改为可读
    End If ‘结束判断
    Next
     
     
     
    23 将Word文件另存为文本文件

    Const wdFormatText = 2 '设置常数值
    '(当该值为8时另存为HTML文档,为11时另存为XML文档)
    Set objWord = CreateObject(Word.Application) '申明调用函数
    Set objDoc = objWord.Documents.Open(%Path%) '打开某DOC文件
    objDoc.SaveAs %PATH2%, wdFormatText '另存为……
    objWord.Quit
     
    例子:
    Const wdFormatText = 2
    Set objWord = CreateObject(Word.Application)
    Set objDoc = objWord.Documents.Open("d:\\doc1.doc")
    objDoc.SaveAs "g:\\doc1.txt", wdFormatText
    objWord.Quit
     
     
     
    24禁用开始菜单选项

    Dim ChangeStartMenu
    Set ChangeStartMenu=WScript.CreateObject("WScript.Shell")
    RegPath="HKCR\\Software\\Microsoft\\Windows\\CurrentVersion\\Policies\\"
    Type_Name="REG_DWORD"
    Key_Data=1
       
    StartMenu_Run="NoRun"
    StartMenu_Find="NoFind"
    StartMenu_Close="NoClose"
       
    Sub Change(Argument)
    ChangeStartMenu.RegWrite RegPath&Argument,Key_Data,Type_Name
    MsgBox("Success!")  
    End Sub
       
    Call Change(StartMenu_Run) '禁用“开始”菜单中的“运行”功能
    Call Change(StartMenu_Find) '禁用“开始”菜单中的“查找”功能
    Call Change(StartMenu_Close) '禁用“开始”菜单中的“关闭系统”功能
     
     
    25重新启动指定的IIS服务
     
    Const ADS_SERVICE_STOPPED = 1
    Set objComputer = GetObject("WinNT://MYCOMPUTER,computer")
    Set objService = objComputer.GetObject("Service","MYSERVICE")
    If (objService.Status = ADS_SERVICE_STOPPED) Then
    objService.Start
    End If
     
     
     
    26 添加系统自动启动程序
     
    Dim AutoRunProgram
    Set AutoRunProgram=WScript.CreateObject("WScript.Shell")
    RegPath="HKLM\\Software\\Microsoft\\Windows\\CurrentVersion\\Run\\"
    Type_Name="REG_SZ"
    Key_Name="AutoRun"
    Key_Data="C:\\Myfile\\autorun.exe"
    '该自启动程序的全路径文件名
    AutoRunProgram.Write RegPath&Key_Name,Key_Data,Type_Name
    '在启动组中添加自启动程序autorun.exe
     
     
     
     27实现整理磁盘碎片功能
     
    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
     
    28 启用和禁用网卡
     
    'this.vbs---disable/enable network interface card
    'usage: cscript /nologo this.vbs
    sConnectionName = "LAN"          '本地连接
    sEnableVerb = "启用(&A)"   '启用(&A)
    sDisableVerb = "禁用(&B)"  '禁用(&B)
    sFolderName = "网络和拨号连接" '网络和拨号连接
     
    Const ssfCONTROLS = 3
    set shellApp = createobject("shell.application")
    set oControlPanel = shellApp.Namespace(ssfCONTROLS)
    set oNetConnections = nothing
    for each folderitem in oControlPanel.items
        if folderitem.name  = sFolderName then
            set oNetConnections = folderitem.getfolder: exit for
        end if
    next
    if oNetConnections is nothing then
        wscript.quit
    end if
    set oLanConnection = nothing
    for each folderitem in oNetConnections.items
        if lcase(folderitem.name)  = lcase(sConnectionName) then
            set oLanConnection = folderitem: exit for
        end if
    next
    if oLanConnection is nothing then
        wscript.quit
    end if
    bEnabled = true
    set oEnableVerb = nothing
    set oDisableVerb = nothing
    s = "Verbs: " & vbcrlf
    for each verb in oLanConnection.verbs
        s = s & vbcrlf & verb.name
        if verb.name = sEnableVerb then
            set oEnableVerb = verb
            bEnabled = false
        end if
        if verb.name = sDisableVerb then
            set oDisableVerb = verb
        end if
    next
    if oDisableVerb is nothing and oEnableVerb is nothing then
        wscript.quit
    end if
    if bEnabled then
        oDisableVerb.DoIt
    else
        oEnableVerb.DoIt
    end if
     
    wscript.sleep 1000
     
    29 对比删除文件
     

    dim sdir,ddir
    \'远程目录
    sdir="\\\\192.168.0.200\\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

     

    30 虚拟光驱自动加载镜像文件


    Dim Wsh,DMpath,ISOpath
    DMpath = "X:\Y\daemon.exe" '设置D-Tools路径
    ISOpath = "Z:\大富翁七\RICH7B.mds" '设置镜像文件路径
    Set Wsh = WScript.CreateObject("WScript.Shell")
    Wsh.run chr(34) & DMpath & chr(34) &" -mount 0,"&chr(34)&ISOpath&chr(34),0,true
    Wscript.Sleep 3000 '最好延时几秒等待镜像加载完毕 1000 = 1 秒
    Wsh.run "Z:\大富翁七\rich7.exe"
    Set WSH = Nothing
    WScript.quit

     

    31 获得特定文件夹的路径

     

    Set wsShell = CreateObject("WScript.Shell")
    DesktopPath = wsShell.SpecialFolders("Desktop")

     

    32 延时启动指定程序

     

    Dim Wsh
    Set Wsh = WScript.CreateObject("WScript.Shell")
    WScript.Sleep(60000)'单位为毫秒
    Wsh.Run "D:\bat.bat",,True
    Set Wsh=NoThing
    WScript.quit

    2008年12月17日 6:34
    版主