Get ClsID, ProgID, TlbID of a DLL file

Question

arvin2006 1 Junior Poster in Training

13 Years Ago

Hi everyone. I am developing a vb app which uses reg free com. How can I get the IDs of the DLL file to insert it into the manifest file I am creating also with vb.
Is this possible?

visual-basic-6

2 Contributors
3 Replies
2K Views
2 Days Discussion Span
Latest Post 13 Years Ago Latest Post by AndreRet

All 3 Replies

AndreRet 526 Senior Poster

13 Years Ago

Well, not all DLLs have CLSIDs (only ones that expose COM objects) and in fact the DLLs themselves do not have CLSIDs. CLSIDs belong to the COM objects that are in the DLL.

The registry (HKEY_CLASSES_ROOT\CLSID\) contains this information.

The following code will return the ClsId and ProgId -

Option Explicit

      'CLSID/GUID structure
      '====================

      Private Type GUID
          Data1 As Long
          Data2 As Integer
          Data3 As Integer
          Data4(7) As Byte
      End Type

      'API Declarations:
      '=================

      Private Declare Function CLSIDFromProgID _
         Lib "ole32.dll" (ByVal lpszProgID As Long, _
         pCLSID As GUID) As Long

      Private Declare Function ProgIDFromCLSID _
         Lib "ole32.dll" (pCLSID As GUID, lpszProgID As Long) As Long

      Private Declare Function StringFromCLSID _
         Lib "ole32.dll" (pCLSID As GUID, lpszProgID As Long) As Long

      Private Declare Function CLSIDFromString _
         Lib "ole32.dll" (ByVal lpszProgID As Long, _
         pCLSID As GUID) As Long

      Private Declare Sub CopyMemory Lib "kernel32" Alias _
         "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

      Private Sub Command1_Click()
         Dim strProgID As String * 255
         Dim pProgID As Long
         Dim udtCLSID As GUID
         Dim strCLSID As String * 255
         Dim pCLSID As Long
         Dim lngRet As Long
         Dim strTemp As String
         Dim i As Integer

         'Take a ProgID.
         strTemp = Text1.Text

         'Get CLSID.
         lngRet = CLSIDFromProgID(StrPtr(strTemp), udtCLSID)

         'Display CLSID elements.
         With List1
            .AddItem Hex(udtCLSID.Data1)
            .AddItem Hex(udtCLSID.Data2)
            .AddItem Hex(udtCLSID.Data3)
            For i = 0 To 7
               .AddItem Hex(udtCLSID.Data4(i))
            Next
         End With

         'Convert CLSID to a string and get the pointer back.
         lngRet = StringFromCLSID(udtCLSID, pCLSID)

         'Get the CLSID string and display it.
         StringFromPointer pCLSID, strCLSID
         Text2.Text = strCLSID

         'Reinitialize the CLSID.
         With udtCLSID
            .Data1 = 0
            .Data2 = 0
            .Data3 = 0
            For i = 0 To 7
               .Data4(i) = 0
            Next
         End With

         'Convert the string back to CLSID.
         strTemp = Text2.Text
         lngRet = CLSIDFromString(StrPtr(strTemp), udtCLSID)

         'Get a pointer to ProgID string. This is a Unicode string.
         lngRet = ProgIDFromCLSID(udtCLSID, pProgID)

         'Get the ProgID and display it.
         StringFromPointer pProgID, strProgID
         Text3.Text = strProgID

      End Sub

      'This function takes a pointer to a Unicode string, a string buffer
      'and place the bytes in the Visual Basic string buffer.

      Private Sub StringFromPointer(pOLESTR As Long, strOut As String)
         Dim ByteArray(255) As Byte
         Dim intTemp As Integer
         Dim intCount As Integer
         Dim i As Integer

         intTemp = 1

         'Walk the string and retrieve the first byte of each WORD.
         While intTemp <> 0
            CopyMemory intTemp, ByVal pOLESTR + i, 2
            ByteArray(intCount) = intTemp
            intCount = intCount + 1
            i = i + 2
         Wend

         'Copy the byte array to our string.
         CopyMemory ByVal strOut, ByteArray(0), intCount
      End Sub

      Private Sub Form_Load()
         Text1.Text = "Project1.Class1"
      End Sub

