Vbscript 使用VBS Ping服务器列表_Vbscript

Vbscript 使用VBS Ping服务器列表

vbscript

Vbscript 使用VBS Ping服务器列表,vbscript,Vbscript,我有以下脚本ping服务器列表（txt文件，每行一个服务器），如果关闭，将信息记录到csv文件中。脚本工作正常，但我无法解决脚本的两个问题： 1）我希望脚本仅在列表中的一个服务器关闭时创建一个文件。当前，如果没有服务器关闭，它将创建一个带有标题行的空文件。我已经通过编写另一个脚本暂时修复了这个问题，该脚本稍后会删除空文件，但最好不要首先创建该文件 2）有没有办法ping两次或三次以双重/三重检查服务器是否已关闭，然后记录它已关闭？目前，脚本记录到有时服务器关闭，而我并不认为它真的关闭了，可能

我有以下脚本ping服务器列表（txt文件，每行一个服务器），如果关闭，将信息记录到csv文件中。脚本工作正常，但我无法解决脚本的两个问题：

1）我希望脚本仅在列表中的一个服务器关闭时创建一个文件。当前，如果没有服务器关闭，它将创建一个带有标题行的空文件。我已经通过编写另一个脚本暂时修复了这个问题，该脚本稍后会删除空文件，但最好不要首先创建该文件

2）有没有办法ping两次或三次以双重/三重检查服务器是否已关闭，然后记录它已关闭？目前，脚本记录到有时服务器关闭，而我并不认为它真的关闭了，可能是我的互联网连接或计算机挂起了一秒钟，所以ping失败了

提前谢谢！我刚刚进入VBS，所以这对我来说是一个陌生的领域

Dim WshShell
Set WshShell = createobject("wscript.shell")
strURL = "www.yahoo.com"
set png = WshShell.exec("ping -n 1 " & strURL)
do until png.status = 1
wscript.sleep 100
loop
strPing = lcase(png.stdout.readall)
Select Case True
 Case InStr(strPing, "reply from") > 1 

dim strInputPath, strOutputPath, strStatus
dim objFSO, objTextIn, objTextOut

strSafeDate = DatePart("yyyy",Date) & Right("0" & DatePart("m",Date), 2) & Right("0" & DatePart("d",Date), 2)

strSafeTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)

strDateTime = strSafeDate & "-" & strSafeTime

strInputPath = "C:\Users\user\Desktop\PING\serverlist.txt" '- location of input
strOutputPath = "C:\Users\user\Desktop\PING\log\" & strDateTime & ".csv" '- location of output
set objFSO = CreateObject("Scripting.FileSystemObject")
set objTextIn = objFSO.OpenTextFile( strInputPath,1 )
set objTextOut = objFSO.CreateTextFile( strOutputPath )
objTextOut.WriteLine("website,status,date")

Do until objTextIn.AtEndOfStream = True
    strComputer = objTextIn.ReadLine
        if fPingTest( strComputer ) then
             strStatus = "UP"
        else
             strStatus = "DOWN"
        end if
        if strStatus = "DOWN" then
              objTextOut.WriteLine(strComputer & "," & strStatus & "," & Now)
        end if
loop

function fPingTest( strComputer )
        dim objShell,objPing
        dim strPingOut, flag
        set objShell = CreateObject("Wscript.Shell")
        set objPing = objShell.Exec("ping " & strComputer)
    strPingOut = objPing.StdOut.ReadAll
    if instr(LCase(strPingOut), "reply") then
        flag = TRUE
        else
                flag = FALSE
        end if
        fPingTest = flag

end function

  Case Else
  End Select

如果需要，您可以使用等待栏尝试我的修改代码：

Option Explicit
Dim strInputPath,strOutputPath,strStatus,strSafeDate,strSafeTime,strDateTime,Titre,MsgTitre,MsgAttente
Dim objFSO,objTextIn,objTextOut,ReadAllFile,Lines,Line,Ws,Command,OpenCSVFile,oExec,Temp,StartTime,DurationTime
Set Ws = CreateObject("WScript.Shell")
Titre = "Ping list of servers"
MsgTitre = Titre
MsgAttente = "Please wait ... the pinging is on progress ...."
Temp = ws.ExpandEnvironmentStrings("%Temp%")
strSafeDate = DatePart("yyyy",Date) & Right("0" & DatePart("m",Date), 2) & Right("0" & DatePart("d",Date), 2)
strSafeTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
strDateTime = strSafeDate & "-" & strSafeTime
strInputPath = "C:\PingServer\serverlist.txt" '- location of input
strOutputPath = "C:\PingServer\" & strDateTime & ".csv" '- location of output
set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strInputPath) Then
    set objTextIn = objFSO.OpenTextFile(strInputPath,1)
