'Form Kodu
'2 tane textbox (txttarget,txtmsg)
'2 tane label (label1,label2)
'2 tane command button (cmdSend,cmdquit)
Private WithEvents NetSend As clsNetSend
Private Sub cmdQuit_Click()
End
End Sub
Private Sub cmdSend_Click()
With NetSend
.Message = txtMsg.Text
.SendTo = txtTarget.Text
.SendFromServer = ""
.NetSendMessage
End With
End Sub
Private Sub Form_Load()
Set NetSend = New clsNetSend
Me.Show
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set NetSend = Nothing
Set Form1 = Nothing
End Sub
'Class Modulü (clsNetSend.cls)
'
Option Explicit
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&
Private Const NERR_NameNotFound = 2273&
Private Const NERR_NetworkError = 2136&
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
End Type
Public Event Error(ByVal lError As Long, ByVal ErrorText As String)
Public Event Sent()
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() 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()
m_lNetApiStatus = 0
m_sErrorText = ""
End Sub
Public Property Get ErrorText() As String
ErrorText = m_sErrorText
End Property
Public Property Get Err() As Long
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
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)
m_sMsg = vData
End Property
Public Property Get Message() As String
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)
m_sMsgFrom = vData
End Property
Public Property Get SendFromServer() As String
SendFromServer = m_sMsgFrom
End Property
Private Sub Class_Initialize()
m_bIsWinNT = IsWindowsNT()
If m_bIsWinNT Then
m_lNetApiStatus = 0
Else
MsgBox "This program works only on NT based Os's.", vbCritical + vbOKOnly, "Error"
End If
End Sub
'2 tane textbox (txttarget,txtmsg)
'2 tane label (label1,label2)
'2 tane command button (cmdSend,cmdquit)
Private WithEvents NetSend As clsNetSend
Private Sub cmdQuit_Click()
End
End Sub
Private Sub cmdSend_Click()
With NetSend
.Message = txtMsg.Text
.SendTo = txtTarget.Text
.SendFromServer = ""
.NetSendMessage
End With
End Sub
Private Sub Form_Load()
Set NetSend = New clsNetSend
Me.Show
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set NetSend = Nothing
Set Form1 = Nothing
End Sub
'Class Modulü (clsNetSend.cls)
'
Option Explicit
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&
Private Const NERR_NameNotFound = 2273&
Private Const NERR_NetworkError = 2136&
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
End Type
Public Event Error(ByVal lError As Long, ByVal ErrorText As String)
Public Event Sent()
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() 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()
m_lNetApiStatus = 0
m_sErrorText = ""
End Sub
Public Property Get ErrorText() As String
ErrorText = m_sErrorText
End Property
Public Property Get Err() As Long
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
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)
m_sMsg = vData
End Property
Public Property Get Message() As String
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)
m_sMsgFrom = vData
End Property
Public Property Get SendFromServer() As String
SendFromServer = m_sMsgFrom
End Property
Private Sub Class_Initialize()
m_bIsWinNT = IsWindowsNT()
If m_bIsWinNT Then
m_lNetApiStatus = 0
Else
MsgBox "This program works only on NT based Os's.", vbCritical + vbOKOnly, "Error"
End If
End Sub