Reply to this topic

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.

arvin2006 1 Junior Poster in Training · Answer 1 · 2010-11-12T05:53:49+00:00

Thank you for the response. I have that code already, but that one still gets the id's on the registry, isn't it?
I want to get the ID on a dll file which not yet registered, or not yet on the registry. So that I can access it through manifest file, even without registration. I am creating a program which dynamically gets clsid from a dll file. All dll's I am using have clsid, I checked it already. But I want to get its id and load it to a variable so that I can build manifest files with different clsid, progid and tlbid.

AndreRet 526 Senior Poster · Answer 2 · 2010-11-12T16:01:14+00:00

Firstly see if THIS will help.

The code below is something I used a while back, see if it will work for you.

'In a class module the following

Option Explicit

Private g_NT4 As Boolean
'
Private Const ADS_SECURE_AUTHENTICATION = 1

Public Sub AuthenticateUser(ByVal sNTDomain As String, ByVal sUserName As String, ByVal sPassword As String, ByRef vStatus As Variant)
     On Error GoTo errorhandler
    '
    If SSPValidateUser(sUserName, sNTDomain, sPassword) = True Then
        '
        MsgBox "pass"
        vStatus = "True"
        '
    Else
        '
        MsgBox "fail"
        vStatus = "False"
        '
    End If
    '
    Exit Sub
    '
errorhandler:
    '
    vStatus = "True"
    '
End Sub
'
'

