Network Scanner

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Network Scanner

Logged in as: Guest

arrSession:exec spGetSession 2,16,60280

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Network Scanner
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Network Scanner - 5/16/2008 12:13:54 AM

4scriptmoni

Posts: 190
Score: 0
Joined: 5/3/2007
Status: offline

I was bored today... as I was trying to find all Terminal Servers in my Domain and wrote this code.
It is required to download the w3Sockets
Modify Script where it says EDIT, duhhh

Its quite lame scanner, the socket.dll like someone said before the timeout is does not work, only if the connections repond, causing the scan speed really slow.
Soon, I will post another version a have using nmap, really fast!

'script to scan Hostname or IPs specifing the Ports
'Requires:  w3Sockets , Download here : http://tech.dimac.net/default3.asp?M=FreeDownloads/Menu.asp&P=FreeDownloads/FreeDownloadsstart.asp
'Author: Felipe Ferreira
'Date 16/05/2008
'Version:2.0
'Auto Download and install Socket.dll - OK
'####Could Improve(next version):
   'Prompt for Servernames and Ports     
   'Faster Scans
   'Get usersdomain  from vbscript ENV
   'Output logfile should not repeat the hostname, should write hostname port1,port2...

dim fchecktsfound
Dim inputfile, outputfile   'TO BE EDITED
Dim userdomain,dispfile
Const ForWriting = 2, ForAppending=8
Dim sPath, strScriptFile,strStatus
Dim objExplorer
Dim wrHtmlFile
Dim arrServers, arrPorts
strScriptFile = WScript.ScriptFullname
sPath = Left(strScriptFile, Len(strScriptFile) - Len(WScript.Scriptname)) 'used to define the path from where the script file is located
Dim Fso : Set Fso = CreateObject("Scripting.FileSystemObject")
Dim objShell : Set objShell = CreateObject("WScript.Shell")   ' Run cmds
Dim t1, intServersChecked
t1 = Timer

dispFile = sPath & "ofile.html"
outputfile = sPath & "HostsOpen.txt"
'##################EDIT#######################
DomainServer = 0 ' SCAN METHOD 1 = Will Use Domain Servers List from AD, 0 = Enter Manually the servers in array
arrServers = Array("INTBRVL08","SERVER1","SERVER2","SERVER3","SERVER4","INTBRVL10","SERVER5","SERVER6","SERVER7")
arrPorts = Array("3389","80")
'##################EDIT#######################

Dim F : Set F = Fso.CreateTextFile(outputfile, TRUE)

call GetFile("socket.dll")
'____Register the dll
wscript.sleep 800
   Set objShell = WScript.CreateObject( "WScript.Shell" ) 
   objShell.Run "regsvr32 /s " & spath & "socket.dll", , True          
wscript.sleep 600
'____Main File
DrawHTML

RunTime = Timer  - t1
RunTime = Left(RunTime, 3)
MsgBox "Scanned: " & intServersChecked & " hosts." &  VbCrLf &_
       "Script executed in: " & RunTime & " seconds."
wscript.quit
'####################### FUNCTIONS AND SUBS ################################
Sub scan()
   if DomainServer = 1 then 
   GetServers
   exit sub
   end if
   for each strHost in ArrServers
     for each intPort in arrPorts   
    ' wscript.echo strHost & " , " & intPort
         If PingStatus(strHost) = "True" then  'if Host dont respond to ICMP, dont Scanit          
           call fcheckTS(strHost, intPort)    
           intServersChecked = intServersChecked + 1
         end if 
       next 'loop of services
   next 'loop of server
end sub

Sub GetServers()
   'IF THE inputfile IS INVALID OR USER WANTS TO GET THE SERVER LIST DO THIS AND WRITES TO inputfile        
   'Get  %USERDOMAIN% ENV
   GetDomain
   Set oContainer = GetObject("WinNT://" & userdomain)
   oContainer.Filter = Array("computer")
   if err.number <> 0 then
       wscript.echo "ERROR: " & err.description
   end if    
   'Ping and Scan for port  then add to Servers.txt List
   For Each oHost in oContainer
       for each intPort2 in arrPorts           
         call fcheckTS(oHost.name, intPort2)    
         intServersChecked = intServersChecked + 1          '           
       next 'ports
   next
   DomainServer = 1
end sub

Sub getdomain()
   Set objExecObject = objShell.Exec("cmd /c echo %USERDOMAIN%")
   Do While Not objExecObject.StdOut.AtEndOfStream
       userdomain = objExecObject.StdOut.ReadLine()   'gets %userdomain%
       trim(userdomain)        
   loop
end sub

Function fCheckTS(strhostp,intportp)
'REQUIRES Socket.dll download w3wsockets from  http://tech.dimac.net/default3.asp?M=FreeDownloads/Menu.asp&P=FreeDownloads/FreeDownloadsstart.asp
  err.clear
'#########WRITE TO IE                
   objExplorer.Document.Body.InnerHTML = "4ScriptOmini Net Scanner" & " " & "Scanning Host: " & strhostp & " " & "Scanning Port: " & intportp & ""
   Dim oSocket, iErr, sSocketText
   sSocketText = "asdasdasasdasdasdasd"
   Set oSocket = CreateObject("Socket.TCP")
   oSocket.DoTelnetEmulation = True
   oSocket.TelnetEmulation = "TTY"    
   oSocket.Host =  strhostp & ":" & intportp
   oSocket.timeout = 200 '300 ms
   On Error Resume Next 
   oSocket.Open
   iErr = Err.Number
    If iErr <> 0 Then 
      Exit Function 
    End If 
   sSocketText = oSocket.GetLine
   oSocket.SendLine "quit"    
   fCheckTSfound = 1
