EN: This script helps network administrators with Windows 7 clients and Windows 2008 servers to use the MSG utility like the old "NET SEND" command. You can send a message to a specific computer, to a list of computers or even the entire netowork, if it is domain-based.   

Please look at: http://pedrofln.blogspot.com/2011/08/net-messenger-script-for-windows-72008.html#en for complete information on how to use it.

 

PT-BR: Este script ajuda os administradores de rede com clientes Widows 7 e servidores Windows 2008 a usar o utilitário MSG como o velho comando "NET SEND". Você pode enviar uma mensagem para um computador específico, para uma lista de computadores ou até mesmo a rede inteira, se ela for baseada em domínio do Active Directory.  

Por favor, veja em: http://pedrofln.blogspot.com/2011/08/net-messenger-script-for-windows-72008.html#pt-br  para maiores detalhes e pela informação detalhada de como usá-lo.

 


Visual Basic
Edit|Remove
' 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 
        objShell.Popup strComputers(intCounter) & " seams to be offline",2 
     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