Send a message

If you are using NT, you can paste the following code into a class module (eg. clsNetSend) and use this. It uses the 'Net Send' messaging that is available under NT.

option Explicit
' Class Module clsNetSend
'
' By: Perry Harmon
' [email protected]
'
' Requires VB5 and NT 4.0
' Sends message from NT 4.0 to NT 4.0 or Win95 running winpopup
'
' Properties:
' SendTo - Read/Write
' SendFromServer - Read/Write
' Message - Read/Write
' Err - Read Only
' ErrorText - Read Only
'
' Methods:
' NetSendMessage - Boolean Returns true/false (Success/Failure)
' optional parameters:
' sUser ' string - Message Recipient
' sMsg ' string - Message Text
'
' ClearError - Sets object.Err = 0, object.ErrorText = ""
'
' Events:
' error - raised on error
' parameters:
' lError ' error Code
' ErrorText ' Just That
' Sent - raised when object.NetSendMessage executed without errors
' parameters: None
'
'

'**** Example ******
'
' Add to Form Declarations Section
' private withevents mNetSend as clsNetSend
'
' Add to a procedure/function
' set mNetSend = new clsNetSend
' With mNetSend
' .Message = "Your Message Here"
' .SendTo = "UserNameOrWorkStation"
' .SendFromServer = "ServerOrWorkStation" 'This is optional
' .NetSendMessage ' Send the message
' End With

' private Sub mNetSend_Error(byval lError as Long, byval ErrorText as string)
' Debug.print lError & " - " & ErrorText
' End Sub

' private Sub mNetSend_Sent()
' debug.print "Message Sent"
' End Sub

'**** Example ******
'
' private mNetSend as new clsNetSend
' Dim bSuccess as Boolean
' If mNetSend.NetSendMessage("UserOrWorkstationName", "This is A Test") then
' MsgBox "Message Sent"
' else
' MsgBox "error " & mNetSend.Err & " - " & mNetSend.ErrorText
' End If
'
' Broadcast a message to all members of Domain called DomainName
' bSuccess = mNetSend.NetSendMessage("DomainName*", "This is A Test")

private Const ERROR_ACCESS_DENIED = 5&
private Const ERROR_BAD_NETPATH = 53&
private Const ERROR_INVALID_PARAMETER = 87&
private Const ERROR_NOT_SUPPORTED = 50&
private Const ERROR_INVALID_NAME = 123&
private Const NERR_Success = 0& ' Success
private Const NERR_NameNotFound = 2273& ' The message alias could not be found on the network.
private Const NERR_NetworkError = 2136& ' A general network error occurred.

private Declare Function NetSend Lib "netapi32" Alias "NetMessageBufferSend" (byval cServerName as string, byval cMsgName as string, byval cFromName as string, byval cBuf as string, byref iBufLen as Integer) as Integer
private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation as OSVERSIONINFO) as Long

private Const VER_PLATFORM_WIN32_NT = 2

private Type OSVERSIONINFO
dwOSVersionInfoSize as Long
dwMajorVersion as Long
dwMinorVersion as Long
dwBuildNumber as Long
dwPlatformId as Long
szCSDVersion as string * 128 ' Maintenance string for PSS usage
End Type

' Events
public Event error(byval lError as Long, byval ErrorText as string)
public Event Sent()

' Local copies of properties
private m_sMsgTo as string
private m_sMsg as string
private m_sMsgFrom as string
private m_lNetApiStatus as Long
private m_sErrorText as string
private m_bIsWinNT as Boolean

'-----------------------------------------------------------
' FUNCTION: IsWindowsNT
'
' Returns true if this program is running under Windows NT
'-----------------------------------------------------------'
Function IsWindowsNT() as Boolean

Dim lRC as Long
Dim typOSInfo as OSVERSIONINFO

typOSInfo.dwOSVersionInfoSize = len(typOSInfo)
lRC = GetVersionEx(typOSInfo)
IsWindowsNT = (typOSInfo.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
public Sub ClearError()
' set error Properties
m_lNetApiStatus = 0
m_sErrorText = ""
End Sub

public property get ErrorText() as string
'set ErrorText
ErrorText = m_sErrorText
End property

public property get Err() as Long
' set error Number
Err = m_lNetApiStatus
End property

private Function SetErrorText(error as Long) as string
Select Case error
Case ERROR_ACCESS_DENIED: SetErrorText = "Access Denied!"
Case ERROR_BAD_NETPATH: SetErrorText = "Server '" & UCase$(m_sMsgFrom) & "' not Found."
Case ERROR_INVALID_PARAMETER: SetErrorText = "Invalid parameter specified."
Case ERROR_NOT_SUPPORTED: SetErrorText = "Network request not supported."
Case ERROR_INVALID_NAME: SetErrorText = "Illegal character or malformed name."
Case NERR_Success: SetErrorText = "Message sent."
Case NERR_NameNotFound: SetErrorText = "User/Workstation '" & m_sMsgTo & "' not found."
Case NERR_NetworkError: SetErrorText = "General network error occurred."
Case else: SetErrorText = "Unknown error executing command."
End Select
End Function

private Sub SetLastErr(byval lError as Long)
m_lNetApiStatus = lError
m_sErrorText = SetErrorText(lError)
If m_lNetApiStatus then RaiseEvent error(m_lNetApiStatus, m_sErrorText)
End Sub
public Function NetSendMessage(optional byval sUser as string = "", optional byval sMsg as string = "") as Boolean

Dim sBuf
Dim sMsgFrom as string
Dim sMsgName as string
Dim Net_Api_Status as Long

If Not m_bIsWinNT then Exit Function

If len(sUser) then m_sMsgTo = sUser ' else use the SendTo property

If m_sMsgTo = "" then
NetSendMessage = false
SetLastErr ERROR_INVALID_PARAMETER
RaiseEvent error(ERROR_INVALID_PARAMETER, m_sErrorText)
else
Screen.MousePointer = vbHourglass

If len(sMsg) then m_sMsg = sMsg

sBuf = StrConv(m_sMsg, vbUnicode)
sMsgName = StrConv(m_sMsgTo, vbUnicode)

If len(m_sMsgFrom) And sUser = "" then
sMsgFrom = StrConv(m_sMsgFrom, vbUnicode)
else
sMsgFrom = vbNullString
End If
Net_Api_Status = NetSend(sMsgFrom, sMsgName, vbNullString, sBuf, byval len(sBuf))
SetLastErr Net_Api_Status
NetSendMessage = Not CBool(Net_Api_Status)
If NetSendMessage then RaiseEvent Sent
Screen.MousePointer = vbNormal
End If

End Function

public property let Message(byval vData as string)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.sMessage = 5
m_sMsg = vData
End property

public property get Message() as string
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.print X.sMessage
Message = m_sMsg
End property

public property let SendTo(byval vData as string)
m_sMsgTo = vData
End property
public property get SendTo() as string
SendTo = m_sMsgTo
End property

public property let SendFromServer(byval vData as string)
'used when assigning a value to the property, on the left side of an assignment.
m_sMsgFrom = vData
End property

public property get SendFromServer() as string
'used when retrieving value of a property, on the right side of an assignment.
SendFromServer = m_sMsgFrom
End property

private Sub Class_Initialize()
m_bIsWinNT = IsWindowsNT()
If m_bIsWinNT then
m_lNetApiStatus = 0
else
MsgBox "The NetSend class requires Windows NT.", vbCritical + vbOKOnly, "Net Send"
End If
End Sub

Chris Eastwood

CodeGuru - the website for developers
http://codeguru.developer.com/vb