Lis all servers in a domain.

This script lists all active servers in a domain and stores the list in a SQL server table. The function GetPCNames will query the domain for all netbios names of the computers in the domain. The script loops through the array and will ping every computer name. The script will then query the role of the computer. If the computer is a server, it will be added to the table servers.

The script uses 2 stored procedures : create_servers and add_server. create_servers will clear the table servers and add_server will store the server in the table servers.

This script uses a component from http://www.netal.com/ssr.htm to ping servers on the network.

On Error Resume next
'check if computer is a Server 

'** Database Access
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adLockPessimistic = 2
Const adCmdText = 1
Const adCmdStoredProc = 4


Dim objWMIObject, objServices, objNetwork, objRole
Dim objIP

'** create IPnetwork object
Set objIP = CreateObject("SScripting.IPNetwork")
'** Get some error messages printed if there are any.
Errorhandling 


'** sql 7 provider  (not used)                                                                                            
'strSql7_0 = "Provider=SQLOLEDB.1;"							
'** sql 2000 provider
strSql2000 = "Provider=SQLOLEDB;"
'** Access 2000 provider (not used)
'strAccess2000 = "Provider=Microsoft.Jet.OLEDB.4.0;"	

'** Data Source = netbios name of the sql server
strDbServer = "Data Source=mysqlserver;"				
'** database	 to connect to
strDataBase = "Initial Catalog=Systeminfo;"	
'** substitute with a valid UserId		
strUser = "User ID=user;"							
'** substitute with a valid password		
strPassword = "Password=secret;"							

'** make connection string
strConn = strSql2000 & strDbServer _
          & strDatabase & strUser & strPassword

Dim objConn

Set objConn = CreateObject("ADODB.Connection")

objConn.open strConn
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = objConn

objCmd.CommandText = "create_servers"
Set objRst = objCmd.execute(,,adCmdStoredProc)
objCmd.CommandText = "add_server"
                                                                                                                                  
For each strComputerName in arrComputers                                                                                                 
  
 
 If objIP.Ping(strComputerName) = 0 And _
    InStr(strComputerName, "WKS") = 0 Then 
   
    'wscript.echo strComputername & " is online!"
   
   Set objServices = _ 
   GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _ 
   & strComputername)
   
'** get an instance of the Win32_ComputerSystem for the computer
   
   
   Set objWMIObject = _ 
   objServices.Get("Win32_ComputerSystem='" _
    & strComputerName & "'")
   
   bServer = False
   
   'check if Roles property is Empty array
   If Not IsNull(objWMIObject.roles) Then
      For Each objRole In objWMIObject.Roles
       	 If objRole = "Server_NT" Then
       		 bServer = True
       	 End If
       	 If objRole = "Backup_Domain_Controller" Then
       		 bServer = True
       	 End If
       	 If objRole = "Primary_Domain_Controller" Then
       		 bServer = True
       	 End If
     Next
   End If
   
   If bServer Or InStr(strComputerName, "SRV") > 0 Then
    Set objRst = _ 
    objCmd.execute(,Array(strComputerName),adCmdStoredProc)
   End If
 End If  
Next     
wscript.quit(0)
'*****************************************************************
'** Function:  GetPcNames
'** Version:   1.0
'** Created:   09-04-2003 11:44
'** Author:    Adriaan Westra
'** E-mail:			
'**
'** Purpose / Comments:
'**
'**   Get all netbiosnames from the domain.
'**
'** Change Log :
'**
'** 09-04-2003 11:49 : Initial Version
'**
'** Arguments :  
'**
'**   strDomain : Name of your nt or windows 2000 domain
'**
'** Returns	:
'**
'**	Array with netbiosnames
'**			
'*****************************************************************
Function GetPcNames(strDomain)

	
	Set objDomain = GetObject("WinNT://" + strDomain)
	objDomain.Filter = Array("Computer")
	
   Dim PcNames()
   I = 1
   For each objcomputer in objDomain
   	 If I = 1 Then	
   	    ReDim PRESERVE PcNames(1)
   	 Else
          ReDim PRESERVE PcNames(UBound(PcNames) + 1)
       End if
       PcNames(UBound(PcNames) - 1) = objComputer.Name
       i = i + 1
   Next
   ReDim PRESERVE PcNames(UBound(PcNames) - 1)
	GetPcNames = pcnames
End Function

Sub ErrorHandling()
	Select Case err.number
		Case 0
			Exit sub
		Case 	-2147467259
			wscript.echo "Database is locked"
			wscript.quit(1)
		Case else
	   	wscript.echo err.number & " " & err.description
	   	err.clear
	  End select
End Sub