VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "MangleTopic"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'This extension implements these Chat extensibility callbacks
Implements CHATSVCLib.IChatChannelCallBack
Implements CHATSVCLib.IChatExtensionCallBack

'Our extension's shortname
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