'#########WRITE TO HTML        
       wrHtmlFile.writeline "<tr"&" "&"width="&"45%"&" "&"valign="&"top"&" "&"height=15>"&"<td>"& strHostp &"</td>"&"<td>"& intportp &"</td>"&"<td>"& "OPEN" &"</td>"
       F.WriteLine strHostp & " | " & intportp
   oSocket.Close
   On Error GoTo 0    
End Function

Function PingStatus(strComputer)
On Error Resume Next
  strWorkstation = "."
  Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strWorkstation & "\root\cimv2")
  Set colPings = objWMIService.ExecQuery _
    ("SELECT * FROM Win32_PingStatus WHERE Address = '" & strComputer & "'")
  For Each objPing in colPings
      'Quickly Identify, Ping Status is 0 then OK, otherwise do not add server to list, no ping response!
               
      If objPing.StatusCode = 0 then
           PingStatus = "True"
           
      else if objPing.StatusCode <> 0 then
           PingStatus = "False"
      end if
      end if       
  Next
on error goto 0
End Function

sub GetFile(filename)
   Dim objMyFile, objShell, strFTPScriptFileName
   Dim strFileGet1, strFileGet2 
   Dim strFTPServerName, strLoginID 
   Dim strPassword, strFTPServerFolder 
   
   strFTPServerName = "xoroz.com" 
   strLoginID = "files@xoroz.com" 
   strPassword = "files" 
   strFTPServerFolder = "/"

'Generate FTP command 
   strFTPScriptFileName = spath & "FTP.txt" 
   Set objFSO = CreateObject("Scripting.FileSystemObject") 
   If (objFSO.FileExists(strFTPScriptFileName)) Then 
    objFSO.DeleteFile (strFTPScriptFileName) 
   End If 
   
   If (objFSO.FileExists(spath & "\" & filename)) Then 
     ' "File " & filename & " already exists, will not replace, quiting..."
     exit sub
   End If 
   Set objMyFile = objFSO.CreateTextFile(strFTPScriptFileName, True) 
   objMyFile.WriteLine ("open " & strFTPServerName) 
   objMyFile.WriteLine (strLoginID) 
   objMyFile.WriteLine (strPassword) 
   objMyFile.WriteLine ("cd " & strFTPServerFolder) 
   objMyFile.WriteLine ("bin") 
   objMyFile.WriteLine ("lcd " & spath) 
   objMyFile.WriteLine ("prompt off") 
   objMyFile.WriteLine ("mget " & filename) 
   objMyFile.WriteLine ("disconnect") 
   objMyFile.WriteLine ("bye") 
   objMyFile.Close 
   
   'Execute the FTP script. 
   Set objShell = WScript.CreateObject( "WScript.Shell" ) 
   'call DisplayMsg( "ftp -s:" & Chr(34) & strFTPScriptFileName & Chr(34))
   'exec "cmd /c ftp -s:" & Chr(34) & strFTPScriptFileName & Chr(34)
   objShell.Run "ftp -s:" & Chr(34) & strFTPScriptFileName & Chr(34), , True      
   If (objFSO.FileExists(strFTPScriptFileName)) Then     
    objFSO.DeleteFile (strFTPScriptFileName) 
   End If  
   Set objFSO = Nothing 
   Set objMyFile = Nothing 
   Set objShell = Nothing 
end sub

Sub DrawHTML()
   '### Initialize File System Object 2, Create File
   Set fSo2 = CreateObject("Scripting.FileSystemObject")
   set dFile = fSo2.CreateTextFile(sPath & "ofile.html",true)
   dFile.Close
    
   '### Initialize File System Object 3, Write File
   Set fSo3 = CreateObject("Scripting.FileSystemObject")
   Set wrHtmlFile = fSo3.OpenTextFile(dispFile, ForAppending)

'### Start Internet Explorer for Status Messages and Output
   Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
   objExplorer.Navigate "about:blank"
   objExplorer.Document.Title = "Net Scan"
   objExplorer.ToolBar = 0
   objExplorer.StatusBar = 0
   objExplorer.Width=300
   objExplorer.Height = 500
   objExplorer.Left = 0
   objExplorer.Top = 0
   objExplorer.Visible = 1

'### Write HTML File Header
   wrHtmlFile.writeline "<html><body><title>Simple Scanner</title>"
   wrHtmlFile.writeline "<center>4ScriptOmini Simple Scanner</center> "
   wrHtmlFile.writeline "<center>"
   wrHtmlFile.writeline "<table border>"
   wrHtmlFile.writeline "<tr"&" "&"width="&"45%"&" "&"valign="&"top"&" "&"height=15>"&"<td>"& "HOSTNAME" &"</td>"&"<td>"& "PORT" &"</td>"&"<td>"& "STATUS" &"</td>"

objExplorer.Document.Body.InnerHTML = "Net Scan " & "" & "X" & ""
'Scan 
   call scan()

wrHtmlFile.writeline "</table>"
    wrHtmlFile.writeline " "
    wrHtmlFile.writeline "</center>"
    wrHtmlFile.writeline "</body></html>"

objExplorer.Navigate "file:///" & dispFile    
end sub

< Message edited by 4scriptmoni -- 6/5/2008 2:33:03 AM >

_____________________________

Enterprise Microsoft Scripts
Exchange, Login/Logout Monitor,TS, Monitoring, Security, AD, etc...
http://www.felipeferreira.net