Cómo extraer mediante programación CDP, AIA y URL de OCSP de un certificado digital

437 views

Skip to first unread message

Roman Koltsov

unread,

Aug 21, 2019, 3:51:40 AM8/21/19

to Comunidad de Visual Foxpro en Español

Hola amigos

El otro día, intenté extraer mediante programación las URL de CDP, AIA y OCSP de un certificado digital usando CryptoAPI.

Los materiales sobre este tema están presentes en la red por enlaces:

1) https://www.sysadmins.lv/blog-en/how-to-programmatically-extract-cdp-aia-and-ocsp-urls-from-a-digital-certificate.aspx

2) https://www.sevecek.com/Lists/Posts/Post.aspx?ID=287

3) https://www.winehq.org/pipermail/wine-cvs/2009-December/062848.html https://www.sevecek.com/Lists/Posts/Post.aspx?ID=287

Para lograr el objetivo, debe usar la función CryptGetObjectUrl

* Constants for use with CryptoAPI function CryptGetObjectUrl
* to programmatically extract CRL list distribution point from a digital certificate (CDP)
* AIA extension - Authority Information Access contains AIA records and possibly even the OCSP URL (OID '1.3.6.1.5.5.7.1.1')
#DEFINE URL_OID_CERTIFICATE_ISSUER                    1  && AIA: $urlType = URL_OID_CERTIFICATE_ISSUER
* CDP extension - CRL Distribution Points (OID '2.5.29.31')
#DEFINE URL_OID_CERTIFICATE_CRL_DIST_POINT            2  && CRL: $urlType = URL_OID_CERTIFICATE_CRL_DIST_POINT
#DEFINE URL_OID_CTL_ISSUER                            3
#DEFINE URL_OID_CTL_NEXT_UPDATE                       4
#DEFINE URL_OID_CRL_ISSUER                            5
#DEFINE URL_OID_CERTIFICATE_FRESHEST_CRL              6
#DEFINE URL_OID_CRL_FRESHEST_CRL                      7
#DEFINE URL_OID_CROSS_CERT_DIST_POINT                 8
#DEFINE URL_OID_CERTIFICATE_OCSP                      9
#DEFINE URL_OID_CERTIFICATE_OCSP_AND_CRL_DIST_POINT   10
#DEFINE URL_OID_CERTIFICATE_CRL_DIST_POINT_AND_OCSP   11
#DEFINE URL_OID_CROSS_CERT_SUBJECT_INFO_ACCESS        12
#DEFINE URL_OID_CERTIFICATE_ONLY_OCSP                 13 && OCSP: $urlType = URL_OID_CERTIFICATE_ONLY_OCSP

#DEFINE CRYPT_GET_URL_FROM_PROPERTY                   1
#DEFINE CRYPT_GET_URL_FROM_EXTENSION                  2  && 0x2
#DEFINE CRYPT_GET_URL_FROM_UNAUTH_ATTRIBUTE           3
#DEFINE CRYPT_GET_URL_FROM_AUTH_ATTRIBUTE             8

Declaración de función en VisualBasic:

Declare Function CryptGetObjectUrl Lib "cryptnet.dll" ( _
                 ByVal pszUrlOid As String, _
                 pvPara As Any, _
                 ByVal dwFlags As Long, _
                 ByRef pUrlArray As PCRYPT_URL_ARRAY, _
                 ByRef pcbUrlArray As Long, _
                 ByRef pUrlInfo As PCRYPT_URL_INFO, _
                 ByRef pcbUrlInfo As Long, _
                 pvReserved As Any) As Long

Declaración de función en С#:

$signature = @"
[DllImport("cryptnet.dll", CharSet = CharSet.Auto, SetLastError = true)]
public static extern bool CryptGetObjectUrl(
    int pszUrlOid,
    IntPtr pvPara,
    int dwFlags,
    byte[] pUrlArray,
    ref int pcbUrlArray,
    IntPtr pUrlInfo,
    ref int pcbUrlInfo,
    int pvReserved
);
"@

Las siguientes constantes se pasan a la función CryptGetObjectUrl

- En el primer parámetro pszUrlOid: URL_OID_CERTIFICATE_ISSUER (de la extensión AIA) y URL_OID_CERTIFICATE_OCSP_AND_CRL_DIST_POINT
- El segundo parámetro pvPara para URL_OID_CERTIFICATE_CRL_DIST_POINT pasa un puntero a la estructura CERT_CONTEXT del certificado, cuyas URL de punto de distribución OCSP y CRL se solicitan, es decir. pvPara = pCertContext
- En el tercer parámetro, dwFlags, debe especificar la constante CRYPT_GET_URL_FROM_EXTENSION con un valor de 0x2 para especificar la función para extraer las URL de la extensión del certificado.

- El cuarto parámetro, pUrlArray, contendrá "byte array with little-endian in Unicode".

- El quinto parámetro pcbUrlArray contendrá el número de bytes en que consiste "byte array" devuelta en el parámetro pUrlArray.

- Los parámetros restantes no se utilizan para nuestra tarea.

Descripción de función en FoxPro:

DECLARE INTEGER CryptGetObjectUrl IN cryptnet;
    STRING  @ pszUrlOid,;     && _In_       STRING OR INTEGER??? 
    INTEGER   pvPara,;        && _In_
    INTEGER   dwFlags,;       && _In_
    LONG    @ pUrlArray,;     && _Out_      PCRYPT_URL_ARRAY  && OR STRING @ pUrlArray?   pUrlArray will contains a byte array that represents little-endian Unicode strings
    LONG    @ pcbUrlArray,;   && _Inout_    DWORD *,          pcbUrlArray will contain a number of bytes to use for pUrlArray byte array
    LONG    @ pUrlInfo,;      && _Out_      PCRYPT_URL_INFO,  not required for our task
    LONG    @ pcbUrlInfo,;    && _Inout_    DWORD *,          not required for our task
    INTEGER   pvReserved      && _reserved_ LPVOID,           not required for our task

El enlace n. ° 3 utiliza otros parámetros distintos de los descritos en MSDN:
https://www.winehq.org/pipermail/wine-cvs/2009-December/062848.html https://www.sevecek.com/Lists/Posts/Post.aspx?ID=287

¡Esta característica no funciona para mí!

pcbUrlArray = 0
pszUrlOid = BINTOC(2, "4RS") + Ñhr(0)
ret = CryptGetObjectUrl(@pszUrlOid, pCertContext, 0, NULL, @pcbUrlArray, NULL, NULL, NULL)
If ret = 0
    lnResultCode = GetLastError()
    lcErr = "Error by calling CryptGetObjectUrl"
    =MessageBox(lcErr,16,"Error: " + Transform(lnResultCode,"@0"))
Else
    pUrlArray = LocalAlloc(0x0040, m.pcbUrlArray)  && Pointer to structure CRYPT_URL_ARRAY
    * https://www.winehq.org/pipermail/wine-cvs/2009-December/062848.html
    If !CryptGetObjectUrl(URL_OID_CERTIFICATE_CRL_DIST_POINT, pCertContext, 0, pUrlArray, @pcbUrlArray, NULL, NULL, NULL)=0
          nBufSize=0  
          = CryptBinaryToString(@m.pUrlArray, Len(m.pUrlArray), CRYPT_STRING_BINARY, NULL, @nBufSize)  && CRYPT_STRING_BINARY = 0x00000002
          lcCDP_URL = REPLICATE(CHR(0), m.nBufSize)  
          If !CryptBinaryToString(@m.pUrlArray, Len(m.pUrlArray), CRYPT_STRING_BINARY, @lcCDP_URL, @nBufSize) = 0
            If !Empty(hFile)
                lcStr = "CRL List URL: " + AllT(lcCDP_URL)
                FPuts(hFile, lcStr)
            EndIf
        Else
            =MessageBox("Can't to retrieve CRL List URL from Certificate!",16,"Error")
        EndIf
    Else
        =MessageBox("Cant't to obtain CRL point address!",16,"Error")
    EndIf
    LocalFree(pUrlInfo)
    LocalFree(pUrlArray)
EndIf

Creo que el problema está en el primer parámetro.

¿Quizás alguien tendrá pensamientos sobre cómo hacer que funcione?

P.S.: Yo uso Windows 7 de 64 bits, Russian

Saludos cordiales

Roman

Roman Koltsov

unread,

Aug 21, 2019, 4:12:19 AM8/21/19

to Comunidad de Visual Foxpro en Español


* https://docs.microsoft.com/en-us/windows/win32/api/wincrypt/nf-wincrypt-cryptbinarytostringa
* Constants for third parameter of CryptBinaryToStringA function
#DEFINE CRYPT_STRING_BASE64HEADER           0x00000000  && Base64, with certificate beginning and ending headers
#DEFINE CRYPT_STRING_BASE64                 0x00000001  && Base64, without headers
#DEFINE CRYPT_STRING_BINARY                 0x00000002  && Pure binary copy
#DEFINE CRYPT_STRING_BASE64REQUESTHEADER    0x00000003  && Base64, with request beginning and ending headers
#DEFINE CRYPT_STRING_HEX                    0x00000004  && Hexadecimal only
#DEFINE CRYPT_STRING_HEXASCII               0x00000005  && Hexadecimal, with ASCII character display
#DEFINE CRYPT_STRING_BASE64X509CRLHEADER    0x00000009  && Base64, with X.509 CRL beginning and ending headers
#DEFINE CRYPT_STRING_HEXADDR                0x0000000A  && Hexadecimal, with address display
#DEFINE CRYPT_STRING_HEXASCIIADDR           0x0000000B  && Hexadecimal, with ASCII character and address display
#DEFINE CRYPT_STRING_HEXRAW                 0x0000000C  && A raw hexadecimal string. Windows Server 2003 and Windows XP:  This value is not supported
#DEFINE CRYPT_STRING_STRICT                 0x20000000  && Enforce strict decoding of ASN.1 text formats. Some ASN.1 binary BLOBS can have the first few bytes of the BLOB incorrectly interpreted as Base64 text. In this case, the rest of the text is ignored. Use this flag to enforce complete decoding of the BLOB. Windows Server 2008, Windows Vista, Windows Server 2003 and Windows XP: This value is not supported
* In addition to the values above, one or more of the following values can be specified to modify the behavior of the function
#DEFINE CRYPT_STRING_NOCRLF                 0x40000000  && Do not append any new line characters to the encoded string. The default behavior is to use a carriage return/line feed (CR/LF) pair (0x0D/0x0A) to represent a new line. Windows Server 2003 and Windows XP:  This value is not supported
#DEFINE CRYPT_STRING_NOCR                   0x80000000  && Only use the line feed (LF) character (0x0A) for a new line. The default behavior is to use a CR/LF pair (0x0D/0x0A) to represent a new line

