home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / VPS_-_Vari179129992004.psc / Modules / modDLL.bas < prev    next >
BASIC Source File  |  2004-08-25  |  5KB  |  173 lines
  1. Attribute VB_Name = "modDLL"
  2. Option Explicit
  3.  
  4. Private Declare Function LoadLibraryRegister Lib "KERNEL32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  5. Private Declare Function FreeLibraryRegister Lib "KERNEL32" Alias "FreeLibrary" (ByVal hLibModule As Long) As Long
  6. Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
  7. Private Declare Function GetProcAddressRegister Lib "KERNEL32" Alias "GetProcAddress" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  8. Private Declare Function CreateThreadForRegister Lib "KERNEL32" Alias "CreateThread" (lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpparameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
  9. Private Declare Function WaitForSingleObject Lib "KERNEL32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  10. Private Declare Function GetExitCodeThread Lib "KERNEL32" (ByVal hThread As Long, lpExitCode As Long) As Long
  11.  
  12. Private Declare Sub ExitThread Lib "KERNEL32" (ByVal dwExitCode As Long)
  13.     Private Const STATUS_WAIT_0 = &H0
  14.     Private Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)
  15.     Private Const NOERRORS As Long = 0
  16.  
  17. Private Enum stRegisterStatus
  18.     stFileCouldNotBeLoadedIntoMemorySpace = 1
  19.     stNotAValidActiveXComponent = 2
  20.     stActiveXComponentRegistrationFailed = 3
  21.     stActiveXComponentRegistrationSuccessful = 4
  22.     stActiveXComponentUnRegisterSuccessful = 5
  23.     stActiveXComponentUnRegistrationFailed = 6
  24.     stNoFileProvided = 7
  25. End Enum
  26.  
  27. Public Function Register(ByVal p_sFileName As String) As Variant
  28.     Dim lLib As Long
  29.     Dim lProcAddress As Long
  30.     Dim lThreadID As Long
  31.     Dim lSuccess As Long
  32.     Dim lExitCode As Long
  33.     Dim lThreadHandle As Long
  34.     Dim lRet As Long
  35.     On Error GoTo ErrorHandler
  36.  
  37.  
  38.     If lRet = NOERRORS Then
  39.  
  40.  
  41.         If p_sFileName = "" Then
  42.             lRet = stNoFileProvided
  43.         End If
  44.     End If
  45.  
  46.  
  47.     If lRet = NOERRORS Then
  48.         lLib = LoadLibraryRegister(p_sFileName)
  49.  
  50.  
  51.         If lLib = 0 Then
  52.             lRet = stFileCouldNotBeLoadedIntoMemorySpace
  53.         End If
  54.     End If
  55.  
  56.  
  57.     If lRet = NOERRORS Then
  58.         lProcAddress = GetProcAddressRegister(lLib, "DllRegisterServer")
  59.  
  60.  
  61.         If lProcAddress = 0 Then
  62.             lRet = stNotAValidActiveXComponent
  63.         Else
  64.             lThreadHandle = CreateThreadForRegister(0, 0, lProcAddress, 0, 0, lThreadID)
  65.  
  66.  
  67.             If lThreadHandle <> 0 Then
  68.                 lSuccess = (WaitForSingleObject(lThreadHandle, 10000) = WAIT_OBJECT_0)
  69.  
  70.  
  71.                 If lSuccess = 0 Then
  72.                     Call GetExitCodeThread(lThreadHandle, lExitCode)
  73.                     Call ExitThread(lExitCode)
  74.                     lRet = stActiveXComponentRegistrationFailed
  75.                 Else
  76.                     lRet = stActiveXComponentRegistrationSuccessful
  77.                 End If
  78.             End If
  79.         End If
  80.     End If
  81. ExitRoutine:
  82.     Register = lRet
  83.  
  84.  
  85.     If lThreadHandle <> 0 Then
  86.         Call CloseHandle(lThreadHandle)
  87.     End If
  88.  
  89.  
  90.     If lLib <> 0 Then
  91.         Call FreeLibraryRegister(lLib)
  92.     End If
  93.     Exit Function
  94. ErrorHandler:
  95.     lRet = Err.Number
  96.     GoTo ExitRoutine
  97. End Function
  98.  
  99.  
  100. Public Function UnRegister(ByVal p_sFileName As String) As Variant
  101.     Dim lLib As Long
  102.     Dim lProcAddress As Long
  103.     Dim lThreadID As Long
  104.     Dim lSuccess As Long
  105.     Dim lExitCode As Long
  106.     Dim lThreadHandle As Long
  107.     Dim lRet As Long
  108.     On Error GoTo ErrorHandler
  109.  
  110.  
  111.     If lRet = NOERRORS Then
  112.  
  113.  
  114.         If p_sFileName = "" Then
  115.             lRet = stNoFileProvided
  116.         End If
  117.     End If
  118.  
  119.  
  120.     If lRet = NOERRORS Then
  121.         lLib = LoadLibraryRegister(p_sFileName)
  122.  
  123.  
  124.         If lLib = 0 Then
  125.             lRet = stFileCouldNotBeLoadedIntoMemorySpace
  126.         End If
  127.     End If
  128.  
  129.  
  130.     If lRet = NOERRORS Then
  131.         lProcAddress = GetProcAddressRegister(lLib, "DllUnregisterServer")
  132.  
  133.  
  134.         If lProcAddress = 0 Then
  135.             lRet = stNotAValidActiveXComponent
  136.         Else
  137.             lThreadHandle = CreateThreadForRegister(0, 0, lProcAddress, 0, 0, lThreadID)
  138.  
  139.  
  140.             If lThreadHandle <> 0 Then
  141.                 lSuccess = (WaitForSingleObject(lThreadHandle, 10000) = WAIT_OBJECT_0)
  142.  
  143.  
  144.                 If lSuccess = 0 Then
  145.                     Call GetExitCodeThread(lThreadHandle, lExitCode)
  146.                     Call ExitThread(lExitCode)
  147.                     lRet = stActiveXComponentUnRegistrationFailed
  148.                 Else
  149.                     lRet = stActiveXComponentUnRegisterSuccessful
  150.                 End If
  151.             End If
  152.         End If
  153.     End If
  154. ExitRoutine:
  155.     UnRegister = lRet
  156.  
  157.  
  158.     If lThreadHandle <> 0 Then
  159.         Call CloseHandle(lThreadHandle)
  160.     End If
  161.  
  162.  
  163.     If lLib <> 0 Then
  164.         Call FreeLibraryRegister(lLib)
  165.     End If
  166.     Exit Function
  167. ErrorHandler:
  168.     lRet = Err.Number
  169.     GoTo ExitRoutine
  170. End Function
  171.  
  172.  
  173.