'
Private Function GenClientContext(ByRef AuthSeq As AUTH_SEQ, _
      ByRef AuthIdentity As SEC_WINNT_AUTH_IDENTITY, _
      ByVal pIn As Long, ByVal cbIn As Long, _
      ByVal pOut As Long, ByRef cbOut As Long, _
      ByRef fDone As Boolean) As Boolean
      
   Dim ss As Long
   Dim tsExpiry As TimeStamp
   Dim sbdOut As SecBufferDesc
   Dim sbOut As SecBuffer
   Dim sbdIn As SecBufferDesc
   Dim sbIn As SecBuffer
   Dim fContextAttr As Long

   GenClientContext = False
   
   If Not AuthSeq.fInitialized Then
      
      If g_NT4 Then
         ss = NT4AcquireCredentialsHandle(0&, "NTLM", _
               SECPKG_CRED_OUTBOUND, 0&, AuthIdentity, 0&, 0&, _
               AuthSeq.hcred, tsExpiry)
      Else
         ss = AcquireCredentialsHandle(0&, "NTLM", _
               SECPKG_CRED_OUTBOUND, 0&, AuthIdentity, 0&, 0&, _
               AuthSeq.hcred, tsExpiry)
      End If
      
      If ss < 0 Then
         Exit Function
      End If

      AuthSeq.fHaveCredHandle = True
   
   End If

   ' Prepare output buffer
   sbdOut.ulVersion = 0
   sbdOut.cBuffers = 1
   sbdOut.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
         Len(sbOut))
   
   sbOut.cbBuffer = cbOut
   sbOut.BufferType = SECBUFFER_TOKEN
   sbOut.pvBuffer = pOut
   
   CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)

   ' Prepare input buffer
   If AuthSeq.fInitialized Then
      
      sbdIn.ulVersion = 0
      sbdIn.cBuffers = 1
      sbdIn.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
            Len(sbIn))
      
      sbIn.cbBuffer = cbIn
      sbIn.BufferType = SECBUFFER_TOKEN
      sbIn.pvBuffer = pIn
      
      CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)
   
   End If

   If AuthSeq.fInitialized Then
      
      If g_NT4 Then
         ss = NT4InitializeSecurityContext(AuthSeq.hcred, _
               AuthSeq.hctxt, 0&, 0, 0, SECURITY_NATIVE_DREP, sbdIn, _
               0, AuthSeq.hctxt, sbdOut, fContextAttr, tsExpiry)
      Else
         ss = InitializeSecurityContext(AuthSeq.hcred, _
               AuthSeq.hctxt, 0&, 0, 0, SECURITY_NATIVE_DREP, sbdIn, _
               0, AuthSeq.hctxt, sbdOut, fContextAttr, tsExpiry)
      End If
   
   Else
      
      If g_NT4 Then
         ss = NT4InitializeSecurityContext2(AuthSeq.hcred, 0&, 0&, _
               0, 0, SECURITY_NATIVE_DREP, 0&, 0, AuthSeq.hctxt, _
               sbdOut, fContextAttr, tsExpiry)
      Else
         ss = InitializeSecurityContext2(AuthSeq.hcred, 0&, 0&, _
               0, 0, SECURITY_NATIVE_DREP, 0&, 0, AuthSeq.hctxt, _
               sbdOut, fContextAttr, tsExpiry)
      End If
   
   End If
   
   If ss < 0 Then
      GoTo FreeResourcesAndExit
   End If

   AuthSeq.fHaveCtxtHandle = True

   ' If necessary, complete token
   If ss = SEC_I_COMPLETE_NEEDED _
         Or ss = SEC_I_COMPLETE_AND_CONTINUE Then

      If g_NT4 Then
         ss = NT4CompleteAuthToken(AuthSeq.hctxt, sbdOut)
      Else
         ss = CompleteAuthToken(AuthSeq.hctxt, sbdOut)
      End If
      
      If ss < 0 Then
         GoTo FreeResourcesAndExit
      End If
      
   End If

   CopyMemory sbOut, ByVal sbdOut.pBuffers, Len(sbOut)
   cbOut = sbOut.cbBuffer

   If Not AuthSeq.fInitialized Then
      AuthSeq.fInitialized = True
   End If

   fDone = Not (ss = SEC_I_CONTINUE_NEEDED _
         Or ss = SEC_I_COMPLETE_AND_CONTINUE)

   GenClientContext = True
      
FreeResourcesAndExit:

   If sbdOut.pBuffers <> 0 Then
      HeapFree GetProcessHeap(), 0, sbdOut.pBuffers
   End If
   
   If sbdIn.pBuffers <> 0 Then
      HeapFree GetProcessHeap(), 0, sbdIn.pBuffers
   End If