DECLARE INTEGER CryptBinaryToString IN Crypt32;  
      STRING @pbBinary,;
      LONG cbBinary,;
      LONG dwFlags,;
      STRING @pszString,;
      LONG @pcchString

DECLARE INTEGER GlobalAlloc IN kernel32;
    INTEGER wFlags,;
    INTEGER dwBytes

DECLARE INTEGER GlobalFree IN kernel32;
    INTEGER hMem

DECLARE INTEGER LocalAlloc IN kernel32;
    INTEGER uFlags,;
    INTEGER uBytes

DECLARE INTEGER LocalFree IN kernel32;
    INTEGER hMem

Fernando Mora

unread,

Aug 21, 2019, 12:23:51 PM8/21/19

to Comunidad de Visual Foxpro en Español

Hola Roman, si lo que deseas es obtener los URL de los puntos de distribución CRL y Acceso de información de entidad emisora, se puede obtener esos datos decodificando el certificado, accediendo directamente al array de OID's, este codigo yo uso para la decodificación de las estructuras antes mencionadas.


#DEFINE X509_ASN_ENCODING 		1  
#DEFINE PKCS_7_ASN_ENCODING 		0x00010000

CLEAR
=DeclarationsApi()
lnHandleStore = 0
lnHandleStore = CertOpenSystemStore(0, "MY")
IF lnHandleStore=0
	RETURN .F.
ENDIF
lpCertContext = 0
lpCertContext=CryptUIDlgSelectCertificateFromStore(lnHandleStore, 0, null, null, 1, 0, null)
IF lpCertContext=0
	RETURN .F.
ENDIF

lcOidValue = GetOidValues(lpCertContext, "2.5.29.31", "ARRAY")
? "ARRAY: ", lcOidValue 
?
?
lcOidValue = GetOidValues(lpCertContext, "2.5.29.31", "URL")
? "URL: ", STRTRAN(lcOidValue, "; ", CHR(10))
?
?
?
lcOidValue = GetOidValues(lpCertContext, "1.3.6.1.5.5.7.1.1", "ARRAY")
? "ARRAY: ", lcOidValue 
?
?
lcOidValue = GetOidValues(lpCertContext, "1.3.6.1.5.5.7.1.1", "URL")
? "URL: ", STRTRAN(lcOidValue, "; ", CHR(10))

PROCEDURE GetOidValues()
	PARAMETERS tpCertContext AS Long, tcOidName AS String, tcRequest AS String
	lcOidUrl = ""
	nExtensions = 0
	lcCertInfo = ""
	IF VARTYPE(tpCertContext)="N"
		lbCertInfo = SUBSTR(SYS(2600, tpCertContext, 20), 13, 4)
		lcCertInfo = SYS(2600, CTOBIN(lbCertInfo, "4RS"), 112)
	ENDIF
	IF !EMPTY(lcCertInfo)
		cBinaryOid  = SUBSTR(lcCertInfo ,105,8)
		nExtensions = CTOBIN(SUBSTR(cBinaryOid,1,4),"4RS")
		pRegExtens  = CTOBIN(SUBSTR(cBinaryOid,5,4),"4RS")	
	ENDIF
	IF nExtensions>0
		nLenReg=(nExtensions*16)
		cBlobExtensions = SYS(2600, pRegExtens, nLenReg)
		lpCertOid = CertFindExtension(tcOidName, nExtensions, cBlobExtensions)
		IF lpCertOid>0
			cOidBinary = SYS(2600, lpCertOid, 16)
			cOidName   = SYS(2600, CTOBIN(SUBSTR(cOidBinary,1,4), "4RS"), 32)
			nOidType   = CTOBIN(SUBSTR(cOidBinary,5,4), "4RS")
			nOidLenght = CTOBIN(SUBSTR(cOidBinary,9,4), "4RS")
			cOidValue  = SYS(2600, CTOBIN(SUBSTR(cOidBinary,13,4), "4RS"), nOidLenght)
			lcStructInfo = GetCryptDecodeObjectExString(tcOidName, cOidValue)
			IF !EMPTY(lcStructInfo)
				lcOidUrl = GetCryptDecodeToString(tcOidName, cOidValue, lcStructInfo, tcRequest)
			ENDIF
		ENDIF
	ENDIF
	RETURN lcOidUrl
ENDPROC

PROCEDURE GetCryptDecodeObjectExString()
	LPARAMETERS tc_Structure_Name AS String, tc_Structure_Binarys AS String
	DECLARE LONG CryptDecodeObjectEx IN Crypt32;
		LONG 	 dwCertEncodingType,;
		STRING	 lpszStructType,;
		STRING	 pbEncoded,;
		LONG 	 cbEncoded,;
		LONG 	 dwFlags,;
		STRING	 pDecodePara,;
		STRING	@pvStructInfo,;
		LONG 	@pcbStructInfo

	dwCertEncodingType = BITOR(PKCS_7_ASN_ENCODING, X509_ASN_ENCODING)
	lpszStructType = tc_Structure_Name
	pbEncoded = tc_Structure_Binarys
	cbEncoded = LEN(pbEncoded)
	pbKeyBlob = ""
	cbKeyBlob = 0
	nResp=CryptDecodeObjectEx(dwCertEncodingType, @lpszStructType, pbEncoded, cbEncoded, 0, NULL, NULL, @cbKeyBlob)
	IF cbKeyBlob>0
		pbKeyBlob = SPACE(cbKeyBlob)
		nResp=CryptDecodeObjectEx(dwCertEncodingType, @lpszStructType, pbEncoded, cbEncoded, 0, NULL, @pbKeyBlob, @cbKeyBlob)
	ENDIF
	RETURN pbKeyBlob
ENDPROC 

PROCEDURE GetCryptDecodeToString()
	LPARAMETERS tcExtension AS String, tcExtValue AS String, pvStructInfo AS String, tcRequest AS String
	lcReturnStr=""
	DO CASE
	CASE tcExtension="2.5.29.31"
		*----- Puntos de distribución CRL, CRL_DIST_POINTS_INFO
		lcReturnStr = GetStructure_CrlDistPoint(pvStructInfo, tcRequest)
	CASE tcExtension=="1.3.6.1.5.5.7.1.1"
		*----- Acceso a la infomración de entidad emisora (CERT_AUTHORITY_INFO_ACCESS)
		lcReturnStr = GetStructure_CertAuthorityInfoAccess(pvStructInfo, tcRequest)
	OTHERWISE
	ENDCASE
	RETURN lcReturnStr
ENDPROC

PROCEDURE GetStructure_CrlDistPoint()
	LPARAMETERS tcCrlDistPoint AS String, tcRequest AS String
	IF VARTYPE(tcCrlDistPoint)<>"C"
		RETURN ""
	ENDIF
	IF EMPTY(tcCrlDistPoint)
		RETURN ""
	ENDIF
	lcReturnURL = ""
	lcReturnCRL = "CRL distribution points: " + "; "
	*----- Número de elementos en la matriz de miembros rgDistPoint, CRL_DIST_POINTS_INFO(cDistPoint, rgDistPoint)
	nDistPoint  = CTOBIN(SUBSTR(tcCrlDistPoint,1,4), "4RS")
	rgDistPoint = CTOBIN(SUBSTR(tcCrlDistPoint,5,4), "4RS")
	nIniChr = 5
	nIniSub = (nDistPoint * 32)+5
	FOR nDP = 1 TO nDistPoint
		lcReturnCRL = lcReturnCRL + "[" + TRANSFORM(nDP) + "] CRL distribution point: " + "; "
		*----- CRL_DIST_POINT structure - CERT_ALT_NAME_INFO structure - CRL_DIST_POINT_NAME 
		nDistPointName = CTOBIN(SUBSTR(tcCrlDistPoint, nIniChr+4, 4), "4RS")
		nAltEntry = CTOBIN(SUBSTR(tcCrlDistPoint, nIniChr+8, 4), "4RS")
		rgAltEntry = STRCONV(SUBSTR(tcCrlDistPoint, nIniChr+12, 4), 15)
		nReasonFlags = CTOBIN(SUBSTR(tcCrlDistPoint, nIniChr+16, 4), "4RS")
		nCRLIssuer = CTOBIN(SUBSTR(tcCrlDistPoint, nIniChr+20, 4), "4RS")
		nDistPointNameChoice = CTOBIN(SUBSTR(tcCrlDistPoint, nIniChr+24, 4), "4RS")
		nFullName = CTOBIN(SUBSTR(tcCrlDistPoint, nIniChr+28, 4), "4RS")
		cUnusedBits = CTOBIN(SUBSTR(tcCrlDistPoint, nIniChr+32, 4), "4RS")
		DIMENSION aMatDistPoint(nAltEntry,2)
		nIniChr = nIniChr + 32
		FOR nAE = 1 TO nAltEntry
			nAltNameChoice = CTOBIN(SUBSTR(tcCrlDistPoint, nIniSub+4, 4), "4RS")
			nAltNameLenght = 0
			IF nAltNameChoice=1 OR nAltNameChoice=5
				nIniSub = nIniSub + 4
				nAltNameLenght = CTOBIN(SUBSTR(tcCrlDistPoint, nIniSub+4, 4), "4RS")
			ENDIF
			cHexaAddres = STRCONV(SUBSTR(tcCrlDistPoint, nIniSub+8, 4),15)
			cHexaSeparator = STRCONV(SUBSTR(tcCrlDistPoint, nIniSub+12, 4),15)
			nIniSub = nIniSub + IIF(cHexaSeparator="20202020", 12, 8)
			aMatDistPoint(nAE, 1)=nAltNameChoice
			aMatDistPoint(nAE, 2)=nAltNameLenght
		NEXT
		IF nAltNameChoice=1 OR nAltNameChoice=5
			nIniSub = nIniSub + 4
		ENDIF
		cHexaSeparator = STRCONV(SUBSTR(tcCrlDistPoint, nIniSub, 4),15)
		DO WHILE cHexaSeparator="20202020"
			nIniSub = nIniSub + 4
			cHexaSeparator = STRCONV(SUBSTR(tcCrlDistPoint, nIniSub, 4),15)
		ENDDO
		cBlobCRL = SUBSTR(tcCrlDistPoint, nIniSub)
		FOR nAE = 1 TO (ALEN(aMatDistPoint)/2)
			DO CASE
			CASE aMatDistPoint(nAE, 1)=7
				cAltNameChoice = SUBSTR(cBlobCRL, 1, AT(CHR(0)+CHR(0), cBlobCRL)+2)
				lcUrl = ALLTRIM(STRTRAN(cAltNameChoice, CHR(0), ""))
				cNameCRL = "Name URL = ; " + lcUrl + "; "
				lcReturnURL = lcReturnURL + IIF(".crl"$LOWER(lcUrl), lcUrl + "; ", "")
			CASE aMatDistPoint(nAE, 1)=5
				cAltNameChoice = SUBSTR(cBlobCRL, 1, aMatDistPoint(nAE, 2))
				cNameCRL = "Directory Name: " + CHR(13) + GetStructure_CertNameBlob(null, cAltNameChoice) + "; "	
			ENDCASE
			nLenght = LEN(cAltNameChoice) + IIF(4-MOD(LEN(cAltNameChoice),4)=4, 0, 4-MOD(LEN(cAltNameChoice),4)) + 1
			cHexaSeparator = STRCONV(SUBSTR(cBlobCRL, nLenght, 4),15)
			cBlobCRL = SUBSTR(cBlobCRL, nLenght + IIF(cHexaSeparator="20202020", 4, 0))
			nIniSub = nIniSub + nLenght - IIF(cHexaSeparator="20202020", 1, 5)
			lcReturnCRL = lcReturnCRL + cNameCRL + "; "
		NEXT
	NEXT
	IF VARTYPE(tcRequest)=="C"
		lcReturnCRL = IIF(tcRequest="URL", lcReturnURL, lcReturnCRL)
	ENDIF
	RETURN lcReturnCRL
