'==========================================================================
'
' VBScript Source File -- Created with SAPIEN Technologies PrimalScript 3.1
'
' NAME: Enumerate Network Printers 
' AUTHOR: Eric Woodford
' DATE  : 10/23/2007; 12/6/2007
'
' COMMENT: Only retrieves detailed port (IP Address, SNMP info, etc.) information from XP and Win2k3 machines. 
'
' SOURCE: http://www.microsoft.com/technet/scriptcenter/guide/sas_prn_wize.mspx?mfr=true
'  Pulled "GetPort" and WMIConnect from PRNPort.vbs @ http://technet2.microsoft.com/windowsserver/en/library/573e8381-1d1f-409f-9ec2-a1d5efb4315b1033.mspx?mfr=True
'   
'==========================================================================
' call by running:
'     cscript enumprinters.vbs > printers.csv
'
'
Const MyDomain = "DC=my_domain_goes_here,DC=com"

set objfso = CreateObject("Scripting.FileSystemObject")
set ef = objfso.CreateTextFile("c:\Printer_Info.csv",vbtrue)

On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "SELECT printerName, serverName, portName, printShareName FROM 'LDAP://"&mydomain&"' WHERE objectClass='printQueue'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
c = 0
ef.writeline "Printer Name, Server name,Port,Share Name,Host Address,Protocol,Raw Port,SNMP Status,DNS host name"
Do Until objRecordSet.EOF
	c= c+ 1	
	pn = objRecordSet.Fields("printerName").Value
	sn = objRecordSet.Fields("serverName").Value	
	ports = objRecordSet.Fields("portName").Value
	
	If IsArray(ports) Then 
		plist = ""
		for each port in ports			
			Host = GetPort(sn,port)
			plist = plist & port& ";"
		Next
	End If
	shares = objRecordSet.Fields("printShareName").Value
	If IsArray(shares) Then 
		slist = ""
		for each port in shares			
			slist = slist & port & ";"
		Next
	End if
 	ef.writeline   pn &"," & sn & "," & left(plist,Len(plist)-1) & "," & left(slist,Len(slist)-1) & "," & host
 	objRecordSet.MoveNext
Loop
ef.writeline  "Printers: " & c
ef.close


' Operation action values.
'
const kErrorSuccess       = 0
const KErrorFailure       = 1

const kFlagCreateOrUpdate = 0

const kNameSpace          = "root\cimv2"



'
' Gets the configuration of a port
'
function GetPort(strServerName, strPortName)

    on error resume next

    dim oService
    dim oPort
    dim strResult
    dim strServer
    dim strPort
    dim strUser 
    dim strPassword
    
    strServer   = strServerName ' oParamDict(kServerName)
    strPort     = strPortName ' oParamDict(kPortName)
    strUser     = "" ' oParamDict(kUserName)
    strPassword = "" ' oParamDict(kPassword)

    if WmiConnect(strServer, kNameSpace, strUser, strPassword, oService) then
        set oPort = oService.Get("Win32_TCPIPPrinterPort.Name='" & strPort & "'")
    else
        strResult = ",,,,"       
        exit function     
    end if
    if Err.Number = kErrorSuccess then             
        strResult = oPort.HostAddress
        if oPort.Protocol = 1 then
           strResult = strResult & ",RAW," & oPort.PortNumber 
        else    
           strResult = strResult & ",LPR," & oPort.Queue
        end if    
            
        if oPort.SNMPEnabled then    
           	strResult = strResult & "," & oPort.SNMPCommunity 
        else                
            strResult = strResult & ",SNMPDisabled"                
        end if  
        strResult= strResult & ","&DNSLookup(oPort.hostaddress)    	 
    end if
    GetPort = strResult
end function
'
' Connects to the WMI service on a server. oService is returned as a service
' object (SWbemServices)
'
function WmiConnect(strServer, strNameSpace, strUser, strPassword, oService)

   on error resume next
   dim oLocator
   dim bResult   
   oService = null   
   bResult  = false   
   set oLocator = CreateObject("WbemScripting.SWbemLocator")
   if Err = kErrorSuccess then
      set oService = oLocator.ConnectServer(strServer, strNameSpace, strUser, strPassword)
      if Err = kErrorSuccess then
          bResult = true      
          oService.Security_.impersonationlevel = 3
          '
          ' Required to perform administrative tasks on the spooler service
          '
          oService.Security_.Privileges.AddAsString "SeLoadDriverPrivilege"          
          Err.Clear                 
      end if         
   end if                                                  
   WmiConnect = bResult           
end Function


Function DNSLookup(sIPAddress)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com
  ' Source: http://www.naterice.com/blog/template_permalink.asp?id=49

  If Not IsIP(sIPAddress) Then
    DNSLookup = "Failed: Invalid IP."
  End If

  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1

  Set oShell = CreateObject("WScript.Shell")
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  sTemp = oShell.ExpandEnvironmentStrings("%TEMP%")
  sTempFile = sTemp & "\" & oFSO.GetTempName

  oShell.Run "%comspec% /c nslookup " & sIPAddress & ">" & sTempFile, 0, True

  Set fFile = oFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsDefault)
  sResults = fFile.ReadAll
  fFile.Close
  oFSO.DeleteFile (sTempFile)

  If InStr(sResults, "Name:") Then
    aNameTemp = Split(sResults, "Name:")
    aName = Split(Trim(aNameTemp(1)), Chr(13))
 
    DNSLookup = aName(0)
  Else
    DNSLookup = "Failed."
  End If
 
  Set oShell = Nothing
  Set oFSO = Nothing
End Function

Function IsIP(sIPAddress)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  aOctets = Split(sIPAddress,".")
 
  If IsArray(aOctets) Then
    If UBound(aOctets) = 3 Then
      For Each sOctet In aOctets
        On Error Resume Next
        sOctet = Trim(sOctet)
        sOctet = sOctet + 0
        On Error Goto 0
       
        If IsNumeric(sOctet) Then
          If sOctet < 0 Or sOctet > 256 Then
            IsIP = False
            Exit Function
          End If
        Else
          IsIP = False
          Exit Function
        End If
      Next
      IsIP = True
    Else
      IsIP = False
    End If
  Else
    IsIP = False
  End If
End Function