Code: Select all
OPTION Explicit
DIM cn,cmd,rs
DIM objRoot
DIM intFailed, intSucceeded
DIM strPing
set cmd = createobject("ADODB.Command")
set cn = createobject("ADODB.Connection")
set rs = createobject("ADODB.Recordset")
cn.open "Provider=ADsDSOObject;"
cmd.activeconnection = cn
' call from Command-Line : CSCRIPT pingall.vbs >> results.txt
' -----------------------------------------------------------
' Used to get the default naming context. e.g. dc=wisesoft,dc=co,dc=uk
set objRoot = getobject("LDAP://RootDSE")
' Query for all computers in the domain
' -------------------------------------
cmd.commandtext = "<LDAP://" & objRoot.get("defaultNamingContext") & ">;(objectCategory=Computer);" & _
"dnsHostName;subtree"
'**** Bypass 1000 record limitation ****
cmd.properties("page size")=1000
set rs = cmd.execute
intFailed = 0
intSucceeded = 0
' Ping all computers in the domain
while rs.eof <> true and rs.bof <> true
strPing = ping(rs("dnsHostName"))
IF LEFT(strPing,2) = "OK" then
intSucceeded = intSucceeded + 1
ELSE
intFailed = intFailed + 1
END IF
wscript.echo rs("dnsHostName") & " : " & strPing
rs.movenext
wend
cn.close
wscript.echo "Finished (" & intSucceeded & " Succeeded, " & intFailed & " Failed)"
' Function to ping a computer
private function ping(byval strComputer)
DIM Status,objPing, ObjPingStatus
status = "Error"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
ExecQuery("select * from Win32_PingStatus where address = '" & _
strComputer & "'")
For Each objPingStatus in objPing
If IsNull(objPingStatus.StatusCode) then
status = "Failed"
elseif objPingStatus.StatusCode<>0 Then
status = "Failed (" & getPingStatus(objPingStatus.StatusCode) & ")"
else
status = "OK (Bytes= " & objPingStatus.BufferSize & _
", Time = " & objPingStatus.ResponseTime & _
", TTL = " & objPingStatus.ResponseTimeToLive & ")"
End If
Next
ping = status
end function
' Function to convert the status code into a useful description
private function getPingStatus(byval statusCode)
DIM status
status = statusCode
SELECT CASE statusCode
CASE 11001
status = "Buffer Too Small"
CASE 11002
status = "Destination Net Unreachable"
CASE 11003
status = "Destination Host Unreachable"
CASE 11004
status = "Destination Protocol Unreachable"
CASE 11005
status = "Destination Port Unreachable"
CASE 11006
status = "No Resources"
CASE 11007
status = "Bad Option"
CASE 11008
status = "Hardware Error"
CASE 11009
status = "Packet Too Big"
CASE 11010
status = "Request Timed Out"
CASE 11011
status = "Bad Request"
CASE 11012
status = "Bad Route"
CASE 11013
status = "TimeToLive Expired Transit"
CASE 11014
status = "TimeToLive Expired Reassembly"
CASE 11015
status = "Parameter Problem"
CASE 11016
status = "Source Quench"
CASE 11017
status = "Option Too Big"
CASE 11018
status = "Bad Destination"
CASE 11032
status = "Negotiating IPSEC"
CASE 11050
status = "General Failure"
END SELECT
getPingStatus = status
end function
Code: Select all
On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
Const ADS_SECURE_AUTHENTICATION = 1
Const ADS_USE_ENCRYPTION = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"SELECT CN FROM 'LDAP://dc=fabrikam,dc=com' WHERE objectCategory='computer'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
strComputer = objRecordSet.Fields("Name").Value
Set objShell = CreateObject("WScript.Shell")
strCommand = "%comspec% /c ping -n 3 -w 1000 " & strComputer & ""
Set objExecObject = objShell.Exec(strCommand)
Do While Not objExecObject.StdOut.AtEndOfStream
strText = objExecObject.StdOut.ReadAll()
If Instr(strText, "Reply") > 0 Then
strComputer = "WinNT://" & strComputer
Set objDSO = GetObject("WinNT:")
Set objComputer = objDSO.OpenDSObject _
(strComputer, strUser, strPassword, _
ADS_SECURE_AUTHENTICATION AND ADS_USE_ENCRYPTION)
' =====================================================================
' Insert your code here
' =====================================================================
objComputer.Filter = Array("User")
For Each objUser in objComputer
Wscript.Echo objUser.Name
Next
' =====================================================================
' End
' =====================================================================
Else
Wscript.Echo strComputer & " could not be reached."
End If
Loop
objRecordSet.MoveNext
Loop
Code: Select all
#include "fivewin.ch"
#include "dll.ch"
Function main()
DEFINE WINDOW oApp TITLE "IP Test"
ACTIVATE WINDOW oApp ON INIT Ping()
return .t.
Function Ping(DestinationAddress)
//-------------------------------------
local IcmpHandle,Replicas
local RequestData:="Testando ping",;
RequestSize:=15,;
RequestOptions:="",;
ReplyBuffer:=space(278),;
ReplySize:=278,;
Timeout:=500 && Milisegundos de espera
default DestinationAddress := "10.10.10.3"
DestinationAddress:=left(alltrim(DestinationAddress)+space(15),15)
MsgGet("Ping...","Input a IP",@DestinationAddress)
IcmpHandle:=IcmpCreateFile()
Replicas:=IcmpSendEcho(IcmpHandle,;
inet_addr(DestinationAddress),;
RequestData,;
RequestSize,0,;
ReplyBuffer,;
ReplySize,;
Timeout)
IcmpCloseHandle(IcmpHandle)
if Replicas > 0
msginfo("The machine "+alltrim(DestinationAddress)+" is Found")
else
msginfo("The machine "+alltrim(DestinationAddress)+" is Not found")
endif
return nil
DLL32 FUNCTION WSAGetLastError() AS _INT PASCAL FROM "WSAGetLastError" LIB "wsock32.dll"
DLL32 FUNCTION inet_addr(cIP AS STRING) AS LONG PASCAL FROM "inet_addr" LIB "wsock32.dll"
DLL32 FUNCTION IcmpCreateFile() AS LONG PASCAL FROM "IcmpCreateFile" LIB "icmp.dll"
DLL32 FUNCTION IcmpCloseHandle(IcmpHandle AS LONG) AS LONG PASCAL FROM "IcmpCloseHandle" LIB "icmp.dll"
DLL32 FUNCTION IcmpSendEcho(IcmpHandle AS LONG,;
DestinationAddress AS LONG,;
RequestData AS STRING,;
RequestSize AS LONG,;
RequestOptions AS LONG,;
ReplyBuffer AS LPSTR,;
ReplySize AS LONG,;
Timeout AS LONG) AS LONG PASCAL FROM "IcmpSendEcho" LIB "icmp.dll"