ENDPROC

PROCEDURE GetStructure_CertAuthorityInfoAccess()
	LPARAMETERS tcAuthorityInfo AS String, tcRequest AS String
	*----- Acceso a la infomración de entidad emisora (CERT_AUTHORITY_INFO_ACCESS)
	IF VARTYPE(tcAuthorityInfo)<>"C"
		RETURN ""
	ENDIF
	IF EMPTY(tcAuthorityInfo)
		RETURN ""
	ENDIF
	lcReturnAuthoInfo = ""
	lcReturnURL = ""
	*----- Numero de elementos en Array
	nAccDescr = CTOBIN(SUBSTR(tcAuthorityInfo,1,4), "4RS")
	*----- Puntero de Origen
	nPoint00 = CTOBIN(SUBSTR(tcAuthorityInfo,5,4), "4RS")
	nIniStr = 5
	FOR nAIA = 1 TO nAccDescr
		*----- Puntero de Origen
		nPoint01 = CTOBIN(SUBSTR(tcAuthorityInfo, nIniStr+4, 4), "4RS")
		*----- Tipo de Entrada
		nPoint02 = CTOBIN(SUBSTR(tcAuthorityInfo, nIniStr+8, 4), "4RS")
		*----- Puntero de Origen
		nPoint03 = CTOBIN(SUBSTR(tcAuthorityInfo, nIniStr+12, 4), "4RS")
		*----- Separador de región
		nPoint04 = CTOBIN(SUBSTR(tcAuthorityInfo, nIniStr+16, 4), "4RS")
		nIniStr = nIniStr + 16
	NEXT
	nIniStr = nIniStr + 4
	cbAutInfo = SUBSTR(tcAuthorityInfo, nIniStr)
	lcReturnAuthoInfo = "Access to the issuer entity information: ; "
	FOR DPN = 1 TO nAccDescr
		lcReturnAuthoInfo = lcReturnAuthoInfo + "[ " + TRANSFORM(DPN) + "] Access to authority information " + "; "
		nEndBit = AT(REPLICATE(CHR(0),3), cbAutInfo)
		IF nEndBit==0
			lcAutInfo = ALLTRIM(SUBSTR(cbAutInfo, 1))
			cbAutInfo = SUBSTR(cbAutInfo, LEN(lcAutInfo))
		ELSE
			lcAutInfo = ALLTRIM(SUBSTR(cbAutInfo, 1, nEndBit-1))		
			cbAutInfo = SUBSTR(cbAutInfo, AT(lcAutInfo, cbAutInfo) + LEN(lcAutInfo))
		ENDIF
		IF !EMPTY(lcAutInfo)		
			lcMetAcce = "Access method = " + SUBSTR(lcAutInfo, 1, AT(CHR(0), lcAutInfo)-1) + "; "
			lcAltName = "Alternative name: ; "
			lcUrlStr  = STRCONV(ALLTRIM(SUBSTR(lcAutInfo, AT(CHR(0), lcAutInfo)+1)) + CHR(0), 6)
			lcAltName = lcAltName + + "URL = " + lcUrlStr
			lcAutInfo = lcMetAcce + lcAltName +"; "
			lcReturnURL = lcReturnURL + lcUrlStr + "; "
		ENDIF
		lcReturnAuthoInfo = lcReturnAuthoInfo + lcAutInfo + "; "
		cbAutInfo = GetCleanStringInit(cbAutInfo)
	NEXT
	IF VARTYPE(tcRequest)=="C"
		lcReturnAuthoInfo = IIF(tcRequest="URL", lcReturnURL, lcReturnAuthoInfo)
	ENDIF
	RETURN lcReturnAuthoInfo
ENDPROC

PROCEDURE GetStructure_CertNameBlob()
	LPARAMETERS tcNameBlob AS String, tcStringBinary AS String
	lcIssuerStr=""
	IF VARTYPE(tcNameBlob)="C"
		lcIssuerByte = 0h + tcNameBlob
		pbCert_Name_Blob = HeapAlloc(GetProcessHeap(), 0, LEN(lcIssuerByte))
		RtlMoveMemory(pbCert_Name_Blob, @lcIssuerByte, LEN(lcIssuerByte))
		lcIssuerStr = GetCertNameToString(pbCERT_NAME_BLOB)
		HeapFree(GetProcessHeap(), 0, pbCert_Name_Blob)
	ENDIF
	IF EMPTY(lcIssuerStr) AND !EMPTY(tcStringBinary)
		cbData = LEN(tcStringBinary)
	  	lbIssuer = SUBSTR(tcStringBinary, 1, cbData)
		pbData = HeapAlloc(GetProcessHeap(), 0, cbData)
		RtlMoveMemory(pbData, @lbIssuer, cbData)
		lcIssuerByte = 0h + BINTOC(cbData,"4RS") + BINTOC(pbData, "4RS")
		pbCert_Name_Blob = HeapAlloc(GetProcessHeap(), 0, LEN(lcIssuerByte))
		RtlMoveMemory(pbCert_Name_Blob, @lcIssuerByte, LEN(lcIssuerByte))
		lcIssuerStr = GetCertNameToString(pbCERT_NAME_BLOB)
		HeapFree(GetProcessHeap(), 0, pbCert_Name_Blob)
		HeapFree(GetProcessHeap(), 0, pbData)
	ENDIF	
	RETURN lcIssuerStr
ENDPROC

PROCEDURE GetCertNameToString()
	LPARAMETERS pbCertNameBlob AS Long
	*----- Valores posibles para wDwStrType, pueden ser la suma de varios
	SIMPLENAMESTR     = 1
	OIDNAMESTR	  = 2
	X500NAMESTR	  = 3
	SEMICOLONFLAG     = 0x40000000
	CRLFFLAG	  = 0x08000000
	NOPLUSFLAG	  = 0x20000000
	NOQUOTINGFLAG     = 0x10000000
	NAMEREVERSE	  = 0x02000000
	DISABLEIE4UTF8    = 0x00010000
	ENABLEPUNYCODE    = 0x00200000
	*----- Asignamos valores a Parametros
	nCertEncodTyp     = X509_ASN_ENCODING
	cpName 		  = pbCertNameBlob
	nDwStrType 	  = BITOR(X500NAMESTR, OIDNAMESTR, NAMEREVERSE, SEMICOLONFLAG)
	lcNameDecoded     = ""
	lnNameLong        = 0
	*----- Intento 1, obtenemos longitud de cadena
	lnNameLong = CertNameToStr(nCertEncodTyp, cpName, nDwStrType, @lcNameDecoded, @lnNameLong)
	IF lnNameLong <> 0
		*----- Intento 2, conociendo longitud de cadena, Obtenemos el nombre decodificado
		lcNameDecoded= REPLICATE(CHR(0), lnNameLong)
		CertNameToStr(nCertEncodTyp, cpName, nDwStrType, @lcNameDecoded, @lnNameLong)
	ENDIF
	*----- La función devuelve una cadena terminada en nulo, quitamos el CHR(0) que represanta nulo
	RETURN STRTRAN(lcNameDecoded, CHR(0), "")
ENDPROC

PROCEDURE GetCleanStringInit()
	LPARAMETERS tcStringToCleanInit AS String
	lnChrIni = 1
	FOR nl = 1 TO LEN(tcStringToCleanInit)
		cChr = STRCONV(SUBSTR(tcStringToCleanInit, nl, 1),15)
		IF cChr<>"00" AND cChr<>"20" AND cChr<>"1A"
			lnChrIni = nl
			EXIT
		ENDIF
	NEXT
	RETURN SUBSTR(tcStringToCleanInit, lnChrIni)
ENDPROC

