您的位置:首页 > 其它

这样注册一个控件,不错!

2008-04-29 22:53 309 查看
这样注册不错啊!很好用的。

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lParameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'Create Thread Creation flags constant dw
Private Const CREATE_SUSPENDED = &H4 'The thread will only start if the thread Resume function
'one of the register server return constants
Private Const S_OK = &H0
'WaitForSingleObject dwMilliseconds one of the constants
Private Const INFINITE = &HFFFF
'My collection constants
Private Enum TLoc
LocalThread = 0
ExternThread = 1
End Enum
'W? Elected to register a file from
Private Sub Command1_Click()
On Error GoTo CancelErr
With CommonDialog1
.CancelError = True
.DialogTitle = "File to register? Open"
.Filter = "All files|*.*|All libraries|*.exe;*.ocx;*.dll;*.drv;*.vxd;*.tlb|*.EXE - Applications|*.exe|*.OCX - ActiveX file|*.ocx|" & _
"*.DLL - DLL Libary|*.dll|*.DRV - Ger? Te Drivers|*.drv|*.VXD - Virtual Driver|*.vxd"
.Flags = cdlOFNFileMustExist
.InitDir = App.Path
.ShowOpen
Label2.Caption = .FileTitle
Label2.Tag = .FileName
End With
Exit Sub
CancelErr:
Label2.Caption = ""
Label2.Tag = ""
End Sub

'De- / Registered a file Internal or Ext (RegSvr32.exe)
Private Function RegFile(ByVal ThreadLocation As TLoc, ByVal ExParams As String)
Dim hProc As Long, hModule As Long, hThread As Long, ThreadID As Long
Dim hExitCode As Long, Retval As Long
Select Case ThreadLocation
Case LocalThread 'Selbst Registrieren
'Datei Laden
hModule = LoadLibrary(Label2.Tag)
If hModule <> 0 Then
'Functional address to register determine
hProc = GetProcAddress(hModule, ExParams)
If hProc <> 0 Then
'New Thread Start with the function address identified
hThread = CreateThread(ByVal 0&, 0&, hProc, 0&, 0&, ThreadID)
'Wait that the function has been completed
Retval = WaitForSingleObject(hThread, INFINITE)
If Retval <> S_OK Then
MsgBox "The file could not be de / Registered be"
Else
MsgBox "The file has been successfully De-Registered"
End If
Else
MsgBox "There was no entry to the de / Register file found"
End If
'Thread Handle freigeben
Retval = CloseHandle(hThread)
'Datei wieder entladen
Retval = FreeLibrary(hModule)
Else
MsgBox "The file could not be loaded."
End If
Case ExternThread 'per RegSVR32 Registrieren
Shell "regsvr32.exe " & ExParams, vbNormalFocus
End Select
End Function
'If a popup menu to Emigr? Choose the registration method to
Private Sub Command2_Click()
If Label2.Tag <> "" Then
Me.PopupMenu Mnu_FileReg
End If
End Sub

'Register file manually
Private Sub Mnu_RegIn_Click()
Call RegFile(LocalThread, "DllRegisterServer")
End Sub

'Register on file Regsvr32.exe
Private Sub Mnu_RegEx_Click()
Call RegFile(ExternThread, Label2.Tag)
End Sub

'Manually DeRegistrieren
Private Sub Mnu_UnRegIn_Click()
Call RegFile(LocalThread, "DllUnregisterServer")
End Sub

'DeRegistrieren on file Regsvr32.exe
Private Sub Mnu_UnRegEx_Click()
Call RegFile(ExternThread, Label2.Tag & " /u")
End Sub
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: