scan pc

[Silvio]

Using Tcip class...
Can I insert on a browse all pc there are in a classroom making a scan from ip to ip ? to see if a pc is dead or alive ?

Can you make a small sample pls ?


Best Regards

[Otto]

Silvio, did you found a solution?
If yes would you be so kind to share it.
Thanks in advance
Otto

[ukoenig]

Hello Otto,

You can use a VBA-Script => save the Code to : PingAll.vbs
Call from Command-Line, or use Winexec : CSCRIPT pingall.vbs >> results.txt

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

Another Version : save and call as => ????.vbs

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
 

Best Regards
Uwe

[Silvio]

Otto ,
No
But I'll like to Know How I can make it on xharbour ....

[mgsoft]

Funky lib provides ping functions.

See also: http://forums.fivetechsupport.com/viewt ... ing#p68085

[Rochinha]

Friends,

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"