' netmessenger-eng.vbs
' Script  to send messages to network computers, like ancient net send
' Version 1.1
' Version Release Date : 8/26/2011
' Version Improvements : Script processing does not show various command prompt windows
'                 and progress messages are shown during processing, with no CPU stress. 
' By Pedro Lima (pedrofln.blogspot.com)
' Information Technology, MBA
' MCT, MCSE, MCSA, MCP+I, Network+ Certified Professional
' ------------------------------------------------------------

Option Explicit  
On Error Resume Next  
Const ADS_SCOPE_SUBTREE = 2 
Dim objConnection, objCommand, objRecordSet, objShell, objSA, objArquivoTexto, objProcessEnv
Dim strDomain, strContent, strCommand, strComputer, strMessage, strComputers, strCall, strLdapDomain
Dim intCounter, intLines, intDomainParts, intDomainLenght, intPosition, intSent, intNotSent, intComputermatch
IntNotSent = 0
IntSent = 0

Set objShell = CreateObject("WScript.Shell")
Set objProcessEnv = objShell.Environment("Process")

'Asks the user to type the message
strMessage = InputBox("Type the message to be sent to network computer(s)","Messenger Service", strMessage)
If strMessage = "" Then
   Wscript.Echo "Operation canceled by the user"
   Wscript.Quit
End If

'Determines the scope of the message being sent
strComputer = InputBox("--> Type * for all computers, or " & vbcr & "--> the single computer name, or" & vbcr & "--> a path to a file containing " & vbcr & "a list of computers like c:\list.txt" & vbcr & "PS: Must contain the ':' character in the path","Choose the right scope", strComputer)
If strComputer = "" Then
   Wscript.Echo "Operation canceled by the user"
   Wscript.Quit
End If

If strComputer = "*" then  
  ' get the domain name of the user
  strdomain = objProcessEnv("USERDNSDOMAIN")
  If strdomain = "" then
     Wscript.Echo "This computer is not joined in a domain, or maybe the account you have used to" & vbcr & "call the script does not have query privileges to AD. Please try again  using" & vbcr & "a computer name or a file with a list containing computer names"
 	 Wscript.Quit
  else
    intdomainparts = Int(Conta(strdomain,".", false))
	For intCounter = 1 to intdomainparts
	  intdomainlenght = len(strdomain)
	  If intCounter < intDomainparts Then 
        intposition = InStr(strdomain, ".")
	  Else
	    intposition = intdomainlenght+1
	  End if
      strldapdomain = strldapdomain & ",DC=" & left(strdomain, intposition - 1)
	  If intCounter < intDomainparts Then 
	    strdomain = right(strdomain, intdomainlenght-intposition)
	  End If
    Next
  End If
  strLdapDomain = right(strldapdomain, len(strldapdomain)-1)
  Set objConnection = CreateObject("ADODB.Connection")
  Set objCommand =   CreateObject("ADODB.Command")  
  objConnection.Provider = "ADsDSOObject"  
  objConnection.Open "Active Directory Provider"  
  Set objCOmmand.ActiveConnection = objConnection  

  'Get all computer objects in the specified domain  
  objCommand.CommandText = "Select Name from 'LDAP://" & strLdapDomain & _
  "' where objectClass='computer'"
  objCommand.Properties("Page Size") = 1500  
  objCommand.Properties("Timeout") = 30  
  objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE  
  objCommand.Properties("Cache Results") = False  
  Set objRecordSet = objCommand.Execute  
  intComputermatch = objRecordSet.RecordCount 
  Set objRecordSet = objCommand.Execute  ' Necessary to call again on account of the Recordcount
    
  'Fails when there is an error in the domain name 
  If Err.Number <> 0 Then 
	 Wscript.Echo "The messenger script could not find the domain specified. Check if the ac-" & vbcr & "count used to call the script has enough privileges. No message was sent." 
	 Wscript.Quit 
  Else
     Do While not objRecordSet.EOF                 
	   strComputer = objRecordSet.Fields("name").Value
       Set objShell = CreateObject("WScript.Shell")
       strCommand = objShell.Run ("cmd /c msg * /server:" & strComputer & " " & strMessage,0,True)	   
	   If strCommand <> 0 Then
	      intNotSent = IntNotSent + 1
		  objShell.Popup strcomputer & " seams to be offline",2
	   Else
	      intSent = intSent + 1
		  objShell.Popup intSent & "/" & intComputermatch & " messages successfully sent to the network, " & vbcr & "but at least " & intNotSent & " computers were offline or " & vbcr & "did not exist or could not be contacted.",1
	   End If
	   Set objShell = Nothing
       objRecordSet.MoveNext  
       Err.Clear   
     Loop  
     If intNotSent > 0 Then
	   wscript.echo intSent & " messages successfully sent to the network, " & vbcr & "but at least " & intNotSent & " computers were offline or did" & vbcr & "not exist or could not be contacted."
	 Else 
	   wscript.echo intSent & " messages sent successfully to the network."
	 End If
  End If   
  wscript.quit
  
