VB6 program - Crypto Failure Trying to Create Container.

  • Thread starter Thread starter DrShell
  • Start date Start date
D

DrShell

I'm hoping someone here can help me on this...if not, please direct me
to a group that can.

I've got a VB6 program that uses the Windows Cryptographic Provider in
Win2K. In it's upgrades I've taken it up through XP and into Vista.
It was, until Vista, a very stable program. Now it fails to create
the Key Container. I've had the user run in Administrator to attempt
to give the program the authority it needs to do this, but it still
fails.

I don't have Vista on my development system (or any of my systems for
that matter), so I can't walk through the code to see what's
happening.

Can someone take a look at my code and see if there is anything wrong?
Thanks in advance for any help.

The following code uses:
o abKeyCon is a Byte Array with the Container name
o abSerPro is a Byte Array with the value
"Microsoft Enhanced Cryptographic Provider v1.0"
Note: Both of these arrays are converted from Unicode strings and have
chr(0) as a terminator.

Failure occurs on the CryptAcquireContext and is handled, with error
code, back to the calling part of the program. There is no
err.LastDllError so I have no idea what is causing the problem.

Watch for line wrap ;-)

_____________Start_Code_________________
Public Property Let KeyContainerName(strKeyConName As String)

lngLastError = 0
If Len(strKeyConName) > 0 Then
ReDim abKeyCon(Len(strKeyConName))
abKeyCon = StrConv(strKeyConName, vbFromUnicode) & vbNullChar
Else
ReDim abKeyCon(0)
abKeyCon(0) = vbNullChar
End If
End Property

Public Sub SessionEnd()

If hSessionKey <> 0 Then CryptDestroyKey hSessionKey
If hKeyPair <> 0 Then CryptDestroyKey hKeyPair
If hCryptProv <> 0 Then CryptReleaseContext hCryptProv, 0
End Sub

Public Function SessionStart(Optional sKeyCon As String, Optional
bFresh As Boolean = False) As Boolean
Dim lngReturnValue As Long

SessionEnd
lngLastError = 0
KeyContainerName = sKeyCon
If bFresh Then
lngReturnValue = CryptAcquireContext( _
hCryptProv, abKeyCon(0), abSerPro(0), PROV_RSA_FULL,
CRYPT_DELETEKEYSET _
)
If lngReturnValue = 0 Then Err.Clear
lngReturnValue = CryptAcquireContext( _
hCryptProv, abKeyCon(0), abSerPro(0), PROV_RSA_FULL,
CRYPT_NEWKEYSET _
)
If lngReturnValue = 0 Then
lngLastError = Err.LastDllError
Exit Function
End If
Else
lngReturnValue = CryptAcquireContext( _
hCryptProv, abKeyCon(0), abSerPro(0), PROV_RSA_FULL,
CRYPT_EXISTINGKEYSET _
)
If lngReturnValue = 0 Then
Err.Clear
lngReturnValue = CryptAcquireContext( _
hCryptProv, abKeyCon(0), abSerPro(0), PROV_RSA_FULL,
CRYPT_NEWKEYSET _
)
If lngReturnValue = 0 Then
lngLastError = Err.LastDllError
Exit Function
End If
End If
End If
SessionStart = True
End Function
_____________End Code________________
 
Just to follow up on this post. I've determined that the Crypto code
was not in error. The culprit has not, as yet, been determined. But,
it is my assumtion that a virus/security program is blocking the calls
to the Crypto provider.

This assumtion is made due to the subject computer flagging a small
Crypto test program, I attempted to run on the system, as a virus.

The program has been installed on another system, by the user, and it
ran without a problem.

A big thanks to anyone who spent time looking this problem over. The
user is now trying to determine the problem concerning the virus
program on his system.

Regards,
Shell
 
Back
Top