PROCEDURE DeclarationsApi()
	DECLARE LONG CertOpenSystemStore IN Crypt32;
		STRING	 hprov,;
		STRING	 szSubsystemProtocol

	DECLARE LONG CertCloseStore IN Crypt32;
		LONG 	 hCertStore,;
		LONG	 dwFlags
	
	DECLARE LONG CryptUIDlgSelectCertificateFromStore IN Cryptui;
		LONG 	 hCertStore,;
		LONG 	 hWnd, ;
		STRING 	@pwszTitle, ;
		STRING	@pwszDisplayString, ;
		LONG	 dwDontUseColumn, ;
		LONG 	 dwFlags,;
		STRING	 pvReserved
	
	DECLARE LONG CertFindExtension IN Crypt32;
		STRING	 pszObjId,;
		LONG 	 nExtensions,;
		STRING	 rgExtensions
	
	DECLARE LONG CertNameToStr IN Crypt32;
		LONG	 dwCertEncodingType, ;
		LONG	 pName, ;
		LONG	 dwStrType, ;
		STRING	@psz, ;
		LONG	 csz
	
	DECLARE LONG GetProcessHeap IN Kernel32

	DECLARE LONG HeapAlloc IN Kernel32;
		LONG 	hHeap,;
		LONG 	dwFlags,;
		LONG 	dwBytes

	DECLARE LONG HeapFree IN Kernel32;
		LONG 	hHeap,;
		LONG 	dwFlags,;
		LONG 	lpMem

	DECLARE RtlMoveMemory IN Kernel32;
		LONG	Destination,;
		STRING @Source,;
		LONG	Length

ENDPROC

Fernando Mora

unread,

Aug 21, 2019, 12:37:58 PM8/21/19

to Comunidad de Visual Foxpro en Español

Aquí un par de capturas del código ejecutándose y devolviendo resultado. Use dos certificados, uno nacional del Banco Central del Ecuador emitido para usuario final (MY), y otro de Microsoft de tipo CA.

Saludos,

Fernando

Fernando Mora

unread,

Aug 21, 2019, 2:31:23 PM8/21/19

to Comunidad de Visual Foxpro en Español

Finalmente encontré el problema en tu código, esta mal declarado la función CryptGetObjectUrl, el primer parámetro debe ser Long.


#DEFINE URL_OID_CERTIFICATE_CRL_DIST_POINT		2
#DEFINE URL_OID_CERTIFICATE_CRL_DIST_POINT_AND_OCSP 	11
#DEFINE CRYPT_GET_URL_FROM_EXTENSION 			2


CLEAR
=DeclarationsApi()
lnHandleStore = 0
lnHandleStore = CertOpenSystemStore(0, "MY")
IF lnHandleStore=0
	RETURN .F.
ENDIF
lpCertContext = 0
lpCertContext=CryptUIDlgSelectCertificateFromStore(lnHandleStore, 0, null, null, 1, 0, null)
IF lpCertContext=0
	RETURN .F.
ENDIF

pszUrlOid = URL_OID_CERTIFICATE_CRL_DIST_POINT_AND_OCSP 
pvPara = lpCertContext
dwFlags = CRYPT_GET_URL_FROM_EXTENSION
pUrlArray = NULL
pcbUrlArray = 0
pUrlInfo = NULL
pcbUrlInfo = 0
pvReserved = 0
nResp = CryptGetObjectUrl(@pszUrlOid, pvPara, dwFlags, pUrlArray, @pcbUrlArray, pUrlInfo, @pcbUrlInfo, pvReserved)
IF nResp>0
	pUrlArray = SPACE(pcbUrlArray)
	pUrlInfo = SPACE(pcbUrlInfo)
	CryptGetObjectUrl(@pszUrlOid, pvPara, dwFlags, @pUrlArray, @pcbUrlArray, @pUrlInfo, @pcbUrlInfo, pvReserved)
	? "URL ARRAY: ", STRCONV(pUrlArray,6)
	?
	? "URL INFO: ", pUrlInfo
ENDIF
CertFreeCertificateContext(lpCertContext)
CertCloseStore(lnHandleStore, 0)



PROCEDURE DeclarationsApi()
	DECLARE LONG CertOpenSystemStore IN Crypt32;
		STRING	 hprov,;
		STRING	 szSubsystemProtocol

	DECLARE LONG CertCloseStore IN Crypt32;
		LONG 	 hCertStore,;
		LONG	 dwFlags

	DECLARE LONG CertFreeCertificateContext IN Crypt32;
		LONG 	 pCertContext

	
	DECLARE LONG CryptUIDlgSelectCertificateFromStore IN Cryptui;
		LONG 	 hCertStore,;
		LONG 	 hWnd, ;
		STRING 	@pwszTitle, ;
		STRING	@pwszDisplayString, ;
		LONG	 dwDontUseColumn, ;
		LONG 	 dwFlags,;
		STRING	 pvReserved

	DECLARE LONG CryptGetObjectUrl IN Cryptnet;
		LONG	 pszUrlOid,;
		LONG	 pvPara,;
		LONG	 dwFlags,;
		STRING	@pUrlArray,;
		LONG	@pcbUrlArray,;
		STRING	@pUrlInfo,;
		LONG	@pcbUrlInfo,;
		LONG	 pvReserved

ENDPROC

Roman Koltsov

unread,

Aug 21, 2019, 6:13:25 PM8/21/19

to Comunidad de Visual Foxpro en Español

Hola Fernando, Bravo!

¡Cosas realmente calientes!

Gracias por la solución alternativa.

Vi en un sitio ruso http://forum.foxclub.ru/read.php?29,781244,781250 que estás seriamente involucrado en criptografía y decidí escribirte aquí

Después de leer la correspondencia en los grupos de Google sobre el reemplazo de @STRING con LONG, me di cuenta de mi error. El problema es idéntico al que descubriste en febrero. Me interesa saber que siempre escribes LONG en lugar de INTEGER. Entiendo bien cuáles son las diferencias. Pero si escribe INTEGER en todas partes en un VFP de 32 bits, ¿es realmente posible obtener un error?

Esperaba exactamente de ti una respuesta y la recibí.Ahora en Tambov, Rusia, todos sabrán sobre la ciudad de Machala desde Ecuador. Gracias de nuevo!

Fernando Mora

unread,

Aug 21, 2019, 11:24:54 PM8/21/19

to Comunidad de Visual Foxpro en Español

Hola Roman. Si, luego de pasar por java y csharp, decidí desarrollar una librería 100% fox, que al igual que csharp y C++, use al máximo CNG de Windows, para el tema criptográfico. Esto abarca todas las necesidades de firmado de Xml, cifrado y descifrado de datos (asimétrico, simétrico), codificación y decodificación de certificados, importación y exportación de certificados, pares de claves, en diversos formatos (cer,pem,key,pfx,p12,) etc. Uso Long (64 bits) en lugar de Integer (32 bits) por dos razones, mejor rendimiento, y simplificar la asignación de parámetros de las funciones. Usando Long y String no te haces lio y da buenos resultados. Mis aplicaciones las tengo instalada en clientes que usan desde Windows 7 32 bits SP1 hasta Windows 10 64 bits, todos trabajan sin problemas. En este momento estoy trabajando en cifrado RSA, AES, DES, 3DES, estoy en fase de pruebas. Has usado las funciones de BCrypt para hacer cifrados AES? necesito ayuda para cifrar archivos grandes. Mi código aún no es estable en esa parte.

Roman Koltsov

unread,

Aug 23, 2019, 5:39:02 AM8/23/19

to Comunidad de Visual Foxpro en Español

Buenas tardes!

Si el certificado se recibe de la solicitud entrante durante la interacción, se guarda en el disco en un archivo y no se instala en SystemStore, entonces la función CryptGetObjectUrl no funciona. No utilizamos cifrado AES, ya que Rusia tiene su propio estándar de firma nacional GOST R 34.11-2012, implementado como una extensión para CryptoAPI

Fernando Mora

unread,

Aug 23, 2019, 7:08:13 PM8/23/19

to Comunidad de Visual Foxpro en Español

Roman, eso es mas sencillo todavía, solo tienes que crearle un contexto al certificado recibido. Para manejar este tipo de cadena, se recomienda transportar los datos en cadenas de Base64, Aquí te dejo un código de ejemplo, con un certificado de prueba de 1024 bits. Que tengas un excelente fin de semana.

PD: Me debes una botella de Vodka...jajaja


DECLARE LONG CertCreateCertificateContext IN Crypt32;
	LONG	 dwCertEncodingType,;
	STRING	 pbCertEncoded,;
	LONG	 cbCertEncoded


DECLARE LONG CertFreeCertificateContext IN Crypt32;
	LONG 	 pCertContext

#DEFINE X509_ASN_ENCODING    1
#DEFINE PKCS_7_ASN_ENCODING  0x00010000

TEXT TO lcCertB64 TEXTMERGE ADDITIVE NOSHOW
MIICLDCCAZWgAwIBAgIQRjRrx4AAVrwR024uxBCzsDANBgkqhkiG9w0BAQUFADASMRAwDgYDVQQD 
EwdDYXJsUlNBMB4XDTk5MDkxOTAxMDg0N1oXDTM5MTIzMTIzNTk1OVowEzERMA8GA1UEAxMIQWxp 
Y2VSU0EwgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBAOCJczmN2PX16Id2OX9OsAW7U4PeD7er 
3H3HdSkNBS5tEt+mhibU0m+qWCn8l+z6glEPMIC+sVCeRkTxLLvYMs/GaG8H2bBgrL7uNAlqE/X3 
BQWT3166NVbZYf8Zf8mB5vhs6odAcO+sbSx0ny36VTq5mXcCpkhSjE7zVzhXdFdfAgMBAAGjgYEw 
fzAMBgNVHRMBAf8EAjAAMA4GA1UdDwEB/wQEAwIGwDAfBgNVHSMEGDAWgBTp4JAnrHggeprTTPJC 
N04irp44uzAdBgNVHQ4EFgQUd9K00bdMioqjzkWdzuw8oDrj/1AwHwYDVR0RBBgwFoEUQWxpY2VS 
U0FAZXhhbXBsZS5jb20wDQYJKoZIhvcNAQEFBQADgYEAPnBHqEjME1iPylFxa042GF0EfoCxjU3M 
yqOPzH1WyLzPbrMcWakgqgWBqE4lradwFHUv9ceb0Q7pY9Jkt8ZmbnMhVN/0uiVdfUnTlGsiNnRz 
uErsL2Tt0z3Sp0LF6DeKtNufZ+S9n/n+dO/q+e5jatg/SyUJtdgadq7rm9tJsCI=
ENDTEXT

