Net Anlatım .Net Geliştirme

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