智能卡与入门Excel 78中的ISO 7816(SCardEstablishContext) [英] Getting started with smartcard & ISO 7816 in excel vba ( SCardEstablishContext )
问题描述
我刚刚收到了标准的廉价 usb智能卡读卡器.
I just received a standard cheap usb smartcard reader.
我正在尝试找出如何在excel中使用VBA与之进行交互.
I'm trying to find out how to interact with it using VBA in excel.
-我是在尝试在工作簿中创建基本智能卡功能时写的.我认为在某个时候我会被卡住(而且确实做到了).如果我没有卡住，我将更新此问题，直到达到在excel中使用智能卡的目标为止.
-- I wrote this as I attempted to create basic smartcard functionality in a workbook. I figured at some point I would get stuck (and I did). If I get unstuck I will update this question until I reach my goal of working smartcard in excel.
TL; DR此时调用函数SCardListReaders时错误为错误的DLL调用约定"
TL;DR at this point the error is "Bad DLL calling convention" when calling function SCardListReaders
智能卡是由读卡器提供动力的微控制器，如AT88SC1608R.
Smartcards are microcontrollers like AT88SC1608R powered by the reader.
有一个标准的Windows界面，用于与围绕winscard.dll的读者打交道.
There is a standard windows interface for dealing with the readers centered around winscard.dll.
某些文档在此处"
After some research, it seems that the first thing to do is to receive a handle to a "resource manager context" using the function SCardEstablishContext. 此上下文"对象具有作用域"(USER或SYSTEM).这些由两个常量SCARD_SCOPE_USER和SCARD_SCOPE_SYSTEM选择. This "context" object has "scopes", USER or SYSTEM. These are selected by the two constants SCARD_SCOPE_USER and SCARD_SCOPE_SYSTEM. 从此线程中，似乎SCARD_SCOPE_USER = 1和SCARD_SCOPE_SYSTEM = 2.我不知道这些值是否已签名.同样根据此页面，USER的值可能为0 From this thread , it seems that SCARD_SCOPE_USER = 1 and SCARD_SCOPE_SYSTEM = 2 . I don't know if these values are signed. Also according to this page, the value of USER might be 0. 因此，我尝试创建一些代码以使用SCard EstablishmentContext&SCardReleaseContext如下. So, I have attempted to create some code to use SCardEstablishContext & SCardReleaseContext as follows. 运行此代码将返回 使用十进制到十六进制转换器，我发现此-2146435055的十六进制值为FFFFFFFF80100011，并根据此图表 Using a decimal to hex converter I found that the hex value of this -2146435055 is FFFFFFFF80100011 and according to this chart Authentication Return Values 第一个返回值将是 然后我尝试为SCARD_SCOPE_USER使用0值，并得到了更有希望的输出 I then tried using a value of 0 for SCARD_SCOPE_USER and got this more promising output 这可能正在起作用，所以继续进行下去，下一个功能似乎是SCardConnect，用于在读卡器中建立到卡的链接.此处成功的呼叫可能意味着整个系统正在运行. This might be working so moving on, the next function appears to be SCardConnect to establish a link to the card in the reader. A successful call here probably means the entire system is working. 我为SCardConnect创建了以下声明 I created the following declarations for SCardConnect Reviewing the documentation for SCardListReaders function I find that it does list this DLL, winscard.dll for this function 也有一行写着 所以我尝试在SCardListReaders的declation中添加一个"Alias"参数，现在声明就像这样 So I tried adding an "Alias" parameter to the declation for SCardListReaders and now the declaration is like this 运行此代码，我收到错误 Running this code I get the error 根据 VB文档，看来此错误通常是由错误地从Declare语句中省略或包括ByVal关键字". According to VB documentation it seems that this error is often caused by " incorrectly omitting or including the ByVal keyword from the Declare statement". 现在，我在SCardListReaders的声明中没有提到前面的内容，当我第一次尝试时，我将phContext声明为 Now I failed to mention something earlier, in the declaration for SCardListReaders, when I first tried it, I declared phContext as 由于这仅是输入，因此我认为它不必是ByRef.但是，当我这样做时，出现以下错误 Since this is an input only, I figured it didn't need to be ByRef.
However, when I did this I got the following error 所以我将行修改为 这会导致错误的DLL调用约定错误. Which leads to the Bad DLL calling convention error. 要尝试解决此问题，我现在替换 To attempt to resolve this, I now replace all instances of 与phContext只要 with
phContext As long 再给它一个机会 这给出了相同的错误的DLL调用约定"错误 This gives the same "Bad DLL calling convention" error 所以也许真的需要SCARDCONTEXT类型变量，然后再次查看它，我在某个时候将ReaderName的类型从Byte更改为String So perhaps it really needed that SCARDCONTEXT type variable and looking at it again, I changed the type of ReaderName from Byte to String at some point 所以我将类型声明改回 然后我将所有phContext改回为phContext作为SCARDCONTEXT，仍然出现错误的DLL调用约定"错误！ And I change back all phContext As long to phContext As SCARDCONTEXT and still I get the "Bad DLL calling convention" error !! 所以我回到了 SCardEstablishContext函数文档，以获取有关"LPSCARDCONTEXT phContext"的结构的线索 So I went back to the SCardEstablishContext function documentation for clues on the structure of that "LPSCARDCONTEXT phContext" 在这一点上，我陷入了困境，我找不到如何正确声明此SCARDCONTEXT类型的方法，或者这是否真的是我的错误. At this point I am stuck, I can't find how to properly declare this SCARDCONTEXT type or if that really is my error. 我希望您能找到我以前出过错的地方，也希望它能为在VBA中为其他人使用智能卡提供一些途径. I hope you can find where I went wrong before and I also hope that this charts some of the road to working with smartcards in VBA for others. 谢谢阅读，再见！ 下面是一些代码，要求用户选择智能卡并返回卡的名称. Here is some code that requests a user select a smartcard and returns the name of the card. 这篇关于智能卡与入门Excel 78中的ISO 7816(SCardEstablishContext)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！Public Declare Function SCardEstablishContext Lib "winscard.dll" (ByVal dwScope As Long, _
ByVal pvReserved1 As Long, _
ByVal pvReserved2 As Long, _
ByRef phContext As SCARDCONTEXT _
) As Long
Public Declare Function SCardReleaseContext Lib "winscard.dll" (ByRef phContext As SCARDCONTEXT) As Long
Public Type SCARDCONTEXT
CardContext1 As Long
ReaderName As Byte
End Type
Sub GetContext()
Dim lReturn As Long
Dim RSVD1 As Long, RSVD2 As Long
Dim myContext As SCARDCONTEXT
' Constants, maybe unsigned ?
Dim SCARD_SCOPE_USER As Long
Dim SCARD_SCOPE_SYSTEM As Long
SCARD_SCOPE_USER = 1
SCARD_SCOPE_SYSTEM = 2
lReturn = SCardEstablishContext(SCARD_SCOPE_USER, RSVD1, RSVD2, myContext)
Debug.Print lReturn
Debug.Print myContext.CardContext1 & " " & myContext.ReaderName
lReturn = SCardReleaseContext(myContext)
Debug.Print lReturn
End Sub
-2146435055
0 0
6
SCARD_E_INVALID_VALUE
0x80100011
One or more of the supplied parameter values could not be properly interpreted.
0
-855572480 0
6
Unicode and ANSI names
SCardListReadersW (Unicode) and SCardListReadersA (ANSI)
Public Declare Function SCardListReaders Lib "winscard.dll" _
Alias "SCardListReadersA" (ByRef phContext As SCARDCONTEXT, _
ByVal dwShareMode As Long, _
ByVal mszGroups As String, _
ByRef mszReaders As String, _
ByRef pcchReaders As Long _
) As Long
Run-time error '49':
Bad DLL calling convention
ByVal phContext As SCARDCONTEXT
Complile error:
User-defined type may not be passed ByVal
ByRef phContext As SCARDCONTEXT
phContext As SCARDCONTEXT
Public Type SCARDCONTEXT
CardContext1 As Long
ReaderName As Byte
End Type
推荐答案
Option Explicit
Option Compare Database
Private Const CRYPTUI_SELECT_LOCATION_COLUMN = 16
Private Const CERT_NAME_SIMPLE_DISPLAY_TYPE = 4
Private Const CERT_NAME_FRIENDLY_DISPLAY_TYPE = 5
Private Const CERT_EKU_EMAIL = "1.3.6.1.5.5.7.3.4"
Private Const CERT_EKU_LOGON = "1.3.6.1.4.1.311.20.2.2"
Public Enum CERT_USAGE
CERT_DATA_ENCIPHERMENT_KEY_USAGE = &H10
CERT_DIGITAL_SIGNATURE_KEY_USAGE = &H80
CERT_KEY_AGREEMENT_KEY_USAGE = &H8
CERT_KEY_CERT_SIGN_KEY_USAGE = &H4
CERT_KEY_ENCIPHERMENT_KEY_USAGE = &H20
CERT_NON_REPUDIATION_KEY_USAGE = &H40
CERT_OFFLINE_CRL_SIGN_KEY_USAGE = &H2
End Enum
Public Enum CERT_SELECT_MODE
SHOW_NO_SELECTION = 0
SHOW_ALL_ID_SELECT_LAST_LOGON = 1
SHOW_ID = 2
SHOW_LOGON = 3
SHOW_ALL_SELECT_LAST_LOGON = 4
SHOW_ALL = 5
SHOW_ADLS_FRIENDLY = 6
End Enum
Private Type CERT_REVOCATION_STATUS
cbSize As Long
dwIndex As Long
dwError As Long
dwReason As Long
fHasFreshnessTime As Boolean
dwFreshnessTime As Long
End Type
Private Type FILE_TIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type CRYPT_INTEGER_BLOB
cbData As Long
pbData As LongPtr
End Type
Private Type CRYPT_BIT_BLOB
cbData As Long
pbData() As Byte
cUnusedBits As Long
End Type
Private Type CRYPT_ALGORITHM_IDENTIFIER
pszObjId As LongPtr
Parameters As CRYPT_INTEGER_BLOB
End Type
Private Type CERT_PUBLIC_KEY_INFO
Algorithm As CRYPT_ALGORITHM_IDENTIFIER
PublicKey As CRYPT_BIT_BLOB
End Type
Private Type CERT_INFO
dwVersion As Long
SerialNumber As CRYPT_INTEGER_BLOB
SignatureAlgorithm As CRYPT_ALGORITHM_IDENTIFIER
Issuer As CRYPT_INTEGER_BLOB
NotBefore As Currency
NotAfter As Currency
Subject As CRYPT_INTEGER_BLOB
SubjectPublicKeyInfo As CERT_PUBLIC_KEY_INFO
IssuerUniqueId As CRYPT_BIT_BLOB
SubjectUniqueId As CRYPT_BIT_BLOB
cExtension As Long
rgExtension As LongPtr
End Type
Private Type CRYPTUI_SELECTCERTIFICATE_STRUCTA
dwSize As Long
hWndParent As LongPtr ' OPTIONAL*/
dwFlags As Long ' OPTIONAL*/
szTitle As String ' OPTIONAL*/
dwDontUseColumn As Long ' OPTIONAL*/
szDisplayString As String ' OPTIONAL*/
pFilterCallback As LongPtr ' OPTIONAL*/
pDisplayCallback As LongPtr ' OPTIONAL*/
pvCallbackData As LongPtr ' OPTIONAL*/
cDisplayStores As Long
rghDisplayStores As LongPtr
cStores As Long ' OPTIONAL*/
rghStores As LongPtr ' OPTIONAL*/
cPropSheetPages As Long ' OPTIONAL*/
rgPropSheetPages As LongPtr ' OPTIONAL*/
hSelectedCertStore As LongPtr ' OPTIONAL*/
End Type
Public Type Cert_Context
dwCertEncodingType As Long
pbCertEncoded() As Byte
cbCertEncoded As Long
pCertInfo As LongPtr
hCertStore As LongPtr
End Type
Private Declare PtrSafe Function CryptUIDlgSelectCertificateFromStore Lib _
"Cryptui.dll" ( _
ByVal hCertStore As LongPtr, _
ByVal hWnd As LongPtr, _
ByVal pwszTitle As String, _
ByVal pwszDisplayString As String, _
ByVal dwDontUseColumn As Long, _
ByVal dwFlags As Long, _
ByVal pvReserved As Any _
) As LongPtr
Private Declare PtrSafe Function CryptUIDlgSelectCertificate Lib _
"Cryptui.dll" Alias "CryptUIDlgSelectCertificateW" ( _
ByRef pcsc As CRYPTUI_SELECTCERTIFICATE_STRUCTA _
) As LongPtr
Private Declare PtrSafe Function CryptUIDlgSelectCertificate2 Lib _
"Cryptui.dll" Alias "CryptUIDlgSelectCertificateW" ( _
ByRef pcsc As CRYPTUI_SELECTCERTIFICATE_STRUCTA _
) As Cert_Context
Private Declare PtrSafe Function CertOpenSystemStore Lib _
"crypt32.dll" Alias "CertOpenSystemStoreA" ( _
ByVal hProv As LongPtr, _
ByVal szSubsystemProtocol As String _
) As LongPtr
Private Declare PtrSafe Function CertEnumCertificatesInStore Lib _
"crypt32.dll" ( _
ByVal hCertStore As LongPtr, _
ByVal pPrevCertContext As LongPtr _
) As LongPtr
Private Declare PtrSafe Function CertGetNameString Lib _
"crypt32.dll" Alias "CertGetNameStringW" ( _
ByVal pCertContext As LongPtr, _
ByVal dwType As Long, _
ByVal dwFlags As Long, _
pvTypePara As Any, _
ByVal pszNameString As LongPtr, _
ByVal cchNameString As Long _
) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cbCopy As Long)
Private Function GetNameString(hCert_Context As LongPtr, Friendly As Boolean) As String
Dim nPtr As LongPtr, bPtr As LongPtr
Dim strNameString As String
Dim szNameString As Long
Dim nullBfr As String
Dim constType As Long
On Error GoTo erh
If Friendly = True Then
constType = CERT_NAME_FRIENDLY_DISPLAY_TYPE
Else
constType = CERT_NAME_SIMPLE_DISPLAY_TYPE
End If
nullBfr = String(1, vbNullChar)
nPtr = StrPtr(nullBfr)
szNameString = CertGetNameString(hCert_Context, _
constType, _
0&, _
0, _
nPtr, _
0& _
)
If szNameString = 1 Then Err.Raise 4004, , "Certificate name contains no data."
strNameString = String(szNameString, vbNullChar)
bPtr = StrPtr(strNameString)
szNameString = CertGetNameString(hCert_Context, _
constType, _
0&, _
0&, _
bPtr, _
szNameString& _
)
GetNameString = Mid(strNameString, 1, szNameString - 1)
strNameString = String(szNameString, vbNullChar)
Exit Function
erh:
Debug.Print "SCard::Error getting certificate name: " + _
Err.Description
End Function
Private Function GetCertificate(Optional bSelect As Boolean = False, _
Optional bShowInfo As Boolean = False, _
Optional CertMode As CERT_SELECT_MODE = SHOW_LOGON, _
Optional ByRef CertStore As LongPtr, _
Optional NoCache As Boolean = False, _
Optional bSelectFirst As Boolean = False, _
Optional CertSelectPrompt As String = "") _
As LongPtr
Dim hCert_Context As LongPtr
Dim rghSystemStore As LongPtr
Dim pszStoreName As String
Dim pcsc As CRYPTUI_SELECTCERTIFICATE_STRUCTA
Dim CertType As String, CertUsage As CERT_USAGE
Dim PFNCOption As Long
Dim CertCheckEKU As Boolean
Dim strPrompt As String
On Error GoTo erh
Select Case CertMode
Case CERT_SELECT_MODE.SHOW_ALL_ID_SELECT_LAST_LOGON
'///OPTION 1: SHOW ALL ID CERTS AND SELECT LAST LOGON CERT
CertType = CERT_EKU_LOGON
CertCheckEKU = True
PFNCOption = 1
Case CERT_SELECT_MODE.SHOW_ID '///OPTION 2: SHOW JUST ID CERTS
CertType = CERT_EKU_EMAIL
CertCheckEKU = True
PFNCOption = 2
Case CERT_SELECT_MODE.SHOW_LOGON '///OPTION 3: SHOW ONLY LOGON CERTS
CertType = CERT_EKU_LOGON
CertCheckEKU = True
PFNCOption = 3
Case CERT_SELECT_MODE.SHOW_ALL_SELECT_LAST_LOGON
'///OPTION 4: SHOW ALL CERTS, SELECT LAST LOGON CERT
bSelect = True
CertType = CERT_EKU_LOGON
CertCheckEKU = True
PFNCOption = 4
Case CERT_SELECT_MODE.SHOW_ALL '///OPTION 5: SHOW ALL CERTS
bSelect = True
PFNCOption = 5
Case CERT_SELECT_MODE.SHOW_ADLS_FRIENDLY
'///OPTION 5: SHOW CERTS with digital signature
' and no secure email EKU
bSelect = False
CertUsage = CERT_DIGITAL_SIGNATURE_KEY_USAGE
CertCheckEKU = False
PFNCOption = 6
End Select
If CertSelectPrompt = "" Then
strPrompt = "Select a certificate."
Else
strPrompt = CertSelectPrompt
End If
'open the personal certificate store
pszStoreName = "MY"
rghSystemStore = CertOpenSystemStore(0&, pszStoreName)
If rghSystemStore = 0 Then Err.Raise 4001, , "Failed to open the certificate store."
CertStore = rghSystemStore
hCert_Context = 0
If GETTEMP("CACHED_CERT") <> "" And NoCache = False Then
Do
hCert_Context = CertEnumCertificatesInStore(rghSystemStore, _
hCert_Context)
If GetSerialNumberAndHash(hCert_Context) = _
GETTEMP("CACHED_CERT") Then
GetCertificate = hCert_Context
Exit Function
End If
Loop Until hCert_Context = 0&
End If
'///OPTIONS FOR CERTIFICATE SELECTION:
'////OPTION 1: SHOW SELECTION DIALOG OF LOGON CERTIFICATES
If bSelect Then
select_cert:
pcsc.dwSize = LenB(pcsc)
pcsc.rghDisplayStores = VarPtr(rghSystemStore)
pcsc.cDisplayStores = 1
pcsc.szTitle = StrConv("Please select a certificate:", vbUnicode)
pcsc.szDisplayString = StrConv("", vbUnicode)
pcsc.dwDontUseColumn = CRYPTUI_SELECT_LOCATION_COLUMN
pcsc.pFilterCallback = GetCallBack(AddressOf PFNCFILTERPROC)
pcsc.pvCallbackData = VarPtr(PFNCOption)
pcsc.dwFlags = 0&
pcsc.hWndParent = Application.hWndAccessApp
hCert_Context = CryptUIDlgSelectCertificate(pcsc)
Else
'////OPTION 2:SELECT LOGON CERTIFICATE IN STORE BY DEFAULT
If bSelectFirst Then
Do
hCert_Context = CertEnumCertificatesInStore(rghSystemStore, _
hCert_Context)
If CertCheckEKU Then
If GetCertificateEKU(hCert_Context, CertType) Then Exit Do
Else
If GetCertificateUsage2(hCert_Context, CertUsage) Then Exit Do
End If
Loop Until hCert_Context = 0&
ElseIf (CertCheckEKU And (CountOfCertificatesByEKU(CertType) <> 1)) And Not bSelectFirst Then
GoTo select_cert
ElseIf (Not CertCheckEKU And (CountOfCertificatesByUsage(CertUsage) <> 1)) And Not bSelectFirst Then
GoTo select_cert
End If
End If
If hCert_Context = 0& Then Err.Raise 4002, , _
"Failed to acquire a valid certificate context or the " + _
"user pressed cancel."
'///END OPTIONS
GetCertificate = hCert_Context
Exit Function
erh:
Debug.Print "DB_SCard::Error while getting certificate: " + _
Err.Description
GetCertificate = 0
End Function
Private Function GetSerialNumberAndHash(hContext As LongPtr) As String
On Error GoTo erh
GetSerialNumberAndHash = StrConv(CertGetProperty(hContext, CERT_ISSUER_SERIAL_NUMBER_MD5_HASH_PROP_ID), vbUnicode)
Exit Function
erh:
Debug.Print _
"DB_SCard::Error while retrieving serial number and hash: " + _
Err.Description
End Function
Private Function GetCallBack(funcAddr As LongPtr) As LongPtr
GetCallBack = funcAddr
End Function
Private Function GetCertificateUsage2(ByRef cContext As LongPtr, Usage As CERT_USAGE) As Boolean
Dim pbKeyUsage As LongPtr
Dim oBfr As Long
Dim rtn As Boolean
Dim bBfr(0 To 7) As Boolean
Dim GLE As Long
Dim certcontext As Cert_Context
Dim certinfo As CERT_INFO
On Error Resume Next
If cContext <> 0 Then
CopyMemory VarPtr(certcontext), cContext, LenB(certcontext)
End If
If certcontext.pCertInfo <> 0 Then
CopyMemory VarPtr(certinfo), certcontext.pCertInfo, LenB(certinfo)
End If
pbKeyUsage = VarPtr(oBfr)
rtn = CertGetIntendedKeyUsage(X509_ASN_ENCODING, _
VarPtr(certinfo), _
pbKeyUsage, _
4& _
)
GLE = Err.LastDllError
If rtn Then
BitBreak oBfr, bBfr
If bBfr(Log2(Usage)) = True Then GetCertificateUsage2 = True
ElseIf oBfr = 0 Then
GetCertificateUsage2 = False
Else
Debug.Print _
"DB_SCard::Error getting certificate usage: " + GLEtx(GLE)
End If
End Function
Private Function GetCertificateEKU(ByVal pContext As LongPtr, eUsage As String) As Boolean
Dim oBfr As CERT_ENHKEY_USAGE
Dim oBfrsz As Long
Dim rtn As Boolean
Dim iter1 As Long
Dim nArray() As Variant
Dim GLE As Long
On Error Resume Next
If pContext = 0 Then Exit Function
oBfrsz = Len(oBfr)
rtn = CertGetEnhancedKeyUsage(pContext, 0&, VarPtr(oBfr), VarPtr(oBfrsz))
GLE = Err.LastDllError
If rtn Then
If oBfr.cUsageIdentifier = 0 Then
GetCertificateEKU = False
Else
nStrToArray StrConv(oBfr.rgpszUsageIdentifier, vbUnicode), nArray
For iter1 = 1 To UBound(nArray)
If eUsage = nArray(iter1) Then If VerifyRevocation(pContext) Then GetCertificateEKU = True
Next iter1
End If
Else
Debug.Print _
"DB_SCard::Error getting enhanced certificate usage: " + GLEtx(GLE)
End If
End Function
Public Function PFNCFILTERPROC( _
ByRef pCertContext As Cert_Context, _
ByVal pfInitialSelectedCert As Long, _
ByVal pvCallbackData As LongPtr _
) As Long
Dim certName As String
certName = GetNameString(VarPtr(pCertContext), True)
If Right(certName, 10) = Left(Environ("username"), 10) Then
PFNCFILTERPROC = 1
Else
PFNCFILTERPROC = 0
End If
End Function
Private Function CountOfCertificatesByEKU(ByVal Usage As String) As Long
Dim hCert_Context As LongPtr
Dim rghSystemStore As LongPtr
Dim pszStoreName As String
Dim CT As Long
On Error GoTo erh
pszStoreName = "MY"
rghSystemStore = CertOpenSystemStore(0&, pszStoreName)
If rghSystemStore = 0 Then Err.Raise 4001, , "Failed to open the certificate store."
hCert_Context = 0
CT = 0
Do Until hCert_Context = 0
hCert_Context = CertEnumCertificatesInStore(rghSystemStore, _
hCert_Context)
If GetCertificateEKU(hCert_Context, Usage) Then CT = CT + 1
Loop
Debug.Print "DB_SCard::Count of certificates matching EKU " + Usage; ": " '+ cstr(CT)
CountOfCertificatesByEKU = CT
out:
CertFreeCertificateContext hCert_Context
CertCloseStore rghSystemStore, 0&
Exit Function
erh:
Debug.Print _
"DB_SCard::Error while enumerating certificates by EKU: " + _
Err.Description
GoTo out
End Function
Private Function CountOfCertificatesByUsage(ByVal Usage As CERT_USAGE) As Long
Dim hCert_Context As LongPtr
Dim rghSystemStore As LongPtr
Dim pszStoreName As String
Dim CT As Long
On Error GoTo erh
pszStoreName = "MY"
rghSystemStore = CertOpenSystemStore(0&, pszStoreName)
If rghSystemStore = 0 Then Err.Raise 4001, , "Failed to open the certificate store."
hCert_Context = 0
CT = 0
Do Until hCert_Context = 0
hCert_Context = CertEnumCertificatesInStore(rghSystemStore, _
hCert_Context)
If GetCertificateUsage2(hCert_Context, Usage) Then CT = CT + 1
Loop
CountOfCertificatesByUsage = CT
out:
CertFreeCertificateContext hCert_Context
CertCloseStore rghSystemStore, 0&
Exit Function
erh:
Debug.Print _
"DB_SCard::Error while enumerating certificates by usage: " + Err.Description
GoTo out
End Function
Public Function GetLongFromPointer(ByVal lPointer As LongPtr) As Long
On Error Resume Next
Dim outLng As Long
If lPointer > 0 Then CopyMemory VarPtr(outLng), lPointer, 4
GetLongFromPointer = outLng
End Function
Public Function GetCertFromContext(ByVal hCert_Context As LongPtr) As Cert_Context
On Error Resume Next
Dim pcc As Cert_Context
CopyMemory VarPtr(pcc), hCert_Context, LenB(pcc)
GetCertFromContext = pcc
End Function
Private Function GETTEMP(ByVal testIt As String) As String
GETTEMP = ""
End Function
Private Function GLEtx(GLE) As String
GLEtx = CStr(GLEtx)
End Function
Public Function testCert() As LongPtr
Dim rghSystemStore As LongPtr, pszStoreName As String, CertStore As LongPtr, hCert_Context As LongPtr, emptyS As LongPtr
pszStoreName = "MY"
rghSystemStore = CertOpenSystemStore(emptyS, pszStoreName)
testCert = GetCertificate(True, False, 3, rghSystemStore, True, False, "Please choose a certificate to use")
End Function
Public Function testFuncs() As String
Dim blargh As Long
blargh = testCert
testFuncs = GetNameString(blargh, True)
End Function
