Attribute VB_Name = "mSnarl_i"
Option Explicit

Private Const WM_COPYDATA = &H4A

Private Const SNARL_GLOBAL_MSG = "SnarlGlobalEvent"

Private Type COPYDATASTRUCT
    dwData As Long
    cbData As Long
    lpData As Long
End Type

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal cbBytes As Long)

    ' /* event identifiers - passed in wParam when either SNARL_GLOBAL_MSG or ReplyMsg is received */
Public Const SNARL_LAUNCHED = 1
Public Const SNARL_QUIT = 2

Public Const SNARL_NOTIFICATION_CLICKED = 32            ' // notification was right-clicked by user
Public Const SNARL_NOTIFICATION_TIMED_OUT = 33
Public Const SNARL_NOTIFICATION_ACK = 34                ' // notification was left-clicked by user

Public Enum SNARL_COMMANDS
    SNARL_SHOW = 1
    SNARL_HIDE
    SNARL_UPDATE
    SNARL_IS_VISIBLE
    SNARL_GET_VERSION
    SNARL_REGISTER_CONFIG_WINDOW
    SNARL_REVOKE_CONFIG_WINDOW
End Enum

Public Type SNARLSTRUCT
    Cmd As SNARL_COMMANDS       ' // what to do...
    Id As Long                  ' // snarl message id (returned by snShowMessage())
    Timeout As Long             ' // timeout in seconds (0=sticky)
    LngData2 As Long            ' // reserved
    Title(0 To 1023) As Byte
    Text(0 To 1023) As Byte
    Icon(0 To 1023) As Byte
End Type

Public Function snShowMessage(ByVal Title As String, ByVal Text As String, Optional ByVal Timeout As Long, Optional ByVal IconPath As String, Optional ByVal hWndReply As Long, Optional ByVal uReplyMsg As Long) As Long
Dim pss         As SNARLSTRUCT

    pss.Cmd = SNARL_SHOW
    uatob Title, pss.Title
    uatob Text, pss.Text
    uatob IconPath, pss.Icon
    pss.Timeout = Timeout
    ' /* R0.3 */
    pss.LngData2 = hWndReply
    pss.Id = uReplyMsg
    snShowMessage = uSend(pss)

End Function

Public Function snHideMessage(ByVal Id As Long) As Boolean
Dim pss         As SNARLSTRUCT

    pss.Cmd = SNARL_HIDE
    pss.Id = Id
    snHideMessage = CBool(uSend(pss))

End Function

Public Function snIsMessageVisible(ByVal Id As Long) As Boolean
Dim pss         As SNARLSTRUCT

    pss.Cmd = SNARL_IS_VISIBLE
    pss.Id = Id
    snIsMessageVisible = CBool(uSend(pss))

End Function

Public Function snUpdateMessage(ByVal Id As Long, ByVal Title As String, ByVal Text As String) As Long
Dim pss         As SNARLSTRUCT

    pss.Cmd = SNARL_UPDATE
    pss.Id = Id
    uatob Title, pss.Title
    uatob Text, pss.Text
    snUpdateMessage = uSend(pss)

End Function

Public Function snRegisterConfig(ByVal hWnd As Long, ByVal AppName As String, ByVal ReplyMsg As Long) As Long
Dim pss         As SNARLSTRUCT

    pss.Cmd = SNARL_REGISTER_CONFIG_WINDOW
    pss.LngData2 = hWnd
    pss.Id = ReplyMsg
    uatob AppName, pss.Title
    snRegisterConfig = uSend(pss)

End Function

Public Function snRevokeConfig(ByVal hWnd As Long) As Long
Dim pss         As SNARLSTRUCT

    pss.Cmd = SNARL_REVOKE_CONFIG_WINDOW
    pss.LngData2 = hWnd
    snRevokeConfig = uSend(pss)

End Function

Private Function uSend(pss As SNARLSTRUCT) As Long
Dim hWnd        As Long
Dim pcds        As COPYDATASTRUCT

    hWnd = FindWindow(vbNullString, "Snarl")
    If IsWindow(hWnd) <> 0 Then
        pcds.dwData = 2                 ' // SNARLSTRUCT
        pcds.cbData = Len(pss)
        pcds.lpData = VarPtr(pss)
        uSend = SendMessage(hWnd, WM_COPYDATA, 0, pcds)

    End If

End Function

Public Function snGetVersion(ByRef Major As Integer, ByRef Minor As Integer) As Boolean
Dim pss         As SNARLSTRUCT
Dim hr          As Long

    pss.Cmd = SNARL_GET_VERSION
    hr = uSend(pss)
    If hr <> 0 Then
        Major = uHIWORD(hr)
        Minor = uLOWORD(hr)
        snGetVersion = True
    End If

End Function

Public Function snGetGlobalMsg() As Long
    snGetGlobalMsg = RegisterWindowMessage(SNARL_GLOBAL_MSG)
End Function

Private Function uLOWORD(ByVal dw As Long) As Integer
Dim i       As Integer

    CopyMemory i, ByVal VarPtr(dw), 2
    uLOWORD = i

End Function

Private Function uHIWORD(ByVal dw As Long) As Integer
Dim i       As Integer

    CopyMemory i, ByVal VarPtr(dw) + 2, 2
    uHIWORD = i

End Function

Private Function uatob(ByVal ansi_str As String, ByRef str_array() As Byte) As Boolean
Dim i           As Long
Dim a           As Long
Dim b           As Long

    On Error Resume Next

    If Len(ansi_str) = 0 Then _
        Exit Function

    Err.Clear
    a = LBound(str_array())

    If Err.Number = 0 Then
        b = UBound(str_array())
        If Err.Number = 0 Then
            If Len(ansi_str) <= (b - a) Then
                For i = 1 To Len(ansi_str)
                    str_array(a + (i - 1)) = Asc(Mid$(ansi_str, i, 1))
                Next i
                uatob = True
            End If
        End If
    End If

End Function