Elseif instr(strComputer,":") then
  
  ' Routine to read a file containing a list of computers
  Set objSA = CreateObject("Scripting.FileSystemObject")
  Const ForReading = 1
  intLines = 0
  Set objArquivoTexto = objSA.OpenTextFile(strComputer, ForReading)
  If Err.Number <> 0 then
     Wscript.echo "The file specified does not exist. Try again with a correct path to the file. Exiting."
     Wscript.Quit
  End If  
  strContent = ObjArquivoTexto.ReadAll
  intLines = Conta(strContent, chr(13), false)
  Redim strComputers(intLines+1)
  
  For intCounter = 1 to intLines
     strCall = GetLine(strContent, intCounter)
     strComputers(intCounter) = strCall
     Set objShell = WScript.CreateObject( "WScript.Shell" )
     strCommand = objShell.Run ("cmd /c msg * /server:" & strComputers(intCounter) & " " & strMessage,0,True)
     If strCommand <> 0 Then
	    intNotSent = IntNotSent + 1
	 Else
	    intSent = intSent + 1
		objShell.Popup intSent &"/" & intLines & " messages successfully sent to the network, " & vbcr & "but at least " & intNotSent & " computers were offline or " & vbcr & "did not exist or could not be contacted.",1
	 End If
	 Set objShell = Nothing
  Next
  If intNotSent > 0 Then
     Wscript.Echo intSent & " messages successfully sent to the network, " & vbcr & "but at least " & intNotSent & " computers were offline or did" & vbcr & "not exist or could not be contacted."
  Else 
	 Wscript.Echo intSent & " messages sent successfully to the network."
  End If
  Wscript.Quit
Else
  Set objShell = CreateObject("WScript.Shell")
  strCommand = objShell.Run("cmd /c msg * /server:" & strComputer & " " & strMessage,0,True)
  Set objShell = Nothing
  if strCommand <> 0 Then
     Wscript.Echo "The specified computer does not exist or can be"  & vbcr & "offline, or you may not have enough privileges" & vbcr & "to send a message to it. Message not sent."
  else
	 Wscript.Echo "Message sent successfully!"
  End If
End If

wscript.quit

'----------------------------------------------------------------------------------------------------------------
' Functions
'----------------------------------------------------------------------------------------------------------------

Function GetLine(strbuffer, Line)

  Dim intEnd, strData, StrLine, IntLine

  StrLine = StrBuffer
  intEnd = InStr(strLine, Chr(13)) '  Get the initial position of ASCII 13 code (ENTER)
  IntLine = 0
  Do  
  IntLine = IntLine + 1
  If intEnd > 0 Then    
     If IntLine = Line Then
        strLine = Left(strLine, intEnd-1)
        intEnd = InStr(strLine, Chr(13))
     Else
        StrLine = Mid(StrLine,IntEnd+2)
        intEnd = InStr(strLine, Chr(13))
     End If
  Else 
     strLine = strLine
  End If
  Loop While IntLine < Line

  GetLine = strLine

End Function

'--------------------------------------------------------------------------------------------------------------------

Function Conta(strText, strFind, fCaseSensitive)
    Dim intCount, intPos, intMode
    
    If Len(strFind) > 0 Then
        ' Configures the comparison mode.
        If fCaseSensitive Then
            intMode = vbBinaryCompare
        Else
            intMode = vbTextCompare
        End If
        intPos = 1
        Do
           intPos = InStr(intPos, strText, strFind, intMode)
            If intPos > 0 Then
                intCount = intCount + 1
                intPos = intPos + Len(strFind)
            End If
        Loop While intPos > 0
    Else
        intCount = 0
    End If
    Conta = intCount+1
End Function