//转载//' Add 2 Commandbuttons and a textbox to the form, and paste this code into the form
Option ExplicitPrivate 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 = &H0Private Sub Form_Load()
Text1.Text = "C:\WINDOWS\SYSTEM\COMCTL32.OCX"
Command1.Caption = "Register server"
Command2.Caption = "Unregister server"
End SubPrivate Sub Command1_Click()
Call RegisterServer(Me.hWnd, Text1.Text, True)
End SubPrivate Sub Command2_Click()
Call RegisterServer(Me.hWnd, Text1.Text, False)
End SubPublic Function RegisterServer(hWnd As Long, DllServerPath As String, bRegister As Boolean)
On Error Resume Next 'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'We're going to call an API-function, without declaring it! ' Modified by G. Kleijer
' [email protected]
' going to call the DllRegisterServer/DllUnRegisterServer API of the specified library.
' there's no need to use the Regsvr32.exe anymore. ' Make sure the path is correct and that the file exists, otherwise VB will crash. 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
'unmap the library's address
FreeLibrary lb
End Function
Option ExplicitPrivate 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 = &H0Private Sub Form_Load()
Text1.Text = "C:\WINDOWS\SYSTEM\COMCTL32.OCX"
Command1.Caption = "Register server"
Command2.Caption = "Unregister server"
End SubPrivate Sub Command1_Click()
Call RegisterServer(Me.hWnd, Text1.Text, True)
End SubPrivate Sub Command2_Click()
Call RegisterServer(Me.hWnd, Text1.Text, False)
End SubPublic Function RegisterServer(hWnd As Long, DllServerPath As String, bRegister As Boolean)
On Error Resume Next 'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'We're going to call an API-function, without declaring it! ' Modified by G. Kleijer
' [email protected]
' going to call the DllRegisterServer/DllUnRegisterServer API of the specified library.
' there's no need to use the Regsvr32.exe anymore. ' Make sure the path is correct and that the file exists, otherwise VB will crash. 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
'unmap the library's address
FreeLibrary lb
End Function
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货