End Function
'
Private Function GenServerContext(ByRef AuthSeq As AUTH_SEQ, _
      ByVal pIn As Long, ByVal cbIn As Long, _
      ByVal pOut As Long, ByRef cbOut As Long, _
      ByRef fDone As Boolean) As Boolean
      
   Dim ss As Long
   Dim tsExpiry As TimeStamp
   Dim sbdOut As SecBufferDesc
   Dim sbOut As SecBuffer
   Dim sbdIn As SecBufferDesc
   Dim sbIn As SecBuffer
   Dim fContextAttr As Long
   
   GenServerContext = False

   If Not AuthSeq.fInitialized Then
      
      If g_NT4 Then
         ss = NT4AcquireCredentialsHandle2(0&, "NTLM", _
               SECPKG_CRED_INBOUND, 0&, 0&, 0&, 0&, AuthSeq.hcred, _
               tsExpiry)
      Else
         ss = AcquireCredentialsHandle2(0&, "NTLM", _
               SECPKG_CRED_INBOUND, 0&, 0&, 0&, 0&, AuthSeq.hcred, _
               tsExpiry)
      End If
      
      If ss < 0 Then
         Exit Function
      End If

      AuthSeq.fHaveCredHandle = True
   
   End If

   ' Prepare output buffer
   sbdOut.ulVersion = 0
   sbdOut.cBuffers = 1
   sbdOut.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
         Len(sbOut))
   
   sbOut.cbBuffer = cbOut
   sbOut.BufferType = SECBUFFER_TOKEN
   sbOut.pvBuffer = pOut
   
   CopyMemory ByVal sbdOut.pBuffers, sbOut, Len(sbOut)

   ' Prepare input buffer
   sbdIn.ulVersion = 0
   sbdIn.cBuffers = 1
   sbdIn.pBuffers = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
         Len(sbIn))
   
   sbIn.cbBuffer = cbIn
   sbIn.BufferType = SECBUFFER_TOKEN
   sbIn.pvBuffer = pIn
   
   CopyMemory ByVal sbdIn.pBuffers, sbIn, Len(sbIn)
      
   If AuthSeq.fInitialized Then
      
      If g_NT4 Then
         ss = NT4AcceptSecurityContext(AuthSeq.hcred, AuthSeq.hctxt, _
               sbdIn, 0, SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
               fContextAttr, tsExpiry)
      Else
         ss = AcceptSecurityContext(AuthSeq.hcred, AuthSeq.hctxt, _
               sbdIn, 0, SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
               fContextAttr, tsExpiry)
      End If
      
   Else
         
      If g_NT4 Then
         ss = NT4AcceptSecurityContext2(AuthSeq.hcred, 0&, sbdIn, 0, _
               SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
               fContextAttr, tsExpiry)
      Else
         ss = AcceptSecurityContext2(AuthSeq.hcred, 0&, sbdIn, 0, _
               SECURITY_NATIVE_DREP, AuthSeq.hctxt, sbdOut, _
               fContextAttr, tsExpiry)
      End If
   
   End If

   If ss < 0 Then
      GoTo FreeResourcesAndExit
   End If

   AuthSeq.fHaveCtxtHandle = True

   ' If necessary, complete token
   If ss = SEC_I_COMPLETE_NEEDED _
         Or ss = SEC_I_COMPLETE_AND_CONTINUE Then

      If g_NT4 Then
         ss = NT4CompleteAuthToken(AuthSeq.hctxt, sbdOut)
      Else
         ss = CompleteAuthToken(AuthSeq.hctxt, sbdOut)
      End If
      
      If ss < 0 Then
         GoTo FreeResourcesAndExit
      End If
      
   End If

   CopyMemory sbOut, ByVal sbdOut.pBuffers, Len(sbOut)
   cbOut = sbOut.cbBuffer
   
   If Not AuthSeq.fInitialized Then
      AuthSeq.fInitialized = True
   End If

   fDone = Not (ss = SEC_I_CONTINUE_NEEDED _
         Or ss = SEC_I_COMPLETE_AND_CONTINUE)

   GenServerContext = True
   
FreeResourcesAndExit:

   If sbdOut.pBuffers <> 0 Then
      HeapFree GetProcessHeap(), 0, sbdOut.pBuffers
   End If
   
   If sbdIn.pBuffers <> 0 Then
      HeapFree GetProcessHeap(), 0, sbdIn.pBuffers
   End If
   
