CustomCommand.cls

' It is always good VB coding to explicitly check your variable declarations
Option Explicit

' This extension implements these three extensibility callback interfaces
Implements CHATSVCLib.IChatExtensionCallBack
Implements CHATSVCLib.IChatServerCallBack
Implements CHATSVCLib.IChatUserCallBack

' Keep a copy of the registrar component to allow ad-hoc binding for events
Dim gRegistrar As CHATSVCLib.IChatRegistrar


' Every extension has a short-name user by the /extmsg command
Private Property Get IChatExtensionCallBack_Name() As String
    IChatExtensionCallBack_Name = "CustomCommand"
End Property


Private Function IChatExtensionCallBack_Init(ByVal Server As CHATSVCLib.IChatServer, ByVal Registrar As CHATSVCLib.IChatRegistrar) As Long
    Dim User As CHATSVCLib.IChatUser
    
    ' Keep a reference to the registrar interface
    Set gRegistrar = Registrar
    
    ' Make sure we have a binding for any users already on the server
    For Each User In Server.Users
        gRegistrar.AddUserEvent "OnProtocolMessageIn", User
    Next
    
    ' And that we can bind for any new user notifications
    gRegistrar.AddServerEvent "OnNewUser"
    
    IChatExtensionCallBack_Init = 0 ' Indicate we initialized OK
End Function

Private Function IChatServerCallBack_OnNewUser(ByVal User As CHATSVCLib.IChatUser, ByVal PostUpdate As Boolean) As Long
    If PostUpdate Then
        ' for any additional users added to the server, bind to their protocol In messages
        gRegistrar.AddUserEvent "OnProtocolMessageIn", User
    End If
    IChatServerCallBack_OnNewUser = 0       ' Accept request for a new user
End Function


Private Function IChatUserCallBack_OnProtocolMessageIn(ByVal User As CHATSVCLib.IChatUser, Message As String, ByVal PostUpdate As Boolean) As Long
    ' If the pre-update attempt at the command, and it is our custom command then
    If Not PostUpdate And UCase(Left$(Message, 7)) = "ISLOCAL" Then
        Dim privmsgheader As String
        Dim nick As String
        nick = Mid$(Message, 9)
        
        'Prepare an IRC PRIVMSG command
        privmsgheader = User.nick & "!" & User.Identity & " PRIVMSG " & User.nick & " :"
        
        ' Send a response to the user that sent the command
        User.ProtocolMessageOut privmsgheader & nick & GetUserHost(User.Server.Users(nick)) & vbCrLf
        
        ' And tell the chat server to ignore the message
        IChatUserCallBack_OnProtocolMessageIn = -1
    Else
        ' Allow other messages through unchanged
        IChatUserCallBack_OnProtocolMessageIn = 0
    End If
End Function


Private Function GetUserHost(ByVal Usr As CHATSVCLib.IChatUser)
    Dim Msg As String
    
    ' Return a descriptive text describing if the user is local, remote or not online
    If Not Usr Is Nothing Then
        Msg = IIf(Usr.IsRemoteUser, " is a remote user", " is a local user")
    Else
        Msg = " is not on-line"
    End If
    GetUserHost = Msg
End Function



' The following methods do not need any implementation and are required only to allow VB
' to implement the interfaces correctly

Private Function IChatUserCallBack_OnProtocolMessageOut(ByVal User As CHATSVCLib.IChatUser, Message As String, ByVal PostUpdate As Boolean) As Long
End Function

Private Sub IChatExtensionCallBack_OnInstall()
End Sub

Private Function IChatUserCallBack_OnNickChanged(ByVal User As CHATSVCLib.IChatUser, nick As String, ByVal PostUpdate As Boolean) As Long
End Function

Private Sub IChatUserCallBack_OnRemoveAccess(ByVal Channel As CHATSVCLib.IChatUser, ByVal Access As CHATSVCLib.IChatAccessEntry)
End Sub

Private Sub IChatUserCallBack_OnRemoveChannel(ByVal User As CHATSVCLib.IChatUser, ByVal Channel As CHATSVCLib.IChatChannel)
End Sub

Private Function IChatUserCallBack_OnUserPropertyChanged(ByVal User As CHATSVCLib.IChatUser, ByVal Prop As CHATSVCLib.USER_PROP, Value As Variant, ByVal PostUpdate As Boolean) As Long
End Function

Private Sub IChatExtensionCallBack_OnConfigureExtension(ByVal User As CHATSVCLib.IChatUser, ByVal Command As String)
End Sub

Private Function IChatExtensionCallBack_OnGetPropertyPageClass(ByVal Class As CHATSVCLib.PROPERTY_PAGE) As String
End Function

Private Sub IChatExtensionCallBack_OnUninstall()
End Sub

Private Function IChatExtensionCallBack_Term() As Long
End Function

Private Sub IChatServerCallBack_OnCloseChannel(ByVal Channel As CHATSVCLib.IChatChannel)
End Sub

Private Sub IChatServerCallBack_OnCloseUser(ByVal User As CHATSVCLib.IChatUser)
End Sub

Private Function IChatServerCallBack_OnNewChannel(ByVal Channel As CHATSVCLib.IChatChannel, ByVal PostUpdate As Boolean) As Long
End Function

Private Function IChatUserCallBack_OnAddAccess(ByVal Channel As CHATSVCLib.IChatUser, ByVal Access As CHATSVCLib.IChatAccessEntry, ByVal PostUpdate As Boolean) As Long
End Function

Private Function IChatUserCallBack_OnAddChannel(ByVal User As CHATSVCLib.IChatUser, ByVal Channel As CHATSVCLib.IChatChannel, ByVal PostUpdate As Boolean) As Long
End Function

Private Function IChatUserCallBack_OnAwayChanged(ByVal User As CHATSVCLib.IChatUser, Away As String, ByVal PostUpdate As Boolean) As Long
End Function

Private Function IChatUserCallBack_OnPrivateText(ByVal FromUser As CHATSVCLib.IChatUser, ByVal ToUser As CHATSVCLib.IChatUser, ByVal Command As CHATSVCLib.IRC_COMMAND_TYPE, Message As String, ByVal PostUpdate As Boolean) As Long
End Function

Private Function IChatServerCallBack_OnAddAccess(ByVal Server As CHATSVCLib.IChatServer, ByVal AccessEntry As CHATSVCLib.IChatAccessEntry, ByVal PostUpdate As Boolean) As Long
End Function

Private Sub IChatServerCallBack_OnRemoveAccess(ByVal Server As CHATSVCLib.IChatServer, ByVal AccessEntry As CHATSVCLib.IChatAccessEntry)
End Sub

© 1998 Microsoft Corporation. All rights reserved.