I have discovered that our legacy client side application (in VB6) was not calling CoInitialzeSecurity. In XP this was fine. In Windows 7 the security is obviously tighter and we must now call this from our client. The next challenge was getting the VB6 code to work.
Here is the code that has made this work. I have trimmed out the bits that apply specifically to our application, but this code is what gets it going. Most of this has been copied from other web pages, but since I could not find a call to CoInitializeSecurity and all the associated code that goes with it, I am posting the consolidated code here.
Private Const RPC_C_AUTHN_NONE As Long = 0
Private Const RPC_C_AUTHN_GSS_NEGOTIATE As Long = 9
Private Const RPC_C_AUTHN_GSS_KERBEROS As Long = 10
Private Const RPC_C_AUTHN_WINNT As Long = &HA
Private Const RPC_C_AUTHN_DEFAULT As Long = &HFFFFFFFF
Private Const RPC_C_AUTHN_LEVEL_DEFAULT As Long = 0
Private Const RPC_C_AUTHN_LEVEL_NONE As Long = 1
Private Const RPC_C_AUTHN_LEVEL_CONNECT As Long = 2
Private Const RPC_C_AUTHN_LEVEL_CALL As Long = 3
Private Const RPC_C_AUTHN_LEVEL_PKT As Long = 4
Private Const RPC_C_AUTHN_LEVEL_PKT_INTEGRITY As Long = 5
Private Const RPC_C_AUTHN_LEVEL_PKT_PRIVACY As Long = 6
Private Const RPC_C_AUTHZ_NONE = 0
Private Const RPC_C_IMP_LEVEL_ANONYMOUS As Long = 1
Private Const RPC_C_IMP_LEVEL_IDENTIFY As Long = 2
Private Const RPC_C_IMP_LEVEL_IMPERSONATE As Long = 3
Private Const RPC_C_IMP_LEVEL_DELEGATE As Long = 4
Private Const API_NULL As Long = 0
Private Const S_OK As Long = 0
Private Const EOAC_NONE As Long = &H0
Private Const EOAC_MUTUAL_AUTH As Long = &H1
Private Const EOAC_CLOAKING As Long = &H10
Private Const EOAC_SECURE_REFS As Long = &H2
Private Const EOAC_ACCESS_CONTROL As Long = &H4
Private Const EOAC_APPID As Long = &H8
Private Const SEC_WINNT_AUTH_IDENTITY_ANSI = &H1
Private Const SEC_WINNT_AUTH_IDENTITY_UNICODE = &H2
Private Type COAUTHINFO
dwAuthnSvc As Long
dwAuthzSvc As Long
pAuthIdentityData As Long
End Type
Private Type COAUTHLIST
dwAuthList As Long
pAuthList As Long
End Type
Type COAUTHIDENTITY
User As String
UserLength As Long
Domain As String
DomainLength As Long
Password As String
PasswordLength As Long
Flags As Long
End Type
Private Declare Function CoInitializeSecurity Lib "OLE32.DLL" ( _
pSD As Any, _
ByVal cAuthSvc As Long, _
asAuthSvc As Long, _
pReserved1 As Any, _
ByVal dwAuthnLevel As Long, _
ByVal dwImpLevel As Long, _
ByVal pAuthInfo As Long, _
ByVal dwCapabilities As Long, _
pvReserved2 As Any _
) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, ByVal Length As Long)
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" _
(ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Private Declare Sub CopyMemoryWrite Lib "kernel32" Alias _
"RtlMoveMemory" (ByVal Destination As Long, _
Source As Any, ByVal Length As Long)
Private Declare Sub CopyMemoryRead Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, _
ByVal Source As Long, ByVal Length As Long)
Sub Main()
Dim AuthInfo As COAUTHINFO
Dim AuthIdentity As COAUTHIDENTITY
Dim AuthList As COAUTHLIST
Dim hr As Long
Dim Context As Long
Dim pAuthIdentity As Long
Dim pAuthInfo As Long
Dim pAuthList As Long
Dim hHeap As Long
Dim strUser As String
Dim strPassword As String
Dim strDomain As String
Dim lngHr As Long
Dim lngAuthn As Long
hHeap = GetProcessHeap()
strUser = StrConv("UserName", vbUnicode)
strPassword = StrConv("Password", vbUnicode)
strDomain = ""
With AuthIdentity
.User = strUser
.UserLength = LenB(strUser)
.Password = strPassword
.PasswordLength = LenB(strPassword)
.Domain = strDomain
.DomainLength = LenB(strDomain)
.Flags = SEC_WINNT_AUTH_IDENTITY_UNICODE
End With
pAuthIdentity = HeapAlloc(hHeap, _
0, _
Len(AuthIdentity))
CopyMemoryWrite pAuthIdentity, _
AuthIdentity, _
Len(AuthIdentity)
With AuthInfo
.dwAuthnSvc = RPC_C_AUTHN_GSS_KERBEROS
.dwAuthzSvc = RPC_C_AUTHZ_NONE
.pAuthIdentityData = pAuthIdentity
End With
pAuthInfo = HeapAlloc(hHeap, _
0, _
Len(AuthInfo))
CopyMemoryWrite pAuthInfo, _
AuthInfo, _
Len(AuthInfo)
With AuthList
.dwAuthList = 1
.pAuthList = pAuthInfo
End With
pAuthList = HeapAlloc(hHeap, _
0, _
Len(AuthList))
CopyMemoryWrite pAuthList, _
AuthList, _
Len(AuthList)
lngAuthn = RPC_C_AUTHN_DEFAULT
lngHr = CoInitializeSecurity(ByVal API_NULL, -1, _
ByVal API_NULL, ByVal API_NULL, _
RPC_C_AUTHN_LEVEL_NONE, RPC_C_IMP_LEVEL_IMPERSONATE, _
pAuthList, EOAC_NONE, ByVal API_NULL)
If (S_OK <> lngHr) Then
MsgBox "CoInitializeSecurity failed with error code: 0x" _
& Trim$(str$(Hex(lngHr))), vbCritical, _
"Application Initialization Failure"
Exit Sub
End If
Exit Sub
Submit an article or tip