lnCertContext = GetCertCreateCertificateContext(lcCertB64)
IF lnCertContext>0
	? "Aquí esta su puntero al contexto del certificado: " + TRANSFORM(lnCertContext)
	*----- No olvide liberar el puntero luego de utilizar el certificado
	CertFreeCertificateContext(lnCertContext)
ENDIF

*---- Función que devuelve un puntero al contexto de un certificado codificado, pasar la cadena en b64 please.
PROCEDURE GetCertCreateCertificateContext()
	PARAMETERS tcCertEncodedB64 AS String
	pCertContext = 0
	IF !EMPTY(tcCertEncodedB64)
		dwCertEncodingType = BITOR(PKCS_7_ASN_ENCODING, X509_ASN_ENCODING)
		pbCertEncoded = STRCONV(ALLTRIM(STRTRAN(tcCertEncodedB64, CHR(0), "")),14)
		cbCertEncoded = LEN(pbCertEncoded)
		pCertContext = CertCreateCertificateContext(dwCertEncodingType, pbCertEncoded, cbCertEncoded)
	ENDIF
	RETURN pCertContext
ENDPROC

Roman Koltsov

unread,

Aug 25, 2019, 6:24:09 AM8/25/19

to Comunidad de Visual Foxpro en Español

Hola Fernando.

Por supuesto, creé un contexto para el certificado recibido. Y lo recibí casi de la misma manera que tú. Solo en lugar de STRCONV (tcCertEncodedB64,14) utilicé

nBufsize = 0
= CryptStringToBinary (@ lcX509Certificate, LEN (m.lcX509Certificate), CRYPT_STRING_BASE64, NULL, @nBufsize, 0,0)
pbCertEncoded = REPLICATE (CHR (0), m.nBufsize)
nResp = CryptStringToBinary (@ lcX509Certificate, LEN (m.lcX509Certificate), CRYPT_STRING_BASE64, @pbCertEncoded, @nBufsize, 0,0)
cbCertEncoded = LEN (pbCertEncoded)

Al mismo tiempo, todavía tenía un error.
Como resultó más tarde, la causa del error fue una declaración adicional (segunda) de la función CryptGetObjectUrl en el archivo VCX, en el que el parámetro pszUrlOid se describió erróneamente como STRING, no LONG.

Roman Koltsov

unread,

Aug 25, 2019, 7:05:30 AM8/25/19

to Comunidad de Visual Foxpro en Español

Aquí está el código de trabajo completo que extrae el CDP point del certificado y extrae aún más el hash Sha1 (thumbprint) del certificado

#DEFINE URL_OID_CERTIFICATE_CRL_DIST_POINT        2
#DEFINE URL_OID_CERTIFICATE_CRL_DIST_POINT_AND_OCSP     11
#DEFINE CRYPT_GET_URL_FROM_EXTENSION             2

#DEFINE X509_ASN_ENCODING    1
#DEFINE PKCS_7_ASN_ENCODING  0x00010000

#DEFINE CRYPT_STRING_BASE64  0x00000001  && Base64, without headers.
#DEFINE CERT_SHA1_HASH_PROP_ID 3         && Returns the SHA1 hash.
#DEFINE CRYPT_STRING_HEX     0x00000004  && Hexadecimal only format.
* https://cpdn.cryptopro.ru/content/csp40/html/group___pro_c_s_p_ex_DP8.html
#DEFINE szOID_CP_GOST_R3411_R3410EL            "1.2.643.2.2.3"        && Algorythm GOST R 34.10-2001
#DEFINE szOID_CP_GOST_R3411_12_256_R3410    "1.2.643.7.1.1.3.2"    && Algorythm GOST R 34.10-2012, 256 bit
#DEFINE szOID_CP_GOST_R3411_12_512_R3410    "1.2.643.7.1.1.3.3"    && Algorythm GOST R 34.10-2012, 512 bit

DECLARE INTEGER CryptStringToBinary IN crypt32;
    STRING @pszString,;
    LONG    cchString,;
    LONG    dwFlags,;
    STRING @pbBinary,;
    LONG   @pcbBinary,;
    LONG    pdwSkip,;
    LONG    pdwFlags

DECLARE LONG CertCreateCertificateContext IN Crypt32;


    LONG    dwCertEncodingType,;
    STRING    pbCertEncoded,;
    LONG    cbCertEncoded

DECLARE LONG CertFreeCertificateContext IN Crypt32;


    LONG     pCertContext

DECLARE LONG CertOpenSystemStore IN Crypt32;


    STRING    hprov,;
    STRING    szSubsystemProtocol

DECLARE LONG CertCloseStore IN Crypt32;
    LONG     hCertStore,;


    LONG    dwFlags
    
DECLARE LONG CertFreeCertificateContext IN Crypt32;
    LONG     pCertContext
    
DECLARE LONG CryptUIDlgSelectCertificateFromStore IN Cryptui;


    LONG     hCertStore,;
    LONG     hWnd, ;
    STRING     @pwszTitle, ;
    STRING    @pwszDisplayString, ;
    LONG    dwDontUseColumn, ;
    LONG     dwFlags,;


    STRING    pvReserved
    
DECLARE LONG CryptGetObjectUrl IN Cryptnet;


    LONG    pszUrlOid,;
    LONG    pvPara,;
    LONG    dwFlags,;
    STRING    @pUrlArray,;
    LONG    @pcbUrlArray,;
    STRING    @pUrlInfo,;
    LONG    @pcbUrlInfo,;


    LONG    pvReserved

DECLARE INTEGER CryptBinaryToString IN Crypt32;  
      STRING @pbBinary,;


      LONG cbBinary,;
      LONG dwFlags,;
      STRING @pszString,;
      LONG @pcchString



DECLARE INTEGER CertGetCertificateContextProperty IN crypt32;
    INTEGER  pCertContext,;
    LONG     dwPropId,;
    INTEGER  pvPara,;
    LONG   @ pcbData

DECLARE INTEGER CertOIDToAlgId IN crypt32;
    STRING  @ pszObjId

DECLARE INTEGER LocalAlloc IN kernel32;


    INTEGER uFlags,;
    INTEGER uBytes

DECLARE INTEGER LocalFree IN kernel32;


    INTEGER hMem

DECLARE INTEGER GetLastError ;
    IN WIN32API AS GetLastError
    
DECLARE INTEGER lstrlen IN kernel32;
    INTEGER lpString



TEXT TO lcCertB64 TEXTMERGE ADDITIVE NOSHOW

MIIIjTCCCDygAwIBAgIRAZe4dS0WrMSA6BEUsUB9qOYwCAYGKoUDAgIDMIHuMR4wHAYJKoZIhvcN
AQkBFg91Y2ZvbXNAZmZvbXMucnUxGDAWBgUqhQNkARINMTAyNzczOTcxMjg1NzEaMBgGCCqFAwOB
AwEBEgwwMDc3MjcwMzIzODIxCzAJBgNVBAYTAlJVMRgwFgYDVQQIDA83NyDQnNC+0YHQutCy0LAx
FTATBgNVBAcMDNCc0L7RgdC60LLQsDEyMDAGA1UECQwp0J3QvtCy0L7RgdC70L7QsdC+0LTRgdC6
0LDRjyDRg9C7Liwg0LQuMzcxETAPBgNVBAoMCNCk0J7QnNChMREwDwYDVQQDDAjQpNCe0JzQoTAe
Fw0xODA5MDUxMzU2MzdaFw0xOTEyMDUxNDA2MzdaMIIBlzEaMBgGCCqFAwOBAwEBEgwwMDY4MzEw
MDAyNjUxGDAWBgUqhQNkARINMTAyNjgwMTE1ODgxMjEbMBkGCSqGSIb3DQEJARYMdGZvbXNAdG1i
LnJ1MQswCQYDVQQGEwJSVTEsMCoGA1UECAwj0KLQsNC80LHQvtCy0YHQutCw0Y8g0L7QsdC70LDR
gdGC0YwxFTATBgNVBAcMDNCi0LDQvNCx0L7QsjErMCkGA1UECQwi0YPQuy4g0JrQvtC80LzRg9C9
0LDQu9GM0L3QsNGPLCAxODE3MDUGA1UECgwu0KLQpNCe0JzQoSDQotCw0LzQsdC+0LLRgdC60L7Q
uSDQvtCx0LvQsNGB0YLQuDFJMEcGA1UECwxA0J7RgtC00LXQuyDQuNC90YTQvtGA0LzQsNGG0LjQ
vtC90L3QvtCz0L4g0L7QsdC10YHQv9C10YfQtdC90LjRjzE/MD0GA1UEAww20JDQmNChINCf0KMg
0J7QnNChINCi0LDQvNCx0L7QstGB0LrQvtC5INC+0LHQu9Cw0YHRgtC4MGMwHAYGKoUDAgITMBIG
ByqFAwICJAAGByqFAwICHgEDQwAEQJClKMdUgM0jjkBUJzW+mGmTF26Gmgcvk1LbPwllgCg5FxzN
HqF7k3CmIawgTzWyMhIsdCCQHSu9HTdGhZ5NtZejggUFMIIFATAOBgNVHQ8BAf8EBAMCA/gwHQYD
VR0OBBYEFM9X1n2LqtthzFr7YScF5TyaY5shMDMGCSsGAQQBgjcVBwQmMCQGHCqFAwICMgEJyZlh
lao6hJGWT4WgsXOD13KDtj4CAQECAQAwggGGBgNVHSMEggF9MIIBeYAUFbdV5IiKzBbjPrBbebba
8+cNX/ehggFSpIIBTjCCAUoxHjAcBgkqhkiG9w0BCQEWD2RpdEBtaW5zdnlhei5ydTELMAkGA1UE
BhMCUlUxHDAaBgNVBAgMEzc3INCzLiDQnNC+0YHQutCy0LAxFTATBgNVBAcMDNCc0L7RgdC60LLQ
sDE/MD0GA1UECQw2MTI1Mzc1INCzLiDQnNC+0YHQutCy0LAsINGD0LsuINCi0LLQtdGA0YHQutCw
0Y8sINC0LiA3MSwwKgYDVQQKDCPQnNC40L3QutC+0LzRgdCy0Y/Qt9GMINCg0L7RgdGB0LjQuDEY
MBYGBSqFA2QBEg0xMDQ3NzAyMDI2NzAxMRowGAYIKoUDA4EDAQESDDAwNzcxMDQ3NDM3NTFBMD8G
A1UEAww40JPQvtC70L7QstC90L7QuSDRg9C00L7RgdGC0L7QstC10YDRj9GO0YnQuNC5INGG0LXQ
vdGC0YCCCwD0Z+EyAAAAAAJqMCcGA1UdJQQgMB4GCCsGAQUFBwMCBggrBgEFBQcDBAYIKwYBBQUH
AwEwMwYJKwYBBAGCNxUKBCYwJDAKBggrBgEFBQcDAjAKBggrBgEFBQcDBDAKBggrBgEFBQcDATAd
BgNVHSAEFjAUMAgGBiqFA2RxATAIBgYqhQNkcQIwggFDBgUqhQNkcASCATgwggE0DDTQodCa0JfQ
mCAi0JrRgNC40L/RgtC+0J/RgNC+IENTUCIgKNCy0LXRgNGB0LjRjyA0LjApDFrQn9CQ0JogItCj
0LTQvtGB0YLQvtCy0LXRgNGP0Y7RidC40Lkg0YbQtdC90YLRgCAi0JrRgNC40L/RgtC+0J/RgNC+
INCj0KYiINCy0LXRgNGB0LjQuCAyLjAMT9Ch0LXRgNGC0LjRhNC40LrQsNGCINGB0L7QvtGC0LLQ
tdGC0YHRgtCy0LjRjyDihJYg0KHQpC8xMjQtMjg2NCDQvtGCIDIwLjAzLjIwMTYMT9Ch0LXRgNGC
0LjRhNC40LrQsNGCINGB0L7QvtGC0LLQtdGC0YHRgtCy0LjRjyDihJYg0KHQpC8xMjgtMjk4MyDQ
vtGCIDE4LjExLjIwMTYwLAYFKoUDZG8EIwwh0KHQmtCX0JggItCa0YDQuNC/0YLQvtCf0YDQviBD
U1AiMFgGA1UdHwRRME8wTaBLoEmGR2h0dHA6Ly91Y2ZvbXMuZmZvbXMucnUvY2RwLzE1Yjc1NWU0
ODg4YWNjMTZlMzNlYjA1Yjc5YjZkYWYzZTcwZDVmZjcuY3JsMIGXBggrBgEFBQcBAQSBijCBhzAw
BggrBgEFBQcwAYYkaHR0cDovL3VjZm9tcy5mZm9tcy5ydS9vY3NwL29jc3Auc3JmMFMGCCsGAQUF
BzAChkdodHRwOi8vdWNmb21zLmZmb21zLnJ1L2FpYS8xNWI3NTVlNDg4OGFjYzE2ZTMzZWIwNWI3
OWI2ZGFmM2U3MGQ1ZmY3LmNydDArBgNVHRAEJDAigA8yMDE4MDkwNTEzNTYzN1qBDzIwMTkwOTA1
MTM1NjM3WjAIBgYqhQMCAgMDQQB5goLR7QDXU6ZtYraFLA8KpEPBlDOXhgRxsZwRZNvyfoshn9+Z
KOYIaFyw5lc7/PwRgyq/XmAf3iZ7ObUdeN7i
ENDTEXT

