Shoutbox

code:

---

'Declare API Variables Used to Unregister the DLL

Option Explicit

Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
                                                                              ByVal hWnd As Long, _
                                                                              ByVal Msg As Any, _
                                                                              ByVal wParam As Any, _
                                                                              ByVal lParam As Any) _
                                                                              As Long

Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
                                                            ByVal dwMilliseconds As Long) _
                                                            As Long

Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long

Public Const INFINITE = &HFFFF

'Function to call the DllUnregisterServer
    'Usage: UnregisterServer Me.hWnd, "C:\Program Files\MessengerPlus! 3\Plugins\MyDLL.dll"
    'DllServerPath - Must be a COMPLETE PATH


Public Function UnregisterServer(hWnd As Long, DllServerPath As String)
    On Error Resume Next

    Dim lb As Long, pa As Long

'Check to see if the file exists, if it doesn't then exit after displaying a message box

'Load the DLL into memory

    lb = LoadLibrary(DllServerPath)

    If lb Then

        MsgBox "File Not Found!" & vbCrLf & "Unable to continue. " & _
           "(DllServerPath must be the full path to the file, " & _
           "or this program must be in the same directory.)"
        Exit Function

    End If

'Get the address of the function DllUnregisterServer from the DLL

    pa = GetProcAddress(lb, "DllUnregisterServer")

'Send the DLLs function to the main form

    If CallWindowProc(pa, hWnd, ByVal 0&, ByVal 0&, ByVal 0&) = ERROR_SUCCESS Then
         MsgBox "Successful"
    Else
         MsgBox "Unuccessful"
    End If
    FreeLibrary lb
End Function

'Delete the Plugin, code will not continue until this is done (WaitForSingleObject)
Public Function DeletePlugin() As Boolean
    Dim nMsg As Long, retVal As Long
   
    retVal = DeleteFile("C:\Program Files\MessengerPlus! 3\Plugins\MyDLL.dll")
    WaitForSingleObject retVal, INFINITE
    DeletePlugin = CBool(retVal)

End Function

---

code:

---

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
                                                                        ByVal wMsg As Long, _
                                                                        ByVal wParam As Long, _
                                                                        lParam As Any) _
                                                                        As Long

Public Declare Function RegisterWindowMessageA Lib "user32" (ByVal lpString As String) As Long

Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
                                                            ByVal dwMilliseconds As Long) _
                                                            As Long

Public Const INFINITE = &HFFFF
Public Const HWND_BROADCAST = &HFFFF&


'Unload the Plugins, code will not continue until this is done (WaitForSingleObject)
Public Function UnloadPlugins()
    Dim nMsg As Long, retVal As Long
   
    nMsg = RegisterWindowMessageA("MessengerPlus_PluginChange")
    retVal = SendMessage(HWND_BROADCAST, nMsg, 0&, 0&)
    WaitForSingleObject retVal, INFINITE
End Function

---

code:

---

Public Function DllUnregister(strFile As String)

    Dim retVal As Long

    retval = shell("regsvr32 /u " & Chr(34) & strFile & Chr(34)), vbHide
    WaitForSingleObject retval, INFINITE

End Function

---

code:

---

Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, _
                                                                               ByVal lpSubKey As String, _
                                                                               phkResult As Long) _
                                                                               As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, _
                                                                                   ByVal lpValueName As String) _
                                                                                   As Long

Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, _
                                                                           ByVal lpSubKey As String, _
                                                                           phkResult As Long) _
                                                                           As Long

Public Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, _
                                                             ByVal lpValueName As String, _
                                                             ByVal lpReserved As Long, _
                                                             lpType As Long, _
                                                             lpData As Any, _
                                                             lpcbData As Long) _
                                                             As Long

Public Declare Function RegQueryValueExA Lib "advapi32.dll" (ByVal hKey As Long, _
                                                             ByVal lpValueName As String, _
                                                             ByVal lpReserved As Long, _
                                                             lpType As Long, _
                                                             lpData As Any, _
                                                             lpcbData As Long) _
                                                             As Long

Public Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    lResult = RegQueryValueExA(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = REG_SZ Then
            strBuf = String(lDataBufSize, Chr$(0))
            lResult = RegQueryValueExA(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        ElseIf lValueType = REG_BINARY Then
            Dim strData As Integer
            lResult = RegQueryValueExA(hKey, strValueName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = strData
            End If
        End If
    End If
End Function

Public Function GetStringvalue(hKey As Long, strPath As String, strValue As String) As String
    Dim Ret
    RegOpenKey hKey, strPath, Ret
    GetStringvalue = RegQueryStringValue(Ret, strValue)
    RegCloseKey Ret
End Function

---

code:

---

Private Sub Form_Load()

    Dim sText As String

    sText = LCase(GetStringvalue(HKEY_LOCAL_MACHINE, "software\patchou\msgplus2\", "plugindir"))
    If sText = vbNullString Then
        sText = LCase(GetStringvalue(HKEY_CURRENT_USER, "software\patchou\msgplus2\", "plugindir"))
        If sText = vbNullString Then
            MsgBox "Messenger Plus! not installed"
        Else
            MsgBox "Plugin Dir: " & sText
        End If
    Else
        MsgBox "Plugin Dir: " & sText
    End If

End Sub

---

code:

---

Private Sub Form_Load()
    Dim Plugin As Object

    Set Plugin = CreateObject("%Projectname%.%Classname%")

    Plugin.Configure

End Sub

---