xAP over ethernet - a non-trivial input plugin....

["Mark Harrison" <Mark.Harrison@xxxxxxx>]

Here's some code for an xAP plugin for Outlook unread messages. It's
written in VBA, because it was written within Outlook2000. I'm appreciate
it if someone could just test with OutlookXP for me. 

This follows Patrick's recommendations for the revised xAP message format.
As far as I'm concerned, that's now the "approved" message
standard :-)

You will note, ahem, that this DOESN'T actually broadcast the xAP message,
but instead puts the body of the xAP message into a popup.

This is for two reasons:

1: Debugging
2: I'm hoping to blatantly steal Patrick's code fragment for that :-)

This triggers on receipt of a new message by Outlook, checks how many
unread messages there are in the inbox, and sends a xAP message IF IT'S
CHANGED. (Not as stupid as it may sound, my Outlook runs lots of server
side filing rules, so 90% of new messages never actually appear in my
Outlook inbox).

It does the checking by a registry value, which I've put in
HKEY_CURRENT_USER\software\xAP-HA\Outlook - it's using a nice  set of
Registry libraries written by Mary a while ago - the joys of a 2-geek
family, eh? :-)

The xAP-source is set to "Outlook"
The xAP-instance is set to the user name logged into Outlook

Mark

Code Follows:

--------------------------------------


'Things needed to use registry.
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const KEY_ALL_ACCESS As Long = &H3F
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const ERROR_NONE As Long = 0
Private Const REG_SZ As Long = 1

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" _
        (ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias
"RegCreateKeyA" _
        (ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        phkResult As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll"
Alias "RegSetValueExA" _
        (ByVal hKey As Long, _
        ByVal lpValueName As String,
_
        ByVal Reserved As Long, _
        ByVal dwType As Long, _
        ByVal lpValue As String, _
        ByVal cbData As Long) As
Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
        (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll"
Alias "RegQueryValueExA" _
        (ByVal hKey As Long, _
        ByVal lpValueName As String,
_
        ByVal lpReserved As Long, _
        lpType As Long, _
        ByVal lpData As Long, _
        lpcbData As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll"
Alias "RegQueryValueExA" _
        (ByVal hKey As Long, _
        ByVal lpValueName As String,
_
        ByVal lpReserved As Long, _
        lpType As Long, _
        ByVal lpData As String, _
        lpcbData As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias
"RegDeleteValueA" _
        (ByVal hKey As Long, _
        ByVal lpValueName As String) As
Long


Private Sub Application_NewMail()

'Work out how many messages there are in the inbox

Set oOutlook = New Outlook.Application
Set oNamespace = oOutlook.GetNamespace("MAPI")
Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox)
UnreadMessagesInInbox = oFolder.UnReadItemCount
oUserName = oNamespace.CurrentUser

'Compare with the unread count in the registry to see if there's a change,
and if so, broadcast it

If Trim$(Str$(UnreadMessagesInInbox)) <>
ReadRegistry("unreadcount") Then
    WriteRegistry "unreadcount",
Trim$(Str$(UnreadMessagesInInbox))
    'So broadcast it :-)

    xAPMessageBody = "xAP-source=Outlook" &
Chr$(10)
    xAPMessageBody = xAPMessageBody &
"xAP-instance=" & oUserName & Chr$(10)
    xAPMessageBody = xAPMessageBody &
"UnreadCount=" & Trim$(Str$(UnreadMessagesInInbox)) &
Chr$(10)
    
    MsgBox xAPMessageBody
    'OK, so it's currently popping up a MsgBox rather than
broadcasting, but, heh :-)
End If

End Sub



Private Function ReadRegistry(sRegistryValue As String, Optional sKey As
String) As String
    Dim lRetVal As Long
    Dim hKey As Long
    Dim DataLength As Long
    Dim DataType As Long
    Dim DataValue As String
    Dim sUseKey As String
    
    sUseKey = "software\xAP-HA\Outlook"
    If Trim$(sKey) <> "" Then
        sUseKey = sUseKey &
"\" & Trim$(sKey)
    End If
    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sUseKey, 0,
KEY_QUERY_VALUE, hKey)
    ' Determine the size and type of data to be read
    lRetVal = RegQueryValueExNULL(hKey, sRegistryValue,
0&, DataType, 0&, DataLength)
    DataValue = String$(DataLength, 0)
    lRetVal = RegQueryValueExString(hKey, sRegistryValue,
0&, REG_SZ, DataValue, DataLength)
    If lRetVal = ERROR_NONE Then
        'Use DataLength - 1 to remove
the string's null terminator
        ReadRegistry = Left$(DataValue,
DataLength - 1)
    Else
        ReadRegistry = ""
    End If
    RegCloseKey hKey
    Exit Function
End Function

Private Sub WriteRegistry(sRegistryValue As String, sNewValue As String,
Optional sKey As String)
    Dim lRetVal As Long
    Dim hKey As Long
    Dim sValue As String
    Dim sUseKey As String
    
    sUseKey = "software\xAP-HA\Outlook"
    If Trim$(sKey) <> "" Then
        sUseKey = sUseKey &
"\" & Trim$(sKey)
    End If
    lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, sUseKey, 0,
KEY_ALL_ACCESS, hKey)
    If lRetVal <> ERROR_NONE Then
        lRetVal =
RegCreateKey(HKEY_CURRENT_USER, sUseKey, hKey)
    End If
    sValue = sNewValue & Chr$(0)
    lRetVal = RegSetValueExString(hKey, sRegistryValue,
0&, REG_SZ, sValue, Len(sValue))
    RegCloseKey (hKey)
End Sub

Yahoo! Groups Sponsor

ADVERTISEMENT

For more information: http://www.automatedhome.co.uk
Post message: ukha_d@xxxxxxx 
Subscribe:  ukha_d-subscribe@xxxxxxx 
Unsubscribe:  ukha_d-unsubscribe@xxxxxxx 
List owner:  ukha_d-owner@xxxxxxx

Your use of Yahoo! Groups is subject to the Yahoo! Terms of Service.