m.lcCertB64 = StrTran(m.lcCertB64, '&#13;', '')  && Very actual in some cases!

lnCertContext = 0
If !Empty(lcCertB64)
    nBufsize=0  
    = CryptStringToBinary(@lcCertB64, LEN(m.lcCertB64), CRYPT_STRING_BASE64, NULL, @nBufsize, 0,0)
    pbCertEncoded = REPLICATE(CHR(0), m.nBufsize)
    nResp = CryptStringToBinary(@lcCertB64, LEN(m.lcCertB64), CRYPT_STRING_BASE64, @pbCertEncoded, @nBufsize, 0,0)

    dwCertEncodingType = BITOR(PKCS_7_ASN_ENCODING, X509_ASN_ENCODING)
    cbCertEncoded = LEN(pbCertEncoded)
    lnCertContext = CertCreateCertificateContext(dwCertEncodingType, pbCertEncoded, cbCertEncoded)
EndIf

If lnCertContext=0
    =MessageBox("lnCertContext = 0",64,"Error")
    Return .F.
EndIf

lcStr = ""
lcCERT_CONTEXT = SYS(2600, lnCertContext, 20)
pCertInfo = CTOBIN(SubStr(lcCERT_CONTEXT, 13, 4), "4RS")
lcCERT_INFO = SYS(2600, pCertInfo, 112)
pAlgorithmOID = CTOBIN(SubStr(lcCERT_INFO, 13, 4), "4RS")
lnStrLen = lstrlen(pAlgorithmOID)
lcAlgorithmOID = SYS(2600, pAlgorithmOID, lnStrLen)
Do Case
    Case lcAlgorithmOID == szOID_CP_GOST_R3411_R3410EL  && "1.2.643.2.2.3"
        lcStr = "Algorythm GOST R 34.10-2001"
    Case lcAlgorithmOID == szOID_CP_GOST_R3411_12_256_R3410     && "1.2.643.7.1.1.3.2"
        lcStr = "Algorythm GOST R 34.10-2012, 256 bit"
    Case lcAlgorithmOID == szOID_CP_GOST_R3411_12_512_R3410  &&    "1.2.643.7.1.1.3.3"
        lcStr = "Algorythm GOST R 34.10-2012, 512 bit"
EndCase
lnCALG_GR3411 = CertOIDToAlgId(@lcAlgorithmOID)  && CALG_GR3411 = 32798, CALG_GR3411_2012_256 = 32801, CALG_GR3411_2012_512 = 32802
=MessageBox(lcStr,64,"Algorythm")

* Get the certificate thumbprint (SHA1 hash)
m.lGetProperty = .T.
m.pcbData = 0
If !CertGetCertificateContextProperty(lnCertContext, CERT_SHA1_HASH_PROP_ID, 0, @m.pcbData) = 0
    pvData = LocalAlloc(0x0040, m.pcbData)
    If !CertGetCertificateContextProperty(lnCertContext, CERT_SHA1_HASH_PROP_ID, pvData, @m.pcbData) = 0
        m.lcHashSha1 = SYS(2600, pvData, m.pcbData)
    Else
        lnResultCode = GetLastError()
        lcErr = "Error getting thumbprint"


        =MessageBox(lcErr,16,"Error: " + Transform(lnResultCode,"@0"))


        m.lGetProperty = .F.
    EndIf
Else
    lnResultCode = GetLastError()
    lcErr = "Error getting thumbprint"


    =MessageBox(lcErr,16,"Error: " + Transform(lnResultCode,"@0"))


    m.lGetProperty = .F.
EndIf

If m.lGetProperty
      nBufSize=0  
      = CryptBinaryToString(@m.lcHashSha1, Len(m.lcHashSha1), CRYPT_STRING_HEX, NULL, @nBufSize)
      lcThumbprint = REPLICATE(CHR(0), m.nBufSize)
      If !CryptBinaryToString(@m.lcHashSha1, Len(m.lcHashSha1), CRYPT_STRING_HEX, @lcThumbprint, @nBufSize) = 0
        lcThumbprint = StrTran(StrTran(StrTran(lcThumbprint,Chr(13),""),Chr(10),Chr(32)),Chr(32)+Chr(32),Chr(32))
        If Right(lcThumbprint, 1) == Chr(0)
            lcThumbprint = Left(lcThumbprint, Len(lcThumbprint)-1)
        EndIf
        lcThumbprint = Upper(AllT(lcThumbprint))
        lcStr = "Certificate thumbprint: " + AllT(lcThumbprint)
        =MessageBox(AllT(lcThumbprint),64,"Certificate Sha1 hash")
    Else
        =MessageBox("Can't get the certificate thumbprint!",16,"Error")
    EndIf
EndIf
If !Empty(pvData)
    LocalFree(pvData)
EndIf

pszUrlOid = URL_OID_CERTIFICATE_CRL_DIST_POINT  && URL_OID_CERTIFICATE_CRL_DIST_POINT_AND_OCSP 
pvPara = lnCertContext
dwFlags = CRYPT_GET_URL_FROM_EXTENSION
pUrlArray = NULL
pcbUrlArray = 0


pUrlInfo = NULL
pcbUrlInfo = 0
pvReserved = 0
nResp = CryptGetObjectUrl(@pszUrlOid, pvPara, dwFlags, pUrlArray, @pcbUrlArray, pUrlInfo, @pcbUrlInfo, pvReserved)

If nResp>0
    pUrlArray = Space(pcbUrlArray)
    pUrlInfo = Space(pcbUrlInfo)
    If !CryptGetObjectUrl(@pszUrlOid, pvPara, dwFlags, @pUrlArray, @pcbUrlArray, @pUrlInfo, @pcbUrlInfo, pvReserved) = 0
        lcCRLArray = STRCONV(pUrlArray,6)
        lcStartCDP = AT("http://", lcCRLArray)
        lnI = 1
        Do While lcStartCDP > 0
            lcCRLArray = SubStr(lcCRLArray, lcStartCDP)
            lcCDP = Left(lcCRLArray, AT(Chr(0), lcCRLArray)-1)
            lcCRLArray = SubStr(lcCRLArray, AT(Chr(0), lcCRLArray)+1)
            lcStartCDP = AT("http://", lcCRLArray)
            lcStr = "[" + AllT(Str(lnI)) + "] CDP point: " + AllT(lcCDP)
            =MessageBox(lcStr,64,"Info")
            lnI = lnI + 1
        EndDo
    Else
        =MessageBox("Can't get CRL List URL!",16,"Error")
    EndIf
EndIf
CertFreeCertificateContext(lnCertContext)

Ahora otra pregunta. Guardé el archivo CRL en el disco e intento analizarlo. La función KKK no quiere funcionar