End Function
'
Private Function SSPValidateUser(User As String, Domain As String, _
      Password As String) As Boolean

   Dim pSPI As Long
   Dim SPI As SecPkgInfo
   Dim cbMaxToken As Long
   
   Dim pClientBuf As Long
   Dim pServerBuf As Long
   
   Dim ai As SEC_WINNT_AUTH_IDENTITY
   
   Dim asClient As AUTH_SEQ
   Dim asServer As AUTH_SEQ
   Dim cbIn As Long
   Dim cbOut As Long
   Dim fDone As Boolean

   Dim osinfo As OSVERSIONINFO
   On Error GoTo errorhandler
   
   SSPValidateUser = False
   
   ' Determine if system is Windows NT (version 4.0 or earlier)
   osinfo.dwOSVersionInfoSize = Len(osinfo)
   osinfo.szCSDVersion = Space$(128)
   GetVersionExA osinfo
   g_NT4 = (osinfo.dwPlatformId = VER_PLATFORM_WIN32_NT And _
         osinfo.dwMajorVersion <= 4)

   ' Get max token size
   If g_NT4 Then
      NT4QuerySecurityPackageInfo "NTLM", pSPI
   Else
      QuerySecurityPackageInfo "NTLM", pSPI
   End If
   
   CopyMemory SPI, ByVal pSPI, Len(SPI)
   cbMaxToken = SPI.cbMaxToken
   
   If g_NT4 Then
      NT4FreeContextBuffer pSPI
   Else
      FreeContextBuffer pSPI
   End If

   ' Allocate buffers for client and server messages
   pClientBuf = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
         cbMaxToken)
   If pClientBuf = 0 Then
      GoTo FreeResourcesAndExit
   End If
      
   pServerBuf = HeapAlloc(GetProcessHeap(), HEAP_ZERO_MEMORY, _
         cbMaxToken)
   If pServerBuf = 0 Then
      GoTo FreeResourcesAndExit
   End If

   ' Initialize auth identity structure
   ai.Domain = Domain
   ai.DomainLength = Len(Domain)
   ai.User = User
   ai.UserLength = Len(User)
   ai.Password = Password
   ai.PasswordLength = Len(Password)
   ai.Flags = SEC_WINNT_AUTH_IDENTITY_ANSI

   ' Prepare client message (negotiate).
   cbOut = cbMaxToken
   If Not GenClientContext(asClient, ai, 0, 0, pClientBuf, cbOut, _
         fDone) Then
      GoTo FreeResourcesAndExit
   End If

   ' Prepare server message (challenge) .
   cbIn = cbOut
   cbOut = cbMaxToken
   If Not GenServerContext(asServer, pClientBuf, cbIn, pServerBuf, _
         cbOut, fDone) Then
      ' Most likely failure: AcceptServerContext fails with
      ' SEC_E_LOGON_DENIED in the case of bad szUser or szPassword.
      ' Unexpected Result: Logon will succeed if you pass in a bad
      ' szUser and the guest account is enabled in the specified domain.
      GoTo FreeResourcesAndExit
   End If

   ' Prepare client message (authenticate) .
   cbIn = cbOut
   cbOut = cbMaxToken
   If Not GenClientContext(asClient, ai, pServerBuf, cbIn, pClientBuf, _
         cbOut, fDone) Then
      GoTo FreeResourcesAndExit
   End If

   ' Prepare server message (authentication) .
   cbIn = cbOut
   cbOut = cbMaxToken
   If Not GenServerContext(asServer, pClientBuf, cbIn, pServerBuf, _
         cbOut, fDone) Then
      GoTo FreeResourcesAndExit
   End If

   SSPValidateUser = True

FreeResourcesAndExit:

   ' Clean up resources
   If asClient.fHaveCtxtHandle Then
      If g_NT4 Then
         NT4DeleteSecurityContext asClient.hctxt
      Else
         DeleteSecurityContext asClient.hctxt
      End If
   End If

   If asClient.fHaveCredHandle Then
      If g_NT4 Then
         NT4FreeCredentialsHandle asClient.hcred
      Else
         FreeCredentialsHandle asClient.hcred
      End If
   End If

   If asServer.fHaveCtxtHandle Then
      If g_NT4 Then
         NT4DeleteSecurityContext asServer.hctxt
      Else
         DeleteSecurityContext asServer.hctxt
      End If
   End If

   If asServer.fHaveCredHandle Then
      If g_NT4 Then
         NT4FreeCredentialsHandle asServer.hcred
      Else
         FreeCredentialsHandle asServer.hcred
      End If
   End If

   If pClientBuf <> 0 Then
      HeapFree GetProcessHeap(), 0, pClientBuf
   End If
   
   If pServerBuf <> 0 Then
      HeapFree GetProcessHeap(), 0, pServerBuf
   End If