else
    MsgBox "CRITICAL ERROR " & VbCrLF & "The File "& DblQuote(strInputPath) & " dosen't exists !",VbCritical,"CRITICAL ERROR " & Titre
    Wscript.Quit
End if
set objTextOut = objFSO.CreateTextFile(strOutputPath)
objTextOut.WriteLine("website;status;date")
ReadAllFile = objTextIn.ReadAll
Lines = Split(ReadAllFile,vbCrLf)
Call CreateProgressBar(MsgTitre,MsgAttente)'Create the waiting Bar
Call LancerProgressBar()'Lancement de la barre de progression
StartTime = Timer 'Debut du Compteur Timer 
For Each Line In Lines
    If OnLine(Line) = True Then
        strStatus = "UP"
        objTextOut.WriteLine(Line & ";" & strStatus & ";" & Now)
    else
        strStatus = "DOWN"
        objTextOut.WriteLine(Line & ";" & strStatus & ";" & Now)
    end if
Next
Call FermerProgressBar()'Closing the waiting Bar
DurationTime = FormatNumber(Timer - StartTime, 0) & " seconds." 'La duree de l'execution du script
Command = "cmd /c CD " & DblQuote(ExcelPath()) & " | Start Excel.exe" &" /E "& DblQuote(strOutputPath)
Ws.Popup "The pinging Script is finshed in "& DurationTime,"2",MsgTitre,64
OpenCSVFile = ws.run(Command,0,False)
'************************************************************************************************************************************************************
Function OnLine(strHost)
    Dim objPing,z,objRetStatus,PingStatus
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
    z = 0
    Do   
        z = z + 1
        For Each objRetStatus In objPing
            If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
                PingStatus = False
            Else
                PingStatus = True
            End If     
        Next   
        Call Pause(1)
        If z = 5 Then Exit Do 'here you can incerase or decerase the value of z = 5
    Loop until PingStatus = True
    If PingStatus = True Then
        OnLine = True
    Else
        OnLine = False
    End If
End Function
'*********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Function ExcelPath()
    Dim appXL,s
    Set appXL = CreateObject("Excel.Application")
    ExcelPath = appXL.Path
    appXL.Quit
    Set appXL = Nothing
End Function
'**********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER>"
    fhta.WriteLine "<marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee>"
    fhta.WriteLine "<br><img src=""data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHonOWBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8PNorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/JiBFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoXyOoqYaBamqBROrqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIphpe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgAAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYBedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGyBROzsrW2tA+5ug68uLbAsxMDxcYDxMfFycrMx87Gv7u5wrfTwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoELHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgSve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwoMR48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipBROqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9DFDr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbBROcm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA"" />"
    fhta.WriteLine "</CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 350,100"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************