* CryptQueryObject types and flags
#DEFINE CERT_QUERY_OBJECT_FILE                 1
#DEFINE CERT_QUERY_CONTENT_FLAG_PKCS7_SIGNED_EMBED     0x400  && 1024 OR (1 << 10) OR (1 shl 10) OR 2 ^ 10
#DEFINE CERT_QUERY_FORMAT_FLAG_BINARY             0x002  && 2 OR (1 << 1) OR (1 shl 1) OR 2 ^ 1

DECLARE LONG CryptQueryObject IN Crypt32;
      LONG dwObjectType,;
      STRING pvObject,;                               && I TRY THIS PARAMETER LONG AND STRING, BUT DON'T WORK...
      LONG dwExpectedContentTypeFlags,;
      LONG dwExpectedFormatTypeFlags,;
      LONG dwFlags,;
      LONG @pdwMsgAndCertEncodingType,;
      LONG @pdwContentType,;
      LONG @pdwFormatType,;
      LONG @phCertStore,;
      LONG @phMsg,;
      LONG @ppvContext

lcCRLFile = "C:\MyFolder\CRL\163d4290bf0a9c881766b9264f928470a3d705db.crl"
If File(lcCRLFile)
    dwObjectType = CERT_QUERY_OBJECT_FILE    && LONG dwObjectType
    pvData = StrConv("file://" + lcCRLFile + CHR(0), 5)  && STRING pvData
    dwExpectedContentTypeFlags = CERT_QUERY_CONTENT_FLAG_PKCS7_SIGNED_EMBED
    dwExpectedFormatTypeFlags = CERT_QUERY_FORMAT_FLAG_BINARY
    dwFlags = 0
    dwEncoding = 0
    dwContentType = 0
    dwFormatType = 0
    hStore = 0
    hMsg = 0

    * Get message handle and store handle from the signed file (CRL)
    fResult = CryptQueryObject(dwObjectType, pvData, dwExpectedContentTypeFlags, dwExpectedFormatTypeFlags, dwFlags, @dwEncoding, @dwContentType, @dwFormatType, @hStore, @hMsg, 0)
    If Empty(fResult)
        lnResultCode = GetLastError()
        If lnResultCode = -2146885623  && 0x80092009
            lcErr = "Cannot find the requested object."  && CRYPT_E_NO_MATCH. May be file is not signed? No!
        Else
            lcErr = "CryptQueryObject error"
        EndIf


        =MessageBox(lcErr,16,"Error: " + Transform(lnResultCode,"@0"))

    EndIf
EndIf

Fernando Mora

unread,

Aug 26, 2019, 2:00:46 PM8/26/19

to Comunidad de Visual Foxpro en Español

Saludos Roman, buen inicio de semana.

En hora buena que ya este resuelto la extracción de la URL de los puntos de distribución CRL, Probé tu código final y funcional excelente.

Pase el certificado de tu ejemplo a mi librería, y pudo observar algunas cosas interesante. Las extensiones, se leen muy bien, tengo programadas la decodificación de 30 de las 44 existentes y que son de estructuras complejas. Los caracteres cirilicos se están mostrando como signos de interrogación, va ha tocar realizar ajuste en esa parte. Comparé mi decodificación con la que hace CryptUIDlgViewContext.

Fernando Mora

unread,

Aug 26, 2019, 2:14:33 PM8/26/19

to Comunidad de Visual Foxpro en Español

Respecto a tu ultima pregunta. No es el formato del parámetro el que esta incorrecto, son los valores que estas pasando de forma errónea. El segundo parámetro pvData, es una simple cadena unicode con la ruta del archivo, no debes especificar "file://", estamos en Fox no en C++, segundo, estas intentando obtener un objeto CRL no PKCS7, por lo que el valor correcto a pasar para el tercer parámetro dwExpectedContentTypeFlags, es la constante CERT_QUERY_CONTENT_FLAG_CRL. El código resuelto quedaría así:


#DEFINE CERT_QUERY_OBJECT_FILE                 		1
#DEFINE CERT_QUERY_CONTENT_CRL 				3
#DEFINE CERT_QUERY_FORMAT_BINARY			1
#DEFINE CERT_QUERY_CONTENT_PKCS7_SIGNED_EMBED 		10
#DEFINE CERT_QUERY_CONTENT_FLAG_CRL			BITLSHIFT(1,CERT_QUERY_CONTENT_CRL)
#DEFINE CERT_QUERY_FORMAT_FLAG_BINARY			BITLSHIFT(1,CERT_QUERY_FORMAT_BINARY)
#DEFINE CERT_QUERY_CONTENT_FLAG_PKCS7_SIGNED_EMBED	BITLSHIFT(1,CERT_QUERY_CONTENT_PKCS7_SIGNED_EMBED)
=DeclarationsAPIS()
SET STEP ON
lcCRLFile = "C:\PROYECTOS\VFPXADES\CERTIFICATES\CRLS\15b755e4888acc16e33eb05b79b6daf3e70d5ff7.crl"
IF FILE(lcCRLFile)

dwObjectType = CERT_QUERY_OBJECT_FILE && LONG dwObjectType

	pvData = STRCONV(lcCRLFile + CHR(0), 5)  && STRING pvData
	dwExpectedContentTypeFlags = CERT_QUERY_CONTENT_FLAG_CRL

	dwExpectedFormatTypeFlags = CERT_QUERY_FORMAT_FLAG_BINARY
	dwFlags = 0
	dwEncoding = 0
	dwContentType = 0
	dwFormatType = 0
	hStore = 0
	hMsg = 0

	ppvContext = 0
	*----- Get message handle and store handle from the signed file (CRL)
	nResult = CryptQueryObject(dwObjectType, pvData, dwExpectedContentTypeFlags, dwExpectedFormatTypeFlags, dwFlags, @dwEncoding, @dwContentType, @dwFormatType, @hStore, @hMsg, @ppvContext)
	IF nResult==0
		lnResultCode = GetLastError()
		IF lnResultCode = -2146885623  && 0x80092009

lcErr = "Cannot find the requested object." && CRYPT_E_NO_MATCH. May be file is not signed? No!

		ELSE
			lcErr = "CryptQueryObject error"
		ENDIF
		=MESSAGEBOX(lcErr,16,"Error: " + TRANSFORM(lnResultCode,"@0"))
	ELSE
		? "dwEncoding: ", dwEncoding
		? "dwContentType: ", dwContentType
		? "dwFormatType: ", dwFormatType
		? "hStore: ", hStore
		? "hMsg: ", hMsg
		? "ppvContext: ", ppvContext
	ENDIF
ENDIF

PROCEDURE DeclarationsAPIS()

	DECLARE LONG CryptQueryObject IN Crypt32;
		LONG	 dwObjectType,;
		STRING	 pvObject,;

		LONG	 dwExpectedContentTypeFlags,;
		LONG	 dwExpectedFormatTypeFlags,;
		LONG	 dwFlags,;
		LONG	 @pdwMsgAndCertEncodingType,;
		LONG	 @pdwContentType,;
		LONG	 @pdwFormatType,;
		LONG	 @phCertStore,;
		LONG	 @phMsg,;
		LONG	 @ppvContext

ENDPROC

Saludos para todo el Fox Club Russian Forum, hay un excelente grupo de foxeros ahí.

Fernando Mora

unread,

Aug 31, 2019, 12:58:23 AM8/31/19

to Comunidad de Visual Foxpro en Español

Hola Roman.

Revisando el link: https://www.winehq.org/pipermail/wine-cvs/2009-December/062848.html que tiene un interesante código en C++ para recuperar el objeto CRL en linea, validarlo y buscar el certificado en la lista de revocaciones, lo traduje a Fox. En lo que he podido observar cuando se ejecuta el código se recupera el objecto CRL en pocos segundos, realmente es un tiempo bastante aceptable, pero si se vuelve a consultar se tarda demasiado. Pienso que sería mas conveniente descargar el objecto CRL. Sería bueno que revises este código, hagas pruebas y veas que se puede mejorar. Otro detalle, incluí CrptStringToBinary para convertir Base64 a ASN1, ya que veo que no usas STRCONV(16). ¿Que versión de VFP usas?.

Saludos,

Fernando


#DEFINE CRYPT_STRING_BASE64HEADER			0
#DEFINE CRYPT_STRING_BASE64 				1
#DEFINE CRYPT_STRING_BINARY				2
#DEFINE CRYPT_STRING_ANY				7

#DEFINE URL_OID_CERTIFICATE_ISSUER			1
#DEFINE URL_OID_CERTIFICATE_CRL_DIST_POINT		2

#DEFINE	URL_OID_CTL_ISSUER				3
#DEFINE	URL_OID_CTL_NEXT_UPDATE				4
#DEFINE	URL_OID_CRL_ISSUER				5
#DEFINE	URL_OID_CERTIFICATE_FRESHEST_CRL		6
#DEFINE	URL_OID_CRL_FRESHEST_CRL			7
#DEFINE	URL_OID_CROSS_CERT_DIST_POINT			8
#DEFINE URL_OID_CERTIFICATE_OCSP			9
#DEFINE	URL_OID_CERTIFICATE_OCSP_AND_CRL_DIST_POINT	10
#DEFINE URL_OID_CERTIFICATE_CRL_DIST_POINT_AND_OCSP 	11
#DEFINE	URL_OID_CROSS_CERT_SUBJECT_INFO_ACCESS		12
#DEFINE	URL_OID_CERTIFICATE_ONLY_OCSP			13

#DEFINE CRYPT_GET_URL_FROM_ANY 0

#DEFINE CRYPT_GET_URL_FROM_PROPERTY			1
#DEFINE CRYPT_GET_URL_FROM_EXTENSION 			2

#DEFINE CRYPT_GET_URL_FROM_UNAUTH_ATTRIBUTE		4
#DEFINE CRYPT_GET_URL_FROM_AUTH_ATTRIBUTE		8

#DEFINE CERT_CONTEXT_REVOCATION_TYPE			1
#DEFINE CERT_VERIFY_REV_CHAIN_FLAG			1
#DEFINE CERT_VERIFY_CACHE_ONLY_BASED_REVOCATION		2
#DEFINE CERT_VERIFY_REV_ACCUMULATIVE_TIMEOUT_FLAG 	4

