Microsoft Chat Server Development Guide |
---|
Option Explicit
'This extension implements these Chat extensibility callbacks
Implements CHATSVCLib.IChatChannelCallBack
Implements CHATSVCLib.IChatExtensionCallBack
'Our extension's short name
Const ExtensionName = "MangleTopic"
' We need the hold the names of channels that have mangle enabled
Dim gMangledChanNames As Collection
' Hold a reference to the ChatRegistrar to allow ad-hoc event binding
Dim gRegistrar As CHATSVCLib.IChatRegistrar
' This property defines our short-name used by the /EXTMSG command
Private Property Get IChatExtensionCallBack_Name() As String
IChatExtensionCallBack_Name = ExtensionName
End Property
Private Function IChatExtensionCallBack_Init(ByVal Server As CHATSVCLib.IChatServer, ByVal Registrar As CHATSVCLib.IChatRegistrar) As Long
' Keep a reference to the notification registrar
Set gRegistrar = Registrar
' Hold a collection of channels names with mangling enabled
Set gMangledChanNames = New Collection
End Function
Private Sub IChatExtensionCallBack_OnConfigureExtension(ByVal User As CHATSVCLib.IChatUser, ByVal Command As String)
Dim chanName As String
Dim chan As CHATSVCLib.IChatChannel
Dim privmsgheader As String
On Error Resume Next ' any collection errors simply run the next statement
If UCase(Left(Command, Len(ExtensionName))) = UCase(ExtensionName) Then
chanName = Mid$(Command, Len(ExtensionName) + 2) ' extract name from "/EXTMSG MANGLETOPIC <channelName>"
'Prepare an IRC PRIVMSG command
privmsgheader = User.nick & "!" & User.Identity & " PRIVMSG " & User.nick & " :"
' Look up channel object in the chat object model
Set chan = User.Server.Channels(chanName)
If Not chan Is Nothing Then
' if name is already in our collection, then turn feature off
If gMangledChanNames(chanName) <> chanName Then
gRegistrar.AddChannelEvent "OnChannelPropertyChanged", chan
gMangledChanNames.Add chanName, chanName
User.ProtocolMessageOut privmsgheader & "Channel " & chanName & " topic change mangle enabled" & vbCrLf
Else
gMangledChanNames.Remove chanName
User.ProtocolMessageOut privmsgheader & "Channel " & chanName & " topic change mangle disabled" & vbCrLf
End If
Else
User.ProtocolMessageOut privmsgheader & "Channel " & chanName & " does not exist" & vbCrLf
End If
End If
End Sub
' Monitor for Topic change notifications and Mangle as necessary
Private Function IChatChannelCallBack_OnChannelPropertyChanged(ByVal Channel As CHATSVCLib.IChatChannel, ByVal Prop As CHATSVCLib.CHAN_PROP, Value As Variant, ByVal PostUpdate As Boolean) As Long
If Not PostUpdate And Prop = CPROP_TOPIC Then
If gMangledChanNames(Channel.Name) = Channel.Name Then
Value = MangleText(Value)
End If
End If
IChatChannelCallBack_OnChannelPropertyChanged = 0 ' always permit property change
End Function
' Utility route to 'Mangle' a string into Alpha-only text
Private Function MangleText(ByVal Value As Variant) As Variant
Dim s As String, ch As String
Dim i As Integer
s = ""
For i = 1 To Len(Value)
ch = Mid$(Value, i, 1)
If (Asc(ch) >= Asc("a") And Asc(ch) <= Asc("z")) _
Or (Asc(ch) >= Asc("A") And Asc(ch) <= Asc("Z")) _
Or ch = " " Then
s = s & ch
End If
Next
MangleText = s
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function IChatExtensionCallBack_OnGetPropertyPageClass(ByVal Class As CHATSVCLib.PROPERTY_PAGE) As String
End Function
Private Sub IChatExtensionCallBack_OnInstall()
End Sub
Private Sub IChatExtensionCallBack_OnUninstall()
End Sub
Private Function IChatExtensionCallBack_Term() As Long
End Function
Private Function IChatChannelCallBack_OnAddAccess(ByVal Channel As CHATSVCLib.IChatChannel, ByVal Access As CHATSVCLib.IChatAccessEntry, ByVal PostUpdate As Boolean) As Long
End Function
Private Function IChatChannelCallBack_OnAddMember(ByVal Channel As CHATSVCLib.IChatChannel, ByVal User As CHATSVCLib.IChatUser, ByVal PostUpdate As Boolean) As Long
End Function
Private Function IChatChannelCallBack_OnChangedMember(ByVal Channel As CHATSVCLib.IChatChannel, ByVal User As CHATSVCLib.IChatUser, ByVal Mode As CHATSVCLib.CHAT_USER_MODE, Value As Variant, ByVal PostUpdate As Boolean) As Long
End Function
Private Function IChatChannelCallBack_OnChannelText(ByVal Channel As CHATSVCLib.IChatChannel, ByVal User As CHATSVCLib.IChatUser, ByVal Command As CHATSVCLib.IRC_COMMAND_TYPE, Message As String, ByVal PostUpdate As Boolean) As Long
End Function
Private Sub IChatChannelCallBack_OnRemoveAccess(ByVal Channel As CHATSVCLib.IChatChannel, ByVal Access As CHATSVCLib.IChatAccessEntry)
End Sub
Private Sub IChatChannelCallBack_OnRemoveMember(ByVal Channel As CHATSVCLib.IChatChannel, ByVal User As CHATSVCLib.IChatUser)
End Sub
© 1998 Microsoft Corporation. All rights reserved.