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?
arvin2006 1 Junior Poster in Training
AndreRet 526 Senior Poster
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 arvin2006 1 Junior Poster in Training
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
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 FunctionIn 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 IntegerIn 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 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.