#DEFINE CONTEXT_OID_CERTIFICATE				1
#DEFINE CONTEXT_OID_CRL					2
#DEFINE CONTEXT_OID_CTL					3
#DEFINE CONTEXT_OID_PKCS7				4
#DEFINE CONTEXT_OID_CAPI2_ANY				5
#DEFINE CONTEXT_OID_OCSP_RESP				6

#DEFINE CRYPT_RETRIEVE_MULTIPLE_OBJECTS			1
#DEFINE CRYPT_CACHE_ONLY_RETRIEVAL			2
#DEFINE CRYPT_WIRE_ONLY_RETRIEVAL			4
#DEFINE CRYPT_DONT_CACHE_RESULT				8
#DEFINE CRYPT_ASYNC_RETRIEVAL				10
#DEFINE CRYPT_STICKY_CACHE_RETRIEVAL			4096
#DEFINE CRYPT_LDAP_SCOPE_BASE_ONLY_RETRIEVAL		8192
#DEFINE CRYPT_OFFLINE_CHECK_RETRIEVAL			16384


#DEFINE X509_ASN_ENCODING    				1
#DEFINE PKCS_7_ASN_ENCODING  				0x00010000

#DEFINE FORMAT_MESSAGE_FROM_SYSTEM			4096

CLEAR
=DeclarationsApi()

lnCertContext = GetCertCreateCertificateContext(lcCertB64)
IF lnCertContext>0

	pszUrlOid = URL_OID_CERTIFICATE_CRL_DIST_POINT
	pvPara = lnCertContext
	dwFlags = CRYPT_GET_URL_FROM_ANY

	pUrlArray = NULL
	pcbUrlArray = 0
	pUrlInfo = NULL
	pcbUrlInfo = 0
	pvReserved = 0
	nResp = CryptGetObjectUrl(@pszUrlOid, pvPara, dwFlags, pUrlArray, @pcbUrlArray, pUrlInfo, @pcbUrlInfo, pvReserved)

	IF nResp>0
		pUrlArray = SPACE(pcbUrlArray)
		pUrlInfo = SPACE(pcbUrlInfo)

CryptGetObjectUrl(@pszUrlOid, pvPara, dwFlags, @pUrlArray, @pcbUrlArray, @pUrlInfo, @pcbUrlInfo, pvReserved)

		? "URL INFO: ", STRCONV(pUrlInfo,15)	
		nItems = CTOBIN(LEFT(pUrlArray,4), "4RS")
		nPointer0 = CTOBIN(SUBSTR(pUrlArray, 5,4), "4RS")
		nIniChr = 5
		FOR X = 1 TO nItems
			nIniChr = nIniChr + 4
			cString = STRCONV(SYS(2600, CTOBIN(SUBSTR(pUrlArray,nIniChr,4), "4RS"), 600),6)
			lcURL = ALLTRIM(SUBSTR(cString, 1, AT(CHR(0), cString)))+CHR(0)
			? lcURL 
			?
			GetValidityCertInCRL(lcURL, lnCertContext)
		NEXT
	ENDIF
	CertFreeCertificateContext(lnCertContext)
ENDIF


PROCEDURE GetCertCreateCertificateContext()
	PARAMETERS tcCertEncodedB64 AS String
	pCertContext = 0
	IF !EMPTY(tcCertEncodedB64)
		dwCertEncodingType = BITOR(PKCS_7_ASN_ENCODING, X509_ASN_ENCODING)

pbCertEncoded = GetCryptStringToBinary(ALLTRIM(STRTRAN(tcCertEncodedB64, CHR(0), "")))

		cbCertEncoded = LEN(pbCertEncoded)
		pCertContext = CertCreateCertificateContext(dwCertEncodingType, pbCertEncoded, cbCertEncoded)
	ENDIF
	RETURN pCertContext
ENDPROC

PROCEDURE GetCryptStringToBinary()
	PARAMETERS tcStringCert AS String
	lcRespStr = ""
	IF VARTYPE(tcStringCert)=="C"
		dwBufferLen=0
		pdwSkip=0
		pdwFlags=0
		nResp = CryptStringToBinary(tcStringCert, 0, CRYPT_STRING_ANY, NULL, @dwBufferLen, @pdwSkip, @pdwFlags)
		pbCertEncoded = SPACE(dwBufferLen)
		DO CASE
		CASE pdwFlags=0
			*------- Base64, with certificate beginning and ending headers.
			CryptStringToBinary(tcStringCert, 0, CRYPT_STRING_BASE64HEADER, @pbCertEncoded, @dwBufferLen, @pdwSkip, @pdwFlags)
		CASE pdwFlags=1
			*------- Base64, without headers.
			CryptStringToBinary(tcStringCert, 0, CRYPT_STRING_BASE64, @pbCertEncoded, @dwBufferLen, @pdwSkip, @pdwFlags)
		CASE pdwFlags=2
			*------- Pure binary copy.
			pbCertEncoded=tcStringCert
		ENDCASE
		lcRespStr = pbCertEncoded
	ENDIF
	RETURN lcRespStr
ENDPROC

PROCEDURE GetValidityCertInCRL()
	LPARAMETERS tcURL AS String, tpCertContext AS Long
	pszUrl = tcURL
	pszObjectOid = CONTEXT_OID_CRL
	dwRetrievalFlags = CRYPT_WIRE_ONLY_RETRIEVAL
	dwTimeout = 0
	pCrlContext = 0
	hAsyncRetrieve = NULL
	pCredentials = NULL
	pvVerify = NULL
	pAuxInfo = NULL
	nResp = CryptRetrieveObjectByUrlA(pszUrl, @pszObjectOid, dwRetrievalFlags, dwTimeout, @pCrlContext, hAsyncRetrieve, pCredentials, pvVerify, pAuxInfo)
	? nResp, IIF(nResp=1, "retrieved Object", "Non Retrieved Object")
	? pCrlContext, IIF(pCrlContext>0, "CRL Pointer" , "")
	IF nResp>0
		pTimeToVerify = 0
		pCrlInfo = CTOBIN(SYS(2600, pCrlContext+ 12, 4), "4RS")
		nResp = CertVerifyCRLTimeValidity(pTimeToVerify, pCrlInfo)
		? nResp, IIF(nResp=0, "CRL time OK", "CRL time out")
		IF nResp==0
			pCert = tpCertContext
			pCrlContext = pCrlContext
			dwFlags = 0
			pvReserved = 0
			ppCrlEntry = 0
			nResp = CertFindCertificateInCRL(pCert, pCrlContext, dwFlags, pvReserved, @ppCrlEntry)
			? nResp, IIF(nResp=1, "Certificate searched", "Certificate non searched")
			IF nResp=1
				? ppCrlEntry, IIF(ppCrlEntry=0, "CERTIFICATE OK", "CERTIFICATE REVOCATE")
			ENDIF
			CertFreeCRLContext(pCrlContext)
		ELSE
			=GetMessageError()
		ENDIF
	ELSE
		=GetMessageError()
	ENDIF
ENDPROC

PROCEDURE GetMessageError(tnNumError AS Long)
	IF VARTYPE(tnNumError)=="N"
		lnErrorCode = tnNumError
	ELSE
		lnErrorCode = GetLastError()
	ENDIF
	lpBuffer = SPACE(128)
	=FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 'WINERROR.H', lnErrorCode, 0, @lpBuffer, 128 , 0)
	=MESSAGEBOX(lpBuffer, 16, "Error: " + TRANSFORM(lnErrorCode,"@0"))
ENDPROC

PROCEDURE DeclarationsApi()
	DECLARE LONG CryptStringToBinary IN Crypt32;

		STRING 	@pszString, ;
		LONG 	 cchString, ;
		LONG 	 dwFlags,;
		STRING 	@pbBinary, ;
		LONG 	@pcbBinary,;

		LONG 	@pdwSkip, ;
		LONG 	@pdwFlags


	DECLARE LONG CertCreateCertificateContext IN Crypt32;
		LONG	 dwCertEncodingType,;
		STRING	 pbCertEncoded,;
		LONG	 cbCertEncoded

DECLARE LONG CryptGetObjectUrl IN CryptNet;

		LONG	 pszUrlOid,;
		LONG	 pvPara,;
		LONG	 dwFlags,;
		STRING	@pUrlArray,;
		LONG	@pcbUrlArray,;
		STRING	@pUrlInfo,;
		LONG	@pcbUrlInfo,;
		LONG	 pvReserved

	DECLARE LONG CryptRetrieveObjectByUrlA IN CryptNet;
		STRING	 pszUrl,;
		LONG	 pszObjectOid,;
		LONG	 dwRetrievalFlags,;
		LONG	 dwTimeout,;
		LONG	@ppvObject,;
		STRING	 hAsyncRetrieve,;
		STRING	 pCredentials,;
		STRING	 pvVerify,;
		STRING	 pAuxInfo

	DECLARE LONG CertVerifyCRLTimeValidity IN Crypt32;
		LONG	 pTimeToVerify,;
		LONG	 pCrlInfo

	DECLARE LONG CertFindCertificateInCRL IN Crypt32;
		LONG	 pCert,;
		LONG	 pCrlContext,;
		LONG	 dwFlags,;
		LONG	 pvReserved,;
		LONG	@ppCrlEntry

	
	DECLARE LONG CertFreeCertificateContext IN Crypt32;
		LONG 	 pCertContext

	DECLARE LONG CertFreeCRLContext IN Crypt32;
		LONG 	 pCrlContext

	DECLARE LONG GetLastError IN Kernel32

	DECLARE LONG FormatMessage IN Kernel32;
	  	LONG 	 dwFlags, ;
	  	STRING 	@lpSource, ;
	  	LONG 	 dwMessageId, ;
	  	LONG 	 dwLanguageId, ;
	  	STRING 	@lpBuffer, ;
	  	LONG 	 nSize, ;
	  	LONG 	 Arguments

ENDPROC

Roman Koltsov

unread,

Sep 1, 2019, 6:21:54 AM9/1/19

to Comunidad de Visual Foxpro en Español

Hola
¡Genial, lo estoy probando!
Estoy usando VFP 09.00.0000.7423.
Ambos métodos funcionan allí.
Por cierto, una discusión interesante sobre el tema de CRL aquí:
http://forum.foxclub.ru/read.php?29,729125