选项显式
Dim strInputPath、STROUTPATH、strStatus、strSafeDate、strSafeTime、strDateTime、Titre、MsgTitre、MSGATENTE
Dim objFSO、OBJTEXTE、OBJTEXOUT、ReadAllFile、Lines、Line、Ws、Command、OpenCSVFile、oExec、Temp、StartTime、DurationTime
设置Ws=CreateObject（“WScript.Shell”）
Titre=“Ping服务器列表”
mSgTire=滴定度
MsgAttente=“请稍候…ping正在进行中…”
Temp=ws.ExpandEnvironmentStrings（“%Temp%”）
strSafeDate=DatePart（“yyyy”，Date）和Right（“0”和DatePart（“m”，Date），2）和Right（“0”和DatePart（“d”，Date），2）
strSafeTime=Right（“0”和小时（现在），2）和Right（“0”和分钟（现在），2）和Right（“0”和秒（现在），2）
strDateTime=strSafeDate&“-”和strSafeTime
strInputPath=“C:\PingServer\serverlist.txt”—输入的位置
strOutputPath=“C:\PingServer\”&strDateTime&“.csv”—输出的位置
设置objFSO=CreateObject（“Scripting.FileSystemObject”）
如果存在objFSO.files（strInputPath），则
设置objtude=objFSO.OpenTextFile（strInputPath，1）
其他的
MsgBox“严重错误”&VbCrLF&“文件”&DblQuote（strInputPath）&dosen't exists！”，VbCritical，“严重错误”&Titre
Wscript.Quit
如果结束
设置objTextOut=objFSO.CreateTextFile（strOutputPath）
objtexout.WriteLine（“网站；状态；日期”）
ReadAllFile=objteme.ReadAll
行=拆分（ReadAllFile，vbCrLf）
调用CreateProgressBar（MsgTitre，MsgAttente）'创建等待栏
调用LancerProgressBar（）'Lancement de la barre de progression
StartTime=计时器的首个计时器
每行中的每一行
如果在线（Line）=True，则
strStatus=“向上”
写入线（行&“；”&strStatus&“；”&Now）
其他的
strStatus=“向下”
写入线（行&“；”&strStatus&“；”&Now）
如果结束
下一个
调用FermerProgressBar（）'关闭等待栏
DurationTime=FormatNumber（计时器-开始时间，0）和“秒”。“在脚本执行期间”
Command=“cmd/c CD”&DblQuote（ExcelPath（））&“| Start Excel.exe”&”/E“&DblQuote（strOutputPath）
Ws.Popup“ping脚本在中找到”&DurationTime，“2”，MsgTitre，64
OpenCSVFile=ws.run（命令，0，False）
'************************************************************************************************************************************************************
在线功能（strHost）
尺寸对象，z，对象状态，PingStatus
Set objPing=GetObject（“winmgmts:{impersonationLevel=impersonate}”）.ExecQuery（“从Win32中选择*，其中地址=””&strHost&“”）
z=0
做
z=z+1
对于objRetStatus中的每个objRetStatus
如果IsNull（objRetStatus.StatusCode）或objRetStatus.StatusCode为0，则
PingStatus=False
其他的
PingStatus=True
如果结束
下一个
呼叫暂停（1）
如果z=5，则退出“执行”，您可以在此处增加或减少z=5的值
循环直到PingStatus=True
如果PingStatus=True，则
在线=真
其他的
在线=错误
如果结束
端函数
'*********************************************************************************************
子暂停（N秒）
Wscript.Sleep（秒*1000）
端接头
'**********************************************************************************************
函数ExcelPath（）
Dim appXL，s
设置appXL=CreateObject（“Excel.Application”）
ExcelPath=appXL.Path
appXL.退出
设置appXL=Nothing
端函数
'**********************************************************************************************
'Fonction pour ajour les double引用了一个变量
函数DblQuote（Str）
DblQuote=Chr（34）和Str&Chr（34）
端函数
'**********************************************************************************************
分包商（滴度、MSGATENTE）
尺寸ws、fso、f、f2、ts、ts2、Ligne、i、fread、LireTout、NbLigneTotal、Temp、病理输出HTML、fhta、oExec
设置ws=CreateObject（“wscript.Shell”）
设置fso=CreateObject（“Scripting.FileSystemObject”）
Temp=WS.ExpandEnvironmentStrings（“%Temp%”）
PathOutPutHTML=Temp&“\Barre.hta”
设置fhta=fso.OpenTextFile（PathOutPutHTML，2，True）
fhta.WriteLine“”
fhta.WriteLine“”
fhta.WriteLine“&标题和”
fhta.WriteLine“”
fhta.WriteLine“”
fhta.WriteLine“”
fhta.WriteLine“&MsgAttente&”
fhta.WriteLine“
”
fhta.WriteLine“”
fhta.WriteLine“”
fhta.WriteLine“Set ws=CreateObject（““wscript.Shell”）”
fhta.WriteLine“Temp=WS.ExpandEnvironmentStrings（“%Temp%”）”
fhta.WriteLine“子窗口加载（）
fhta.WriteLine“中心窗口350100”
fhta.WriteLine“Self.document.bgColor=”“DarkOrange”“”
fhta.WriteLine“末端接头”
fhta.WriteLine“子中心窗口（x，y）”
fhta.WriteLine“Dim iLeft，itop”
fhta.WriteLine“window.resizeTo x，y”
fhta.WriteLine“iLeft=window.screen.availWidth/2-x/2”
fhta.WriteLine“itop