c_c_lai

¦^´_ 20# linderlong
³o¬O§Aºô¸ôÅv­­¤£°÷ªº½t¬G¡C
¥ç§Y Users' ªºÅv­­¤£¨¬µLªk«ü¨ì Windows/system32/ ªº¸ô®|¡C

c_c_lai

¦^´_  c_c_lai
¥[¤JdoeventsÁÙ¬O¤£¦æ¡CªGµM¬O§ä¤£¨ìcommand«ü¥O¡A¤£ª¾¦³µL¨ä¥¦´À¥N¤èªk¡H¤£¦n·N«ä¡A¤U¯Z¤F ...
linderlong µoªí©ó 2013-8-30 16:59

¶¢¶¢µL¨Æ¡A¶K¤W´X­Ó Function¡A ¦Û¤v¬Ý¬Ý­þºØ¾A¥Î¡C
1.  ´ú¸Õ¥Dµ{¦¡¡G

1. Sub TestPing()
   
2.     Dim xi As Integer
   
3.    
   
4.     xi = 1
   
5.     Do
   
6.         If Cells(xi, 1) <> "" Then
   
7.             '  MsgBox sPing("www.microsoft.com")
   
8.             '  Cells(xi, "C") = sPing("www.google.com")
   
9.             Cells(xi, "C") = Ping2("www.google.com")
   
10.             '  Cells(xi, "C") = sPing(Cells(xi, 1))
    
11.             '  Cells(xi, "C") = IsConnectible(Cells(xi, 1))
    
12.         End If
    
13.         xi = xi + 1
    
14.     Loop Until Cells(xi, 1) = ""
    
15. End Sub

½Æ»s¥N½X

¥H¤U¬°µ{¦¡¼Ò²Õ¡A§A¥i¥H¤@¤@´ú´ú¬Ý¡G

1. Private Function Ping2(strAddr As String) As String
   
2.     Dim strTmpFile As String
   
3.    
   
4.     strTmpFile = Environ("TEMP") & "\PingResult.txt"   '  ·Ç³Æ«Ø¼È¦sÀɦb Windows Temp ¥Ø¿ý¤U
   
5.     '  «Ø¥ß WScript ª«¥ó Shell Ãþ§O , ¨Ï¥Î Run ¤èªk , ©I¥s¥~³¡«ü¥O Ping ( ¨Ãµ¥«Ý¨ä°õ¦æµ²§ô )
   
6.     CreateObject("WScript.Shell").Run Environ("COMSPEC") & " /c PING " & strAddr & " > " & strTmpFile, 0, True
   
7.     '  PS : "Ping IP¦ì¸m > XXÀÉ®×" ³o¸Ì¬O¨Ï¥Î > ¨Ó±N Ping µ²ªG¼g¨ìÀɮ׸Ì
   
8.     '  ( ·íµM¤]¥i Call API CreatePipe ¨ÓŪ¨ú©R¥Oµ²ªG )
   
9.     '  Ping ¬O¤@ºØ¤½¥Îµ{¦¡¡A¥i¥HÅçÃÒ¤@©Î¦h­Ó»·ºÝ¥D¾÷³s½u¡C
   
10.     '  Ping «ü¥O¥Î ICMP ¦^À³­n¨D©M¦^À³¦^ÂЮM¸Ë³nÅé¨Ó¨M©wºô¸ô¤Wªº¯S®í IP ¨t²Î¬O§_¥¿±`¹B§@¡C
    
11.     '  Ping ¹ï¶EÂ_ IP ºô¸ô©Î¸ô¥Ñ¾¹¥¢±Ñ«D±`¦³¥Î¡C
    
12.     '  Internet Control Message Protocol (ICMP)
    
13.     '  TCP/IP ²Õ¥ó¤¤¥²­nªº¤@ºØºûÅ@³q°T¨ó©w¡A¥i³ø§i¿ù»~¨Ã¤¹³\²©ö³s½u¡C
    
14.     '  Ping ¤u¨ã¥Î¨Ó°õ¦æ TCP/IP ºÃÃø±Æ¸Ñªº ICMP¡C
    
15.     '  ¸Ô²Ó»¡©ú¤Î¥Îªk¥i°Ñ¦Ò:
    
16.     '  ms-its:%WINDIR%\Help\ntcmds.chm::/ping.htm
    
17.     '  ms-its:%WINDIR%\Help\ntcmds.chm::/ping.htm
    
18.     '  ms-its:%WINDIR%\Help\tcpip.chm::/sag_TCPIP_pro_PingConnect.htm
    
19.     '  ms-its:%WINDIR%\Help\tcpip.chm::/sag_TCPIP_pro_Ping.htm
    
20.     '  «Ø¥ßÀɮרt²Îª«¥ó,¥Î¨Ó¶}±Ò¼È¦s¤å¦rÀÉ,¨ÃŪ¨ú¤º®e ( ¨ú¦^ Pingªºµ²ªG )
    
21.     Ping2 = CreateObject("Scripting.FileSystemObject").OpenTextFile(strTmpFile).ReadAll
    
22.     Ping2 = Replace(Ping2, vbCrLf, "", 1)
    
23.    
    
24.     On Error Resume Next
    
25.     Kill strTmpFile         '  §R°£¼È¦sÀÉ
    
26. End Function

½Æ»s¥N½X

c_c_lai

¦^´_ 20# linderlong

1. Function sPing(sHost) As String
   
2.     Dim oPing As Object, oRetStatus As Object
   
3.      
   
4.     Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
   
5.       ("select * from Win32_PingStatus where address = '" & sHost & "'")
   
6.      
   
7.     '  The following script illustrates how to use the StatusCode property of the Win32_PingStatus class
   
8.     '  to determine whether a remote computer is responding to the PING command.
   
9.     '  A value of the StatusCode equal to 0 indicates the PING command was successful;
   
10.     '  a non-zero value indicates a failure.
    
11.     '  The reason for the failure can be determined by analyzing returned value,
    
12.     '  which can be one of the following:
    
13. 
    
14.     '  11001 Buffer Too Small
    
15.     '  11002 Destination Net Unreachable
    
16.     '  11003 Destination Host Unreachable
    
17.     '  11004 Destination Protocol Unreachable
    
18.     '  11005 Destination Port Unreachable
    
19.     '  11006 No Resources
    
20.     '  11007 Bad Option
    
21.     '  11008 Hardware Error
    
22.     '  11009 Packet Too Big
    
23.     '  11010 Request Timed Out
    
24.     '  11011 Bad Request
    
25.     '  11012 Bad Route
    
26.     '  11013 TimeToLive Expired Transit
    
27.     '  11014 TimeToLive Expired Reassembly
    
28.     '  11015 Parameter Problem
    
29.     '  11016 Source Quench
    
30.     '  11017 Option Too Big
    
31.     '  11018 Bad Destination
    
32.     '  11032 Negotiating IPSEC
    
33.     '  11050 General Failure
    
34. 
    
35.     For Each oRetStatus In oPing
    
36.         If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then
    
37.             sPing = "Status code is " & oRetStatus.StatusCode
    
38.         Else
    
39.             sPing = oRetStatus.ProtocolAddress & Chr(10) & "Pinging " & sHost & " with " & oRetStatus.BufferSize & " bytes of data:" & Chr(10) & Chr(10)
    
40.             sPing = sPing & "Time (ms) = " & vbTab & oRetStatus.ResponseTime & Chr(10)
    
41.             sPing = sPing & "TTL (s) = " & vbTab & vbTab & oRetStatus.ResponseTimeToLive
    
42.         End If
    
43.     Next
    
44.    
    
45.     Set oRetStatus = Nothing
    
46.     Set oPing = Nothing
    
47. End Function

½Æ»s¥N½X

c_c_lai

¦^´_ 20# linderlong

1. Function IsConnectible(sHost As String, Optional iPings As Integer = 1, Optional iTO As Integer = 250)
   
2.     '  Returns True or False based on the output from ping.exe
   
3.     '
   
4.     '  Authors: Alex Angelopoulos/Torgeir Bakken
   
5.     '  Modified by: Tom Lavedas
   
6.     '  Works an "all" WSH versions
   
7.     '  sHost is a hostname or IP
   
8.     '  iPings is number of ping attempts
   
9.     '  iTO is timeout in milliseconds
   
10.     '  if values are set to "", then defaults below used
    
11.     '  iPings default number (1) of pings
    
12.     '  iTO default timeout (250) per ping
    
13.     Dim nRes
    
14.    
    
15.     With CreateObject("WScript.Shell")
    
16.         nRes = .Run("%comspec% /c ping.exe -n " & iPings & " -w " & iTO _
    
17.                      & " " & sHost & " | find ""TTL="" > nul 2>&1", 0, True)
    
18.     End With
    
19.    
    
20.     IsConnectible = (nRes = 0)
    
21. End Function

½Æ»s¥N½X

linderlong

¦^´_ 24# c_c_lai
¯u¬O·d¯º¡A·L³n¤£ª¾¦b°µ¤°»ò¡Axp¤Îw7¡A32¦ì¤¸¤U¡A§¡¦³command«ü¥O¥i¥Î¡A¦Ó¦bw7¡A64¦ì¤¸¤U¡A«h§ï¬°cmd¡Acommand¤Ï¦Ó¤£¯à¥Î¡C
¦]¦¹¥u­n±N
RetVal = Shell("command.com /c Ping -n 1 " & Cells(i, 1) & " > " & ThisWorkbook.Path & "\" & i & ".txt")
§ï¬°
RetVal = Shell("cmd /c Ping -n 1 " & Cells(i, 1) & " > " & ThisWorkbook.Path & "\" & i & ".txt")
§Y¥i¥¿½T°õ¦æ¡A¹ê¦b·PÁ¤j¤jªº«ü¾É¡AÁÂÁ¡I:L