詢問一段 VB 寫法

1833

其實這個算哪種語言，我不懂，但是這一串真的好用。

裡面"PING指令 + IP "直接寫在裡面，就不太方便，請教；該如何修改才能變成執行後才輸入要測試的IP?


***************************************************

Set shell = WScript.CreateObject("WScript.Shell")
Set re=New RegExp
re.Pattern = "^Reply|^Request"
Set myping=shell.Exec("ping 127.0.0.1 -t")
while Not myping.StdOut.AtEndOfStream
        strLine = myping.StdOut.ReadLine()
        r=re.Test(strLine)
        If r Then
                WScript.Echo date & " "& time & chr(99) & strLine
        End if
Wend


***************************************************

PS: 這工具用法；在Windows XP 下，將上面***內的字串段落複製到記事本哩，另存成*.VBS (檔名隨意囉)，點*.VBS後"以命令提示開啟"就能看到成果。

1833

謝謝

努力組合中

1833

這段期間蒐集不少與這相關vbs, 但是發現在 win server 2008 . win7 . win xp, 使用"以命令提示開啟"執行後結果都不一至.

繼續努力修改到喜歡樣式

andyboy

Dear all:
我習慣用VBA寫，VBS也不錯用，只是不習慣。
如果要拿來管理IP，察看指定機器是否有開機
應該還是用Excel來做會簡單些，我將程式碼貼上
並附上範本，希望對各位有幫助。

[Visual Basic] 純文本查看 復制代碼

Sub check_Ping()
'檢測電腦是否在網路上，或者說是否開機
'如果PING不到，IP顏色會變成灰色，有PING到，則變回黑色
'方式有三種：
'1.單一:選擇一個IP
'2.多重:在指定欄位內(iTC)選擇範圍，點選Ping即可多個Ping測試
'3.全部:選擇小於資料起始列，且位在iTC欄，點選Ping即進行全部測試
'  (範本為  IP Adderss標題欄)

Dim iTC As Integer, iSR As Integer

iTC = 4 ' IP放置欄位
iSR = 2 ' 資料起始列


If Selection.Column = iTC And Selection.Row > 4 And Selection.Count < 2 Then
    If Ping(Cells(Selection.Row, iTC)) = True Then
        Cells(Selection.Row, iTC).Font.ColorIndex = 0
        Cells(Selection.Row, iTC).Font.Italic = False
    Else
        Cells(Selection.Row, iTC).Font.Italic = True
        Cells(Selection.Row, iTC).Font.ColorIndex = 15
    End If
ElseIf Selection.Row < iSR And Selection.Column = iTC Then
    If MsgBox("Ping all IP?", vbOKCancel) = 2 Then
        MsgBox "If you just want to ping 1 IP, please select IP on this table, and click this button again. "
        Exit Sub
    End If

    For i = iSR To Cells(2, 1).End(xlDown).Row
        If Cells(i, iTC) = Empty Then
        Else
            If Ping(Cells(i, iTC)) = True Then
                Cells(i, iTC).Font.ColorIndex = 0
                Cells(i, iTC).Font.Italic = False
            Else
                Cells(i, iTC).Font.Italic = True
                Cells(i, iTC).Font.ColorIndex = 15
            End If
        End If
    Next
ElseIf Selection.Count > 1 And Selection.Column = iTC Then
    If MsgBox("Ping " & Selection.Count & " IPs?", vbOKCancel) = 2 Then
        MsgBox "If you just want to ping 1 IP, please select IP on this table, and click this button again. "
        Exit Sub
    End If

    For i = Selection.Row To Selection.Row + Selection.Count
        If Cells(i, iTC) = Empty Then
        Else
            If Ping(Cells(i, iTC)) = True Then
                Cells(i, iTC).Font.ColorIndex = 0
                Cells(i, iTC).Font.Italic = False
            Else
                Cells(i, iTC).Font.Italic = True
                Cells(i, iTC).Font.ColorIndex = 15
            End If
        End If
    Next
    

End If

End Sub


Function Ping(strComputer)
      Dim objShell, boolCode
      Set objShell = CreateObject("WScript.Shell")
      boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
      If boolCode = 0 Then
            Ping = True
      Else
            Ping = False
      End If
End Function

發文驗証碼:fd2ik434a2ft44f

1833

andyboy 發表於 2013-8-11 22:47
Dear all:
我習慣用VBA寫，VBS也不錯用，只是不習慣。
如果要拿來管理IP，察看指定機器是否有開機

哇 好棒

謝謝