Функция NetMessageBufferSend

Declare Function NetMessageBufferSend Lib "netapi32" _
  (ByVal servername As String, _
   ByVal msgname As String, _
   ByVal fromname As String, _
   ByVal msgbuf As String, _
   ByRef msgbuflen As Long) As Long

NetMessageBufferSend посылает сообщение зарегистрированным машинам сети. Посылать сообщений с другого компьютера могут только администраторы!

Возвращаемое значение

В успешном случае функция возвращает NERR_Success. В случае ошибки функция возвращает коды ошибок

Параметры

servername

Имя компьютера (DNS или NetBIOS-имя), на котором нужно выполнить данную функцию. В Windows NT имя должно начинаться с \\. Если параметр равен vbNullString, то используется локальный компьютер

msgname

Имя получателя (без \\)

fromname

Имя отправителя. Если параметр равен vbNullString, то используется имя локального компьютера. Можно использовать произвольное имя, но оно должно быть зарегистрировано, для чего используется функция NetMessageNameAdd

msgbuf

Текст сообщения

msgbuflen

Длина сообщения в байтах

Пример

 ' Создадим на форме четыре текстовых поля и одну кнопку
Option Explicit
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_BAD_NETPATH As Long = 53
Private Const ERROR_INVALID_PARAMETER As Long = 87
Private Const ERROR_NOT_SUPPORTED As Long = 50
Private Const ERROR_INVALID_NAME As Long = 123
Private Const NERR_BASE As Long = 2100
Private Const NERR_SUCCESS As Long = 0
Private Const NERR_NetworkError As Long = (NERR_BASE + 36)
Private Const NERR_NameNotFound As Long = (NERR_BASE + 173)
Private Const NERR_UseNotFound As Long = (NERR_BASE + 150)

Private Const MAX_COMPUTERNAME As Long = 15

'User-defined type for passing
'the data to the Send function
Private Type NetMessageData
   sServerName As String
   sSendTo As String
   sSendFrom As String
   sMessage As String
End Type

Private Declare Function NetMessageBufferSend Lib "netapi32" _
  (ByVal servername As String, _
   ByVal msgname As String, _
   ByVal fromname As String, _
   ByVal msgbuf As String, _
   ByRef msgbuflen As Long) As Long

Private Declare Function GetComputerName Lib "kernel32" _
   Alias "GetComputerNameA" _
  (ByVal lpBuffer As String, _
   nSize As Long) As Long

Private Sub Form_Load()
   Dim tmp As String
   
  ' Заполняем текстовые поля
  ' именем компьютера для тестирования
   tmp = Space$(MAX_COMPUTERNAME + 1)
   Call GetComputerName(tmp, Len(tmp))
   
   Text1.Text = TrimNull(tmp)
   Text2.Text = TrimNull(tmp)
   Text3.Text = TrimNull(tmp)

End Sub

Private Sub Command1_Click()

   Dim msgData As NetMessageData
   Dim sSuccess As String
   
   With msgData
      .sServerName = Text1.Text
      .sSendTo = Text2.Text
      .sSendFrom = Text3.Text
      .sMessage = Text4.Text
   End With
   
    sSuccess = NetSendMessage(msgData)
    
    Label1.Caption = sSuccess
    
End Sub

Private Function NetSendMessage(msgData As NetMessageData) As String

   Dim success As Long
    
   With msgData
        ' если пустая строка, то возвращаем ошибку и выходим
         If .sSendTo = "" Then
            NetSendMessage = GetNetSendMessageStatus(ERROR_INVALID_PARAMETER)
            Exit Function
            
         Else
           If Len(.sMessage) Then
              ' конвертируем строки в Unicode
               .sSendTo = StrConv(.sSendTo, vbUnicode)
               .sMessage = StrConv(.sMessage, vbUnicode)
            
              ' можно использовать vbNullString в SendFrom и sServerName
              
               If Len(.sServerName) > 0 Then
                  .sServerName = StrConv(.sServerName, vbUnicode)
               Else
                  .sServerName = vbNullString
               End If
                        
               If Len(.sSendFrom) > 0 Then
                  .sSendFrom = StrConv(.sSendFrom, vbUnicode)
               Else
                  .sSendFrom = vbNullString
               End If
            
               Screen.MousePointer = vbHourglass
           
               success = NetMessageBufferSend(.sServerName, _
                                              .sSendTo, _
                                              .sSendFrom, _
                                              .sMessage, _
                                              ByVal Len(.sMessage))
           
               Screen.MousePointer = vbNormal
           
               NetSendMessage = GetNetSendMessageStatus(success)
   
            End If 'If Len(.sMessage)
         End If  'If .sSendTo
      End With  'With msgData
   
End Function

Private Function GetNetSendMessageStatus(nError As Long) As String
    
   Dim msg As String
   
   Select Case nError
     Case NERR_SUCCESS:            msg = "Сообщение успешно отправлено"
     Case NERR_NameNotFound:       msg = "Получатель не найден"
     Case NERR_NetworkError:       msg = "Ошибка в сети"
     Case NERR_UseNotFound:        msg = "Нет соединения"
     Case ERROR_ACCESS_DENIED:     msg = "Отказано в доступе к компьютеру"
     Case ERROR_BAD_NETPATH:       msg = "Не найдет сервер отправителя"
     Case ERROR_INVALID_PARAMETER: msg = "Заданы неправильные параметры"
     Case ERROR_NOT_SUPPORTED:     msg = "Запрос не поддерживается"
     Case ERROR_INVALID_NAME:      msg = "Недопустимый символ"
     Case Else:                    msg = "Неизвестная ошибка"
     
   End Select
   
   GetNetSendMessageStatus = msg
   
End Function
         
Private Function TrimNull(item As String)

  ' возвращает строку без завершающего нулевого символа
   Dim pos As Integer
   
   pos = InStr(item, Chr$(0))
   
   If pos Then
      TrimNull = Left$(item, pos - 1)
   Else
      TrimNull = item
   End If
   
End Function

Смотри также

NetMessageNameAdd, NetMessageNameDel, NetMessageNameEnum, NetMessageGetInfo

Категория