PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
[VB6] - Module for working with COM-Dll without registration.-VBForums
Results 1 to 16 of 16

Thread: [VB6] - Module for working with COM-Dll without registration.

Threaded View

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,360

    [VB6] - Module for working with COM-Dll without registration.

    Hello. I give my module for working with COM-DLL without registration in the registry.
    The module has several functions:
    1. GetAllCoclasses - returns to the list of classes and unique identifiers are extracted from a type library.
    2. CreateIDispatch - creates IDispatch implementation by reference to the object and the name of the interface.
    3. CreateObjectEx2 - creates an object by name from a type library.
    4. CreateObjectEx - creates an object by CLSID.
    5. UnloadLibrary - unloads the DLL if it is not used.

    vb Code:
    1. ' The module modTrickUnregCOM.bas - for working with COM libraries without registration.
    2. ' Krivous Anatolii Anatolevich (The trick), 2015
    3.  
    4. Option Explicit
    5.  
    6. . . .
    7. D E C L A R A T I O N
    8. . . .
    9.  
    10. Dim iidClsFctr      As GUID
    11. Dim iidUnk          As GUID
    12. Dim isInit          As Boolean
    13.  
    14. ' // Get all co-classes described in type library.
    15. Public Function GetAllCoclasses( _
    16.                 ByRef path As String, _
    17.                 ByRef listOfClsid() As GUID, _
    18.                 ByRef listOfNames() As String, _
    19.                 ByRef countCoClass As Long) As Boolean
    20.                
    21.     Dim typeLib As IUnknown
    22.     Dim typeInf As IUnknown
    23.     Dim ret     As Long
    24.     Dim count   As Long
    25.     Dim index   As Long
    26.     Dim pAttr   As Long
    27.     Dim tKind   As Long
    28.    
    29.     ret = LoadTypeLibEx(StrPtr(path), REGKIND_NONE, typeLib)
    30.    
    31.     If ret Then
    32.         Err.Raise ret
    33.         Exit Function
    34.     End If
    35.    
    36.     count = ITypeLib_GetTypeInfoCount(typeLib)
    37.     countCoClass = 0
    38.    
    39.     If count > 0 Then
    40.    
    41.         ReDim listOfClsid(count - 1)
    42.         ReDim listOfNames(count - 1)
    43.        
    44.         For index = 0 To count - 1
    45.        
    46.             ret = ITypeLib_GetTypeInfo(typeLib, index, typeInf)
    47.                        
    48.             If ret Then
    49.                 Err.Raise ret
    50.                 Exit Function
    51.             End If
    52.            
    53.             ITypeInfo_GetTypeAttr typeInf, pAttr
    54.            
    55.             GetMem4 ByVal pAttr + &H28, tKind
    56.            
    57.             If tKind = TKIND_COCLASS Then
    58.            
    59.                 memcpy listOfClsid(countCoClass), ByVal pAttr, Len(listOfClsid(countCoClass))
    60.                 ret = ITypeInfo_GetDocumentation(typeInf, -1, listOfNames(countCoClass), vbNullString, 0, vbNullString)
    61.                
    62.                 If ret Then
    63.                     ITypeInfo_ReleaseTypeAttr typeInf, pAttr
    64.                     Err.Raise ret
    65.                     Exit Function
    66.                 End If
    67.                
    68.                 countCoClass = countCoClass + 1
    69.                
    70.             End If
    71.            
    72.             ITypeInfo_ReleaseTypeAttr typeInf, pAttr
    73.            
    74.             Set typeInf = Nothing
    75.            
    76.         Next
    77.        
    78.     End If
    79.    
    80.     If countCoClass Then
    81.        
    82.         ReDim Preserve listOfClsid(countCoClass - 1)
    83.         ReDim Preserve listOfNames(countCoClass - 1)
    84.    
    85.     Else
    86.    
    87.         Erase listOfClsid()
    88.         Erase listOfNames()
    89.        
    90.     End If
    91.    
    92.     GetAllCoclasses = True
    93.    
    94. End Function
    95.  
    96. ' // Create IDispach implementation described in type library.
    97. Public Function CreateIDispatch( _
    98.                 ByRef obj As IUnknown, _
    99.                 ByRef typeLibPath As String, _
    100.                 ByRef interfaceName As String) As Object
    101.                
    102.     Dim typeLib As IUnknown
    103.     Dim typeInf As IUnknown
    104.     Dim ret     As Long
    105.     Dim retObj  As IUnknown
    106.     Dim pAttr   As Long
    107.     Dim tKind   As Long
    108.    
    109.     ret = LoadTypeLibEx(StrPtr(typeLibPath), REGKIND_NONE, typeLib)
    110.    
    111.     If ret Then
    112.         Err.Raise ret
    113.         Exit Function
    114.     End If
    115.    
    116.     ret = ITypeLib_FindName(typeLib, interfaceName, 0, typeInf, 0, 1)
    117.    
    118.     If typeInf Is Nothing Then
    119.         Err.Raise &H80004002, , "Interface not found"
    120.         Exit Function
    121.     End If
    122.    
    123.     ITypeInfo_GetTypeAttr typeInf, pAttr
    124.     GetMem4 ByVal pAttr + &H28, tKind
    125.     ITypeInfo_ReleaseTypeAttr typeInf, pAttr
    126.    
    127.     If tKind = TKIND_DISPATCH Then
    128.         Set CreateIDispatch = obj
    129.         Exit Function
    130.     ElseIf tKind <> TKIND_INTERFACE Then
    131.         Err.Raise &H80004002, , "Interface not found"
    132.         Exit Function
    133.     End If
    134.  
    135.     ret = CreateStdDispatch(Nothing, obj, typeInf, retObj)
    136.    
    137.     If ret Then
    138.         Err.Raise ret
    139.         Exit Function
    140.     End If
    141.    
    142.     Set CreateIDispatch = retObj
    143.  
    144. End Function
    145.  
    146. ' // Create object by Name.
    147. Public Function CreateObjectEx2( _
    148.                 ByRef pathToDll As String, _
    149.                 ByRef pathToTLB As String, _
    150.                 ByRef className As String) As IUnknown
    151.                
    152.     Dim typeLib As IUnknown
    153.     Dim typeInf As IUnknown
    154.     Dim ret     As Long
    155.     Dim pAttr   As Long
    156.     Dim tKind   As Long
    157.     Dim clsid   As GUID
    158.    
    159.     ret = LoadTypeLibEx(StrPtr(pathToTLB), REGKIND_NONE, typeLib)
    160.    
    161.     If ret Then
    162.         Err.Raise ret
    163.         Exit Function
    164.     End If
    165.    
    166.     ret = ITypeLib_FindName(typeLib, className, 0, typeInf, 0, 1)
    167.    
    168.     If typeInf Is Nothing Then
    169.         Err.Raise &H80040111, , "Class not found in type library"
    170.         Exit Function
    171.     End If
    172.  
    173.     ITypeInfo_GetTypeAttr typeInf, pAttr
    174.    
    175.     GetMem4 ByVal pAttr + &H28, tKind
    176.    
    177.     If tKind = TKIND_COCLASS Then
    178.         memcpy clsid, ByVal pAttr, Len(clsid)
    179.     Else
    180.         Err.Raise &H80040111, , "Class not found in type library"
    181.         Exit Function
    182.     End If
    183.    
    184.     ITypeInfo_ReleaseTypeAttr typeInf, pAttr
    185.            
    186.     Set CreateObjectEx2 = CreateObjectEx(pathToDll, clsid)
    187.    
    188. End Function
    189.                
    190. ' // Create object by CLSID and path.
    191. Public Function CreateObjectEx( _
    192.                 ByRef path As String, _
    193.                 ByRef clsid As GUID) As IUnknown
    194.                
    195.     Dim hLib    As Long
    196.     Dim lpAddr  As Long
    197.     Dim isLoad  As Boolean
    198.    
    199.     hLib = GetModuleHandle(StrPtr(path))
    200.    
    201.     If hLib = 0 Then
    202.    
    203.         hLib = LoadLibrary(StrPtr(path))
    204.         If hLib = 0 Then
    205.             Err.Raise 53, , Error(53) & " " & Chr$(34) & path & Chr$(34)
    206.             Exit Function
    207.         End If
    208.        
    209.         isLoad = True
    210.        
    211.     End If
    212.    
    213.     lpAddr = GetProcAddress(hLib, "DllGetClassObject")
    214.    
    215.     If lpAddr = 0 Then
    216.         If isLoad Then FreeLibrary hLib
    217.         Err.Raise 453, , "Can't find dll entry point DllGetClasesObject in " & Chr$(34) & path & Chr$(34)
    218.         Exit Function
    219.     End If
    220.  
    221.     If Not isInit Then
    222.         CLSIDFromString StrPtr(IID_IClassFactory), iidClsFctr
    223.         CLSIDFromString StrPtr(IID_IUnknown), iidUnk
    224.         isInit = True
    225.     End If
    226.    
    227.     Dim ret     As Long
    228.     Dim out     As IUnknown
    229.    
    230.     ret = DllGetClassObject(lpAddr, clsid, iidClsFctr, out)
    231.    
    232.     If ret = 0 Then
    233.  
    234.         ret = IClassFactory_CreateInstance(out, 0, iidUnk, CreateObjectEx)
    235.    
    236.     Else
    237.    
    238.         If isLoad Then FreeLibrary hLib
    239.         Err.Raise ret
    240.         Exit Function
    241.        
    242.     End If
    243.    
    244.     Set out = Nothing
    245.    
    246.     If ret Then
    247.    
    248.         If isLoad Then FreeLibrary hLib
    249.         Err.Raise ret
    250.  
    251.     End If
    252.    
    253. End Function
    254.  
    255. ' // Unload DLL if not used.
    256. Public Function UnloadLibrary( _
    257.                 ByRef path As String) As Boolean
    258.                
    259.     Dim hLib    As Long
    260.     Dim lpAddr  As Long
    261.     Dim ret     As Long
    262.    
    263.     If Not isInit Then Exit Function
    264.    
    265.     hLib = GetModuleHandle(StrPtr(path))
    266.     If hLib = 0 Then Exit Function
    267.    
    268.     lpAddr = GetProcAddress(hLib, "DllCanUnloadNow")
    269.     If lpAddr = 0 Then Exit Function
    270.    
    271.     ret = DllCanUnloadNow(lpAddr)
    272.    
    273.     If ret = 0 Then
    274.         FreeLibrary hLib
    275.         UnloadLibrary = True
    276.     End If
    277.    
    278. End Function
    279.  
    280. ' // Call "DllGetClassObject" function using a pointer.
    281. Private Function DllGetClassObject( _
    282.                  ByVal funcAddr As Long, _
    283.                  ByRef clsid As GUID, _
    284.                  ByRef iid As GUID, _
    285.                  ByRef out As IUnknown) As Long
    286.                  
    287.     Dim params(2)   As Variant
    288.     Dim types(2)    As Integer
    289.     Dim list(2)     As Long
    290.     Dim resultCall  As Long
    291.     Dim pIndex      As Long
    292.     Dim pReturn     As Variant
    293.    
    294.     params(0) = VarPtr(clsid)
    295.     params(1) = VarPtr(iid)
    296.     params(2) = VarPtr(out)
    297.    
    298.     For pIndex = 0 To UBound(params)
    299.         list(pIndex) = VarPtr(params(pIndex)):   types(pIndex) = VarType(params(pIndex))
    300.     Next
    301.    
    302.     resultCall = DispCallFunc(0&, funcAddr, CC_STDCALL, vbLong, 3, types(0), list(0), pReturn)
    303.              
    304.     If resultCall Then Err.Raise 5: Exit Function
    305.    
    306.     DllGetClassObject = pReturn
    307.    
    308. End Function
    309.  
    310. ' // Call "DllCanUnloadNow" function using a pointer.
    311. Private Function DllCanUnloadNow( _
    312.                  ByVal funcAddr As Long) As Long
    313.                  
    314.     Dim resultCall  As Long
    315.     Dim pReturn     As Variant
    316.    
    317.     resultCall = DispCallFunc(0&, funcAddr, CC_STDCALL, vbLong, 0, ByVal 0&, ByVal 0&, pReturn)
    318.              
    319.     If resultCall Then Err.Raise 5: Exit Function
    320.    
    321.     DllCanUnloadNow = pReturn
    322.    
    323. End Function
    324.  
    325. ' // Call "IClassFactory:CreateInstance" method.
    326. Private Function IClassFactory_CreateInstance( _
    327.                  ByVal obj As IUnknown, _
    328.                  ByVal punkOuter As Long, _
    329.                  ByRef riid As GUID, _
    330.                  ByRef out As IUnknown) As Long
    331.    
    332.     Dim params(2)   As Variant
    333.     Dim types(2)    As Integer
    334.     Dim list(2)     As Long
    335.     Dim resultCall  As Long
    336.     Dim pIndex      As Long
    337.     Dim pReturn     As Variant
    338.    
    339.     params(0) = punkOuter
    340.     params(1) = VarPtr(riid)
    341.     params(2) = VarPtr(out)
    342.    
    343.     For pIndex = 0 To UBound(params)
    344.         list(pIndex) = VarPtr(params(pIndex)):   types(pIndex) = VarType(params(pIndex))
    345.     Next
    346.    
    347.     resultCall = DispCallFunc(obj, &HC, CC_STDCALL, vbLong, 3, types(0), list(0), pReturn)
    348.          
    349.     If resultCall Then Err.Raise resultCall: Exit Function
    350.      
    351.     IClassFactory_CreateInstance = pReturn
    352.    
    353. End Function
    354.  
    355. ' // Call "ITypeLib:GetTypeInfoCount" method.
    356. Private Function ITypeLib_GetTypeInfoCount( _
    357.                  ByVal obj As IUnknown) As Long
    358.    
    359.     Dim resultCall  As Long
    360.     Dim pReturn     As Variant
    361.  
    362.     resultCall = DispCallFunc(obj, &HC, CC_STDCALL, vbLong, 0, ByVal 0&, ByVal 0&, pReturn)
    363.          
    364.     If resultCall Then Err.Raise resultCall: Exit Function
    365.      
    366.     ITypeLib_GetTypeInfoCount = pReturn
    367.    
    368. End Function
    369.  
    370. ' // Call "ITypeLib:GetTypeInfo" method.
    371. Private Function ITypeLib_GetTypeInfo( _
    372.                  ByVal obj As IUnknown, _
    373.                  ByVal index As Long, _
    374.                  ByRef ppTInfo As IUnknown) As Long
    375.    
    376.     Dim params(1)   As Variant
    377.     Dim types(1)    As Integer
    378.     Dim list(1)     As Long
    379.     Dim resultCall  As Long
    380.     Dim pIndex      As Long
    381.     Dim pReturn     As Variant
    382.    
    383.     params(0) = index
    384.     params(1) = VarPtr(ppTInfo)
    385.    
    386.     For pIndex = 0 To UBound(params)
    387.         list(pIndex) = VarPtr(params(pIndex)):   types(pIndex) = VarType(params(pIndex))
    388.     Next
    389.    
    390.     resultCall = DispCallFunc(obj, &H10, CC_STDCALL, vbLong, 2, types(0), list(0), pReturn)
    391.          
    392.     If resultCall Then Err.Raise resultCall: Exit Function
    393.      
    394.     ITypeLib_GetTypeInfo = pReturn
    395.    
    396. End Function
    397.  
    398. ' // Call "ITypeLib:FindName" method.
    399. Private Function ITypeLib_FindName( _
    400.                  ByVal obj As IUnknown, _
    401.                  ByRef szNameBuf As String, _
    402.                  ByVal lHashVal As Long, _
    403.                  ByRef ppTInfo As IUnknown, _
    404.                  ByRef rgMemId As Long, _
    405.                  ByRef pcFound As Integer) As Long
    406.    
    407.     Dim params(4)   As Variant
    408.     Dim types(4)    As Integer
    409.     Dim list(4)     As Long
    410.     Dim resultCall  As Long
    411.     Dim pIndex      As Long
    412.     Dim pReturn     As Variant
    413.    
    414.     params(0) = StrPtr(szNameBuf)
    415.     params(1) = lHashVal
    416.     params(2) = VarPtr(ppTInfo)
    417.     params(3) = VarPtr(rgMemId)
    418.     params(4) = VarPtr(pcFound)
    419.    
    420.     For pIndex = 0 To UBound(params)
    421.         list(pIndex) = VarPtr(params(pIndex)):   types(pIndex) = VarType(params(pIndex))
    422.     Next
    423.    
    424.     resultCall = DispCallFunc(obj, &H2C, CC_STDCALL, vbLong, 5, types(0), list(0), pReturn)
    425.          
    426.     If resultCall Then Err.Raise resultCall: Exit Function
    427.      
    428.     ITypeLib_FindName = pReturn
    429.    
    430. End Function
    431.  
    432. ' // Call "ITypeInfo:GetTypeAttr" method.
    433. Private Sub ITypeInfo_GetTypeAttr( _
    434.             ByVal obj As IUnknown, _
    435.             ByRef ppTypeAttr As Long)
    436.    
    437.     Dim resultCall  As Long
    438.     Dim pReturn     As Variant
    439.    
    440.     pReturn = VarPtr(ppTypeAttr)
    441.    
    442.     resultCall = DispCallFunc(obj, &HC, CC_STDCALL, vbEmpty, 1, vbLong, VarPtr(pReturn), 0)
    443.          
    444.     If resultCall Then Err.Raise resultCall: Exit Sub
    445.  
    446. End Sub
    447.  
    448. ' // Call "ITypeInfo:GetDocumentation" method.
    449. Private Function ITypeInfo_GetDocumentation( _
    450.                  ByVal obj As IUnknown, _
    451.                  ByVal memid As Long, _
    452.                  ByRef pBstrName As String, _
    453.                  ByRef pBstrDocString As String, _
    454.                  ByRef pdwHelpContext As Long, _
    455.                  ByRef pBstrHelpFile As String) As Long
    456.    
    457.     Dim params(4)   As Variant
    458.     Dim types(4)    As Integer
    459.     Dim list(4)     As Long
    460.     Dim resultCall  As Long
    461.     Dim pIndex      As Long
    462.     Dim pReturn     As Variant
    463.    
    464.     params(0) = memid
    465.     params(1) = VarPtr(pBstrName)
    466.     params(2) = VarPtr(pBstrDocString)
    467.     params(3) = VarPtr(pdwHelpContext)
    468.     params(4) = VarPtr(pBstrHelpFile)
    469.    
    470.     For pIndex = 0 To UBound(params)
    471.         list(pIndex) = VarPtr(params(pIndex)):   types(pIndex) = VarType(params(pIndex))
    472.     Next
    473.    
    474.     resultCall = DispCallFunc(obj, &H30, CC_STDCALL, vbLong, 5, types(0), list(0), pReturn)
    475.          
    476.     If resultCall Then Err.Raise resultCall: Exit Function
    477.      
    478.     ITypeInfo_GetDocumentation = pReturn
    479.    
    480. End Function
    481.  
    482. ' // Call "ITypeInfo:ReleaseTypeAttr" method.
    483. Private Sub ITypeInfo_ReleaseTypeAttr( _
    484.             ByVal obj As IUnknown, _
    485.             ByVal ppTypeAttr As Long)
    486.    
    487.     Dim resultCall  As Long
    488.    
    489.     resultCall = DispCallFunc(obj, &H4C, CC_STDCALL, vbEmpty, 1, vbLong, VarPtr(CVar(ppTypeAttr)), 0)
    490.          
    491.     If resultCall Then Err.Raise resultCall: Exit Sub
    492.  
    493. End Sub

    Download.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width