errorhandler:
   ' MsgBox Err.Description
End Function

In a module, the following -

Option Explicit

' API Declerations for Getting the ClsId of the ActiveX component
Public Declare Function CLSIDFromProgID Lib "ole32.dll" (ByVal lpszProgID As Long, pCLSID As GUID) As Long
Public Declare Function StringFromCLSID Lib "ole32.dll" (pCLSID As GUID, lpszProgID As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
' API to get the local computer name
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'
Public Const MAX_COMPUTERNAME_LENGTH As Long = 15&
'
' CLSID/GUID structure
Public Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
'
Public Const MOVEFILE_COPY_ALLOWED = &H2
Public Const MOVEFILE_REPLACE_EXISTING = &H1
Public Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
Public Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
'
Public Const APP_TITLE As String = "iIE 2.4 Test Harness"
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const REG_BINARY = 3                     ' Free form binary
Public Const REG_DWORD_BIG_ENDIAN = 5           ' 32-bit number
Public Const REG_DWORD_LITTLE_ENDIAN = 4        ' 32-bit number (same as REG_DWORD)
'
Public Enum RegType
    RG_SZ = 1
    RG_DWORD = 4
    RG_BINARY = 3
    RG_DWORD_BIG_ENDIAN = 5
    RG_DWORD_LITTLE_ENDIAN = 4
End Enum
'
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
'
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
'
Public Const KEY_ALL_ACCESS = &H3F
Public Const KEY_SET_VALUE = &H2
Public Const KEY_QUERY_VALUE = &H1
'
Public Const REG_OPTION_NON_VOLATILE = 0
'
Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hkey As Long) As Long
'
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
"RegCreateKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, _
ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
As Long, phkResult As Long, lpdwDisposition As Long) As Long
'
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hkey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
Long) As Long
'
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As String, lpcbData As Long) As Long
'
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, lpData As _
Long, lpcbData As Long) As Long
'
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As Long, lpcbData As Long) As Long
'
Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
String, ByVal cbData As Long) As Long
'
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hkey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long
'
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hkey As Long, _
ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, _
lpType As Long, lpData As Byte, lpcbData As Long) As Long
'
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Long) As Long
'
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
   (ByVal hkey As Long, _
    ByVal lpSubKey As String) _
    As Long
'
Public Const HEAP_ZERO_MEMORY = &H8
'
Public Const SEC_WINNT_AUTH_IDENTITY_ANSI = &H1
'
Public Const SECBUFFER_TOKEN = &H2
'
Public Const SECURITY_NATIVE_DREP = &H10
'
Public Const SECPKG_CRED_INBOUND = &H1
Public Const SECPKG_CRED_OUTBOUND = &H2
'
Public Const SEC_I_CONTINUE_NEEDED = &H90312
Public Const SEC_I_COMPLETE_NEEDED = &H90313
Public Const SEC_I_COMPLETE_AND_CONTINUE = &H90314

Public Const VER_PLATFORM_WIN32_NT = &H2
'
Public Type SecPkgInfo
   fCapabilities As Long
   wVersion As Integer
   wRPCID As Integer
   cbMaxToken As Long
   Name As Long
   Comment As Long
End Type
'
Public Type SecHandle
    dwLower As Long
    dwUpper As Long
End Type
'
Public Type AUTH_SEQ
   fInitialized As Boolean
   fHaveCredHandle As Boolean
   fHaveCtxtHandle As Boolean
   hcred As SecHandle
   hctxt As SecHandle
End Type
'
Public Type SEC_WINNT_AUTH_IDENTITY
   User As String
   UserLength As Long
   Domain As String
   DomainLength As Long
   Password As String
   PasswordLength As Long
   Flags As Long
End Type
'
Public Type TimeStamp
   LowPart As Long
   HighPart As Long
End Type
'
Public Type SecBuffer
   cbBuffer As Long
   BufferType As Long
   pvBuffer As Long
End Type
'
Public Type SecBufferDesc
   ulVersion As Long
   cBuffers As Long
   pBuffers As Long
End Type
'
Public Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
'
Public Declare Function NT4QuerySecurityPackageInfo Lib "security" _
      Alias "QuerySecurityPackageInfoA" (ByVal PackageName As String, _
      ByRef pPackageInfo As Long) As Long
'
Public Declare Function QuerySecurityPackageInfo Lib "secur32" _
      Alias "QuerySecurityPackageInfoA" (ByVal PackageName As String, _
      ByRef pPackageInfo As Long) As Long
'
Public Declare Function NT4FreeContextBuffer Lib "security" _
      Alias "FreeContextBuffer" (ByVal pvContextBuffer As Long) As Long
'
Public Declare Function FreeContextBuffer Lib "secur32" _
      (ByVal pvContextBuffer As Long) As Long
'
Public Declare Function NT4InitializeSecurityContext Lib "security" _
      Alias "InitializeSecurityContextA" _
      (ByRef phCredential As SecHandle, ByRef phContext As SecHandle, _
      ByVal pszTargetName As Long, ByVal fContextReq As Long, _
      ByVal Reserved1 As Long, ByVal TargetDataRep As Long, _
      ByRef pInput As SecBufferDesc, ByVal Reserved2 As Long, _
      ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
      ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long
'
Public Declare Function InitializeSecurityContext Lib "secur32" _
      Alias "InitializeSecurityContextA" _
      (ByRef phCredential As SecHandle, ByRef phContext As SecHandle, _
      ByVal pszTargetName As Long, ByVal fContextReq As Long, _
      ByVal Reserved1 As Long, ByVal TargetDataRep As Long, _
      ByRef pInput As SecBufferDesc, ByVal Reserved2 As Long, _
      ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
      ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long
'
Public Declare Function NT4InitializeSecurityContext2 Lib "security" _
      Alias "InitializeSecurityContextA" _
      (ByRef phCredential As SecHandle, ByVal phContext As Long, _
      ByVal pszTargetName As Long, ByVal fContextReq As Long, _
      ByVal Reserved1 As Long, ByVal TargetDataRep As Long, _
      ByVal pInput As Long, ByVal Reserved2 As Long, _
      ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
      ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long
'
Public Declare Function InitializeSecurityContext2 Lib "secur32" _
      Alias "InitializeSecurityContextA" _
      (ByRef phCredential As SecHandle, ByVal phContext As Long, _
      ByVal pszTargetName As Long, ByVal fContextReq As Long, _
      ByVal Reserved1 As Long, ByVal TargetDataRep As Long, _
      ByVal pInput As Long, ByVal Reserved2 As Long, _
      ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
      ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long
'
Public Declare Function NT4AcquireCredentialsHandle Lib "security" _
      Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, _
      ByVal pszPackage As String, ByVal fCredentialUse As Long, _
      ByVal pvLogonId As Long, _
      ByRef pAuthData As SEC_WINNT_AUTH_IDENTITY, _
      ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, _
      ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) _
      As Long
'
Public Declare Function AcquireCredentialsHandle Lib "secur32" _
      Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, _
      ByVal pszPackage As String, ByVal fCredentialUse As Long, _
      ByVal pvLogonId As Long, _
      ByRef pAuthData As SEC_WINNT_AUTH_IDENTITY, _
      ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, _
      ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) _
      As Long
'
Public Declare Function NT4AcquireCredentialsHandle2 Lib "security" _
      Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, _
      ByVal pszPackage As String, ByVal fCredentialUse As Long, _
      ByVal pvLogonId As Long, ByVal pAuthData As Long, _
      ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, _
      ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) _
      As Long
'
Public Declare Function AcquireCredentialsHandle2 Lib "secur32" _
      Alias "AcquireCredentialsHandleA" (ByVal pszPrincipal As Long, _
      ByVal pszPackage As String, ByVal fCredentialUse As Long, _
      ByVal pvLogonId As Long, ByVal pAuthData As Long, _
      ByVal pGetKeyFn As Long, ByVal pvGetKeyArgument As Long, _
      ByRef phCredential As SecHandle, ByRef ptsExpiry As TimeStamp) _
      As Long
'
Public Declare Function NT4AcceptSecurityContext Lib "security" _
      Alias "AcceptSecurityContext" (ByRef phCredential As SecHandle, _
      ByRef phContext As SecHandle, ByRef pInput As SecBufferDesc, _
      ByVal fContextReq As Long, ByVal TargetDataRep As Long, _
      ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
      ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long
'
Public Declare Function AcceptSecurityContext Lib "secur32" _
      (ByRef phCredential As SecHandle, _
      ByRef phContext As SecHandle, ByRef pInput As SecBufferDesc, _
      ByVal fContextReq As Long, ByVal TargetDataRep As Long, _
      ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
      ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long
'
Public Declare Function NT4AcceptSecurityContext2 Lib "security" _
      Alias "AcceptSecurityContext" (ByRef phCredential As SecHandle, _
      ByVal phContext As Long, ByRef pInput As SecBufferDesc, _
      ByVal fContextReq As Long, ByVal TargetDataRep As Long, _
      ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
      ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long
'
Public Declare Function AcceptSecurityContext2 Lib "secur32" _
      Alias "AcceptSecurityContext" (ByRef phCredential As SecHandle, _
      ByVal phContext As Long, ByRef pInput As SecBufferDesc, _
      ByVal fContextReq As Long, ByVal TargetDataRep As Long, _
      ByRef phNewContext As SecHandle, ByRef pOutput As SecBufferDesc, _
      ByRef pfContextAttr As Long, ByRef ptsExpiry As TimeStamp) As Long
'
Public Declare Function NT4CompleteAuthToken Lib "security" _
      Alias "CompleteAuthToken" (ByRef phContext As SecHandle, _
      ByRef pToken As SecBufferDesc) As Long
'
Public Declare Function CompleteAuthToken Lib "secur32" _
      (ByRef phContext As SecHandle, _
      ByRef pToken As SecBufferDesc) As Long
'
Public Declare Function NT4DeleteSecurityContext Lib "security" _
      Alias "DeleteSecurityContext" (ByRef phContext As SecHandle) _
      As Long
'
Public Declare Function DeleteSecurityContext Lib "secur32" _
      (ByRef phContext As SecHandle) _
      As Long
'
Public Declare Function NT4FreeCredentialsHandle Lib "security" _
      Alias "FreeCredentialsHandle" (ByRef phContext As SecHandle) _
      As Long
'
Public Declare Function FreeCredentialsHandle Lib "secur32" _
      (ByRef phContext As SecHandle) _
      As Long
'
Public Declare Function GetProcessHeap Lib "kernel32" () As Long
'
Public Declare Function HeapAlloc Lib "kernel32" _
      (ByVal hHeap As Long, ByVal dwFlags As Long, _
      ByVal dwBytes As Long) As Long
'
Public Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, _
      ByVal dwFlags As Long, ByVal lpMem As Long) As Long
'
Public Declare Function GetVersionExA Lib "kernel32" _
   (lpVersionInformation As OSVERSIONINFO) As Integer

In your form the following -

Option Explicit

Dim ObjAuth As New GetClsidNumbers.Class1
 
Private Sub Command1_Click()

Call ObjAuth.AuthenticateUser(LTrim(Me.Text1.Text), LTrim(Me.Text2.Text), LTrim(Me.Text3.Text), 1)
 
End Sub

Get ClsID, ProgID, TlbID of a DLL file

Recommended Answers Collapse Answers

All 3 Replies

Recommended Answers