• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Tải thư viện tự động cho chương trình

Các thủ thuật về hệ thống, thư mục, tập tin và mạng
User avatar
Posts: 261
Joined: Sat 19/04/2008 8:46 pm
Location: Hưng Yên
Been thanked: 43 times

Tải thư viện tự động cho chương trình

Postby tuyen_dt18 » Sat 06/06/2009 9:25 pm

Thủ thuật: Tải thư viện tự động cho chương trình
Tác giả: Sưu tầm
Mô tả: Tải thư viện lúc thực thi, không cần đăng ký với hệ thống - ( regsvr32 )

Code: Select all

  2. [color=#0000BF]Register Components without using Regsvr32.exe
  4. NOTE: Check the improved version of this at:
  7. Before you can use an DLL or an OCX you must register it. Registering a component places information about the control in the system registry. Once the control has been registered, applications and development environments can search the registry to determine which components have been installed.
  9. Most developers use the Package and deployment wizard to register their components. However, it is occasionally useful to make your own setup kit. The most common method of doing this usually involves shelling Regsvr32.exe. The main problem with shelling Regsvr32.exe is that it is relatively difficult to see if the component was successfully registered.
  11. The following code shows how to register DLL/Ocx components (including ActiveX EXE's):
  13. Option Explicit
  15. Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lLibFileName As String) As Long
  16. Private Declare Function CreateThread Lib "kernel32" (lThreadAttributes As Any, ByVal lStackSize As Long, ByVal lStartAddress As Long, ByVal larameter As Long, ByVal lCreationFlags As Long, lThreadID As Long) As Long
  17. Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal lMilliseconds As Long) As Long
  18. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lProcName As String) As Long
  19. Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  20. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  21. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  22. Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lExitCode As Long) As Long
  23. Private Declare Sub ExitThread Lib "kernel32" (ByVal lExitCode As Long)
  25. 'Purpose   :    This function registers and Unregisters OLE components
  26. 'Inputs    :    sFilePath                       The path to the DLL/OCX or ActiveX EXE
  27. '               bRegister                       If True Registers the control, else unregisters control
  28. 'Outputs   :    Returns True if successful
  29. 'Notes     :    This is the API equivalent of RegSvr32.exe.
  30. 'Example   :
  31. '               If RegisterComponent("C:\MyPath\MyFile.dll") = True Then
  32. '                   Msgbox "Component Successfully Registered"
  33. '               Else
  34. '                   Msgbox "Failed to Registered Component"
  35. '               End If
  36. 'Revisions :    1/Jan/2002. Updated to include code for registering ActiveX Exes.
  38. Function RegisterComponent(ByVal sFilePath As String, Optional bRegister As Boolean = True) As Boolean
  39.     Dim lLibAddress As Long, lProcAddress As Long, lThreadID As Long, lSuccess As Long, lExitCode As Long, lThread As Long
  40.     Dim sRegister As String
  41.     Const clMaxTimeWait As Long = 20000     'Wait 20 secs for register to complete
  43.     On Error GoTo ErrFailed
  44.     If Len(sFilePath) > 0 And Len(Dir(sFilePath)) > 0 Then
  45.         'File exists
  46.         If UCase$(Right$(sFilePath, 3)) = "EXE" Then
  47.             'Register/Unregister ActiveX EXE
  48.             If bRegister Then
  49.                 'Register EXE
  50.                 Shell sFilePath & " /REGSERVER", vbHide
  51.             Else
  52.                 'Unregister ActiveX EXE
  53.                 Shell sFilePath & " /UNREGSERVER", vbHide
  54.             End If
  55.             RegisterComponent = True
  56.         Else
  57.             'Register/Unregister DLL
  58.             If bRegister Then
  59.                 sRegister = "DllRegisterServer"
  60.             Else
  61.                 sRegister = "DllUnRegisterServer"
  62.             End If
  64.             'Load library into current process
  65.             lLibAddress = LoadLibraryA(sFilePath)
  67.             If lLibAddress Then
  68.                 'Get address of the DLL function
  69.                 lProcAddress = GetProcAddress(lLibAddress, sRegister)
  70.                 If lProcAddress Then
  71.                     lThread = CreateThread(ByVal 0&, 0&, ByVal lProcAddress, ByVal 0&, 0&, lThread)
  72.                     If lThread Then
  73.                         'Created thread and wait for it to terminate
  74.                         lSuccess = (WaitForSingleObject(lThread, clMaxTimeWait) = 0)
  75.                         If Not lSuccess Then
  76.                             'Failed to register, close thread
  77.                             Call GetExitCodeThread(lThread, lExitCode)
  78.                             Call ExitThread(lExitCode)
  79.                             RegisterComponent = False
  80.                         Else
  81.                             'Successfully registered component
  82.                             RegisterComponent = True
  83.                             Call CloseHandle(lThread)
  84.                         End If
  85.                     End If
  86.                     Call FreeLibrary(lLibAddress)
  87.                 Else
  88.                     'Object doesn't expose OLE interface
  89.                     Call FreeLibrary(lLibAddress)
  90.                 End If
  91.             End If
  92.         End If
  93.     End If
  94.     Exit Function
  96. ErrFailed:
  97.     Debug.Print Err.Description
  98.     Debug.Assert False
  99.     On Error GoTo 0
  100. End Function
  101. [/color]

Hỏi ý kiến tác giả trước khi sử dụng hoặc trích dẫn rõ nguồn bài viết khi sử dụng.

Return to “[VB] Hệ thống - Tập tin - Thư mục và Mạng”

Who is online

Users browsing this forum: No registered users and 1 guest