afinstallere activex komponent(ocx) med vb6

Option Explicit

Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName 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
Private Const ERROR_SUCCESS = &H0

Private Sub Form_Load()
  Text1.Text = "C:\WINDOWS\SYSTEM\COMCTL32.OCX"
  Command1.Caption = "Register server"
  Command2.Caption = "Unregister server"
End Sub

Private Sub Command1_Click()
  Call RegisterServer(Me.hWnd, Text1.Text, True)
End Sub

Private Sub Command2_Click()
  Call RegisterServer(Me.hWnd, Text1.Text, False)
End Sub

Public Function RegisterServer(hWnd As Long, DllServerPath As String, bRegister As Boolean)
On Error Resume Next
Dim lb As Long, pa As Long
lb = LoadLibrary(DllServerPath)
  If bRegister Then
    pa = GetProcAddress(lb, "DllRegisterServer")
      Else
    pa = GetProcAddress(lb, "DllUnregisterServer")
  End If
 
  If CallWindowProc(pa, hWnd, ByVal 0&, ByVal 0&, ByVal 0&) = ERROR_SUCCESS Then
    MsgBox IIf(bRegister = True, "Registration", "Unregistration") + " Successful"
      Else
    MsgBox IIf(bRegister = True, "Registration", "Unregistration") + " Unsuccessful"
  End If
FreeLibrary lb
End Function

smukt takker ! :)

hmm kan ikke lige få det til at virke hehe

den kommer ud og siger unregistration successful
men komponenten er stadig registreret og kan bruges
koden kommer her


Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName 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
Private Const ERROR_SUCCESS = &H0



Private Sub cmdUnpoint_Click()

If optExcel.Value = True Then
txtName.Caption = "xpoint30_excel.ocx"
End If
  Call RegisterServer(Me.hWnd, txtName.Caption, False)
End Sub

Public Function RegisterServer(hWnd As Long, DllServerPath As String, bRegister As Boolean)
On Error Resume Next
Dim lb As Long, pa As Long
lb = LoadLibrary(DllServerPath)
  If bRegister Then
    pa = GetProcAddress(lb, "DllRegisterServer")
      Else
    pa = GetProcAddress(lb, "DllUnregisterServer")
  End If
 
  If CallWindowProc(pa, hWnd, ByVal 0&, ByVal 0&, ByVal 0&) = ERROR_SUCCESS Then
    MsgBox IIf(bRegister = True, "Registration", "Unregistration") + " Successful"
      Else
    MsgBox IIf(bRegister = True, "Registration", "Unregistration") + " Unsuccessful"
  End If
FreeLibrary lb
End Function

Private Sub cmdExit_Click()
End
End Sub