DECLARE LONG CryptAcquireCertificatePrivateKey IN crypt32; LONG pCert,; LONG dwFlags,; LONG pvParameters,; LONG @phCryptProvOrNCryptKey,; LONG @pdwKeySpec,; LONG @pfCallerFreeProvOrNCryptKey
DECLARE LONG CryptGetUserKey IN Advapi32; LONG hProv,; LONG dwKeySpec,; LONG @phUserKey
DECLARE LONG CryptExportKey IN Advapi32; LONG hKey,; LONG hExpKey,; LONG dwBlobType,; LONG dwFlags,; STRING @pbData,; LONG @pdwDataLen
la información contenida en esta transmisión es sólo para el uso personal y confidencial de la persona o entidad a la que va dirigida. Si el lector de este mensaje no es el destinatario o un agente responsable de entregar al destinatario, se le notifica que cualquier revisión, difusión, distribución o copia de este mensaje está estrictamente prohibida. Si usted ha recibido este mensaje por error, por favor notifique al remitente inmediatamente. Gracias.
DECLARE LONG CertOpenSystemStore IN Crypt32; LONG hprov,; STRING szSubsystemProtocol
DECLARE LONG CryptUIDlgSelectCertificateFromStore IN Cryptui; LONG hCertStore,; LONG hWnd, ; STRING @pwszTitle, ; STRING @pwszDisplayString, ; LONG dwDontUseColumn, ; LONG dwFlags,; STRING pvReserved
hStore = CertOpenSystemStore(0, "MY")
pCertContext=0pCertContext=CryptUIDlgSelectCertificateFromStore(hStore , 0, null, null, 1, 0, null)IF pCertContext=0 RETURN .F.ENDIF
*---- Decodificación de certificadoSET STEP ONlcCERT_CONTEXT = SYS(2600, pCertContext, 20)ndwCertEncoTyp = SUBSTR(lcCERT_CONTEXT, 1, 4)pbCertEncoded = SUBSTR(lcCERT_CONTEXT, 5, 4)cbCertEncoded = SUBSTR(lcCERT_CONTEXT, 9, 4)lcCERT_INFO = SUBSTR(lcCERT_CONTEXT, 13, 4)hCertStore = SUBSTR(lcCERT_CONTEXT, 17, 4)
*---- Declaración de Apis para decodificaciónDECLARE LONG CryptBinaryToString IN Crypt32; STRING pbBinary, ; LONG cbBinary, ; LONG dwFlags,; STRING @pszString, ; LONG @pcchString
DECLARE LONG CryptDecodeObject IN crypt32; LONG dwCertEncodingType,; STRING lpszStructType,; STRING pbEncoded,; LONG cbEncoded,; LONG dwFlags,; STRING @pvStructInfo,; LONG @pcbStructInfo
Gracias por el dato, ¿cómo se puede obtener información para hacerlo?.
"Un buen programador nunca muere solo se pierde en un proceso"
DECLARE LONG CertOpenStore IN crypt32; LONG lpszStoreProvider,; LONG dwEncodingType,; LONG hCryptProv,; LONG dwFlags,; STRING pvPara DECLARE LONG CertOpenSystemStore IN crypt32; LONG 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 CryptAcquireCertificatePrivateKey IN crypt32; LONG pCert,; LONG dwFlags,; LONG pvParameters,; LONG @phCryptProvOrNCryptKey,; LONG @pdwKeySpec,; LONG @pfCallerFreeProvOrNCryptKey
DECLARE LONG CryptGetUserKey IN Advapi32; LONG hProv,; LONG dwKeySpec,; LONG @phUserKey
DECLARE LONG CryptExportKey IN Advapi32; LONG hKey,; LONG hExpKey,; LONG dwBlobType,; LONG dwFlags,; STRING @pbData,; LONG @pdwDataLen
*------------------------- CNG DECLARE LONG BCryptOpenAlgorithmProvider IN BCrypt; LONG @phAlgorithm,; STRING pszAlgId,; STRING pszImplementation,; LONG dwFlags
DECLARE LONG BCryptImportKeyPair IN BCrypt; LONG hAlgorithm,; LONG hImportKey,; STRING pszBlobType,; LONG @phKey,; STRING pbInput,; LONG cbInput,; LONG dwFlags
DECLARE LONG BCryptSignHash IN BCrypt; LONG hKey,; LONG @pPaddingInfo,; STRING pbInput,; LONG cbInput,; STRING @pbOutput,; LONG cbOutput,; LONG @pcbResult,; LONG dwFlags
DECLARE LONG BCryptGetProperty IN BCrypt; LONG hObject,; STRING pszProperty,; LONG @pbOutput,; LONG cbOutput,; LONG @pcbResult,; LONG dwFlags
DECLARE LONG BCryptCreateHash IN BCrypt; LONG hAlgorithm,; LONG @phHash,; STRING @pbHashObject,; LONG cbHashObject,; STRING pbSecret,; LONG cbSecret,; LONG dwFlags
DECLARE LONG BCryptHashData IN BCrypt; LONG hHash,; STRING pbInput,; LONG cbInput,; LONG dwFlags
DECLARE LONG BCryptFinishHash IN BCrypt; LONG hHash,; STRING @pbOutput,; LONG cbOutput,; LONG dwFlags
DECLARE LONG BCryptDestroyHash IN BCrypt; LONG hHash
DECLARE LONG BCryptDestroyKey IN BCrypt; LONG hKey
DECLARE LONG BCryptCloseAlgorithmProvider IN BCrypt; LONG hAlgorithm,; LONG dwFlags
*------------------------ KernelDECLARE INTEGER GetLastError IN Kernel32
DECLARE LONG FormatMessage IN Kernel32; LONG dwFlags,; STRING @lpSource,; LONG dwMessageId,; LONG dwLanguageId,; STRING @lpBuffer,; LONG nSize,; LONG Arguments
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*------------------------ CONSTANTES #DEFINE CERT_STORE_PROV_SYSTEM 10 #DEFINE CERT_SYSTEM_STORE_CURRENT_USER 0x00010000#DEFINE CRYPT_ACQUIRE_ALLOW_NCRYPT_KEY_FLAG 0x00010000#DEFINE CRYPT_ACQUIRE_PREFER_NCRYPT_KEY_FLAG 0x00020000#DEFINE CRYPT_ACQUIRE_ONLY_NCRYPT_KEY_FLAG 0x00040000#DEFINE CERT_NCRYPT_KEY_SPEC 0xFFFFFFFF#DEFINE PUBLICKEYBLOB 0x6#DEFINE PRIVATEKEYBLOB 0x7#DEFINE BCRYPT_RSA_ALGORITHM STRCONV("RSA" + CHR(0), 5)#DEFINE BCRYPT_PRIVATE_KEY_BLOB STRCONV("PRIVATEBLOB" + CHR(0), 5)#DEFINE LEGACY_RSAPRIVATE_BLOB STRCONV("CAPIPRIVATEBLOB" + CHR(0), 5)#DEFINE BCRYPT_SHA1_ALGORITHM STRCONV("SHA1" + CHR(0), 5)#DEFINE BCRYPT_PAD_PKCS1 0x00000002#DEFINE BCRYPT_PAD_PSS 0x00000008#DEFINE FORMAT_MESSAGE_FROM_SYSTEM 0x00001000
*----------------------- MAINLOCAL hStore pvPara = STRCONV("MY" + CHR(0), 5) hStore = CertOpenStore(CERT_STORE_PROV_SYSTEM, 0, 0, CERT_SYSTEM_STORE_CURRENT_USER, pvPara) pCertContext=0cTitulo=STRCONV("ATENCION: Seleccione su Certificado"+CHR(0),5)cMensaje=STRCONV("Por favor haga clic en su certificado y Aceptar"+CHR(0),5)pCertContext=CryptUIDlgSelectCertificateFromStore(hStore , 0, cTitulo, cMensaje, 1, 0, null)IF pCertContext=0 =CertCloseStore(hStore, 0) RETURN .F.ENDIFtcParKey = GetPrivateKey(pCertContext)IF EMPTY(tcParKey) MESSAGEBOX("NO SE PUDO EXPORTAR EL PAR DE CLAVES, PROBABLEMENTE ESTA MARCADO COMO NO EXPORTABLE") =CertCloseStore(hStore, 0) RETURN .F.ENDIFtcDataSign = GetDigestValue("<ds:Inicio>Texto que se desea firmar</inicio>", "SHA1")IF EMPTY(tcDataSign) MESSAGEBOX("NO SE CREO EL HASH...NI MODO") =CertCloseStore(hStore, 0) RETURN .F.ENDIFtcSigned = GetSignHash(tcDataSign, tcParKey)IF EMPTY(tcSigned) MESSAGEBOX("NO SE FIRMO ESTA VAINA") =CertCloseStore(hStore, 0) RETURN .F. ENDIF? "Digest Value SHA1: " + TRANSFORM(tcDataSign)?? "Signature: " + STRCONV(tcSigned,13)?? "Longitud de firma: " + TRANSFORM(LEN(STRCONV(tcSigned,13)))?=CertCloseStore(hStore, 0)
PROCEDURE GetPrivateKey(pCertContext) hCryptProv = 0 dwKeySpec = 0 pfCFreProv = 0 nResCPrivK = CryptAcquireCertificatePrivateKey(pCertContext, CRYPT_ACQUIRE_ALLOW_NCRYPT_KEY_FLAG, 0, @hCryptProv, @dwKeySpec, @pfCFreProv) phUserKey = 0 nResCGUK = CryptGetUserKey(hCryptProv, dwKeySpec, @phUserKey) pdwDataLen = 0 nRespEK = CryptExportKey(phUserKey , 0, PRIVATEKEYBLOB, 0, NULL, @pdwDataLen) pbData = SPACE(pdwDataLen) nRespEK = CryptExportKey(phUserKey , 0, PRIVATEKEYBLOB, 0, @pbData, @pdwDataLen) IF EMPTY(pbData) MESSAGEBOX("NO SE PUDO EXPORTAR EL PAR DE CLAVES") ENDIF RETURN pbDataENDPROC
PROCEDURE GetDigestValue(tcData, tcHashAlg) lnAlg = 0 nRespBCOAP = BCryptOpenAlgorithmProvider(@lnAlg, STRCONV(tcHashAlg,5)+CHR(0), NULL, 0) IF nRespBCOAP<>0 MESSAGEBOX("ERROR AL ABRIR ALGORITMO") RETURN "" ENDIF *----- Determinamos cuántos bytes necesitamos para almacenar el objeto hash lnSizeObj = 0 lnData = 0 nRespNCGP = BCryptGetProperty(lnAlg, STRCONV("ObjectLength",5)+CHR(0), @lnSizeObj, 4, @lnData, 0) IF nRespNCGP<>0 MESSAGEBOX("ERROR AL OBTENER PROPIEDAD DE ENCRIPTACION") RETURN "" ENDIF *----- Determinamos la longitud de valor hash lnSizeHash = 0 nRespNCGP = BCryptGetProperty(lnAlg, STRCONV("HashDigestLength",5)+CHR(0), @lnSizeHash, 4, @lnData, 0) IF nRespNCGP<>0 MESSAGEBOX("ERROR AL OBTENER PROPIEDAD DE ENCRIPTACION") RETURN "" ENDIF *----- Creamos un objeto Hash LOCAL lnHash, lcHashObj lnHash = 0 lcHashObj = SPACE(lnSizeObj) nRespBCCH = BCryptCreateHash(lnAlg, @lnHash, @lcHashObj, lnSizeObj, NULL, 0, 0) IF nRespBCCH<>0 MESSAGEBOX("ERROR AL CREAR OBJETO HASH") RETURN "" ENDIF *----- Para crear el valor hash agregamos datos al objeto hash. Puede repetir este paso según sea necesario nLenData = LEN(tcData) nRespBCHD = BCryptHashData(lnHash, tcData, nLenData, 0) IF nRespBCHD<>0 nRespBCHD = BCryptHashData(lnHash, tcData, nLenData, 0) IF nRespBCHD<>0 =GetMensajeError(nRespBCHD) RETURN "" ENDIF ENDIF *----- Indicamos al objeto hash que hemos terminado. El algoritmo ahora calcula el valor de hash y lo devuelve. lcHash = SPACE(lnSizeHash) =BCryptFinishHash(lnHash, @lcHash, lnSizeHash, 0) IF lnAlg<>0 BCryptCloseAlgorithmProvider(lnAlg, 0) ENDIF IF lnHash<>0 BCryptDestroyHash(lnHash) ENDIF lcHash15 = STRCONV(lcHash,13) && HexBinary ~ 16 format RETURN lcHash15ENDPROC
PROCEDURE GetSignHash(tcDataSign, tcParKey) lcSigned = "" lnAlg = 0 lnRes = BCryptOpenAlgorithmProvider(@lnAlg, BCRYPT_RSA_ALGORITHM, NULL, 0) lnKey = 0 lnRes = BCryptImportKeyPair(lnAlg, 0, LEGACY_RSAPRIVATE_BLOB, @lnKey, tcParKey, LEN(tcParKey), 0) IF lnRes = 0 lnAlgoString = HeapAlloc(GetProcessHeap(), 0, LEN(BCRYPT_SHA1_ALGORITHM)) IF lnAlgoString <> 0 SYS(2600, lnAlgoString, LEN(BCRYPT_SHA1_ALGORITHM), BCRYPT_SHA1_ALGORITHM) lnSize = 0 lnRes = BCryptSignHash(lnKey, @lnAlgoString, tcDataSign, LEN(tcDataSign), NULL, 0, @lnSize, 8) IF lnRes = 0 *---- Firmamos la cadena de datos lcSigned = SPACE(lnSize) lnRes = BCryptSignHash(lnKey, @lnAlgoString, tcDataSign, LEN(tcDataSign), @lcSigned, lnSize, @lnSize, 8) IF lnRes = 0 *---- EXITO! lcSigned = LEFT(lcSigned, lnSize) ELSE *---- fracaso lcSigned = "" ENDIF ENDIF HeapFree(GetProcessHeap(), 0, lnAlgoString) ENDIF BCryptDestroyKey(lnKey) ENDIF BCryptCloseAlgorithmProvider(lnAlg, 0) RETURN lcSignedENDPROC
PROCEDURE GetMensajeError(tcNumError) IF VARTYPE(tcNumError)=="N" lnErrorCode = tcNumError 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
"Un equipo solo son piezas que intercambias hasta que terminas el trabajo, es eficiente, funciona."
Fernando,
Enviar información al correo
di...@hassler.ec
Gracias
Aquí esta un ejemplo bastante completo, adicional a esto aprendan a canonalizar datos para realizar correctamente los digest-values y el firmado de los mismo. Aquí hay un portal que es de gran ayuda, mejor explicado que ese portal imposible. Revisen la parte 1 y 2 de esta web. https://www.di-mgt.com.au/xmldsig2.htmlComenzamos el 2019 con pie derecho.... agradecer no cuesta nada. saludos a todos y bendiciones.
DECLARE LONG CertOpenStore IN crypt32;LONG lpszStoreProvider,;LONG dwEncodingType,;LONG hCryptProv,;LONG dwFlags,;STRING pvParaDECLARE LONG CertOpenSystemStore IN crypt32;LONG hprov,;STRING szSubsystemProtocolDECLARE 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 CryptAcquireCertificatePrivateKey IN crypt32;LONG pCert,;LONG dwFlags,;LONG pvParameters,;LONG @phCryptProvOrNCryptKey,;LONG @pdwKeySpec,;LONG @pfCallerFreeProvOrNCryptKeyDECLARE LONG CryptGetUserKey IN Advapi32;LONG hProv,;LONG dwKeySpec,;LONG @phUserKeyDECLARE LONG CryptExportKey IN Advapi32;LONG hKey,;LONG hExpKey,;LONG dwBlobType,;LONG dwFlags,;STRING @pbData,;LONG @pdwDataLen*------------------------- CNGDECLARE LONG BCryptOpenAlgorithmProvider IN BCrypt;LONG @phAlgorithm,;STRING pszAlgId,;STRING pszImplementation,;LONG dwFlagsDECLARE LONG BCryptImportKeyPair IN BCrypt;LONG hAlgorithm,;LONG hImportKey,;STRING pszBlobType,;LONG @phKey,;STRING pbInput,;LONG cbInput,;LONG dwFlagsDECLARE LONG BCryptSignHash IN BCrypt;LONG hKey,;LONG @pPaddingInfo,;STRING pbInput,;LONG cbInput,;STRING @pbOutput,;LONG cbOutput,;LONG @pcbResult,;LONG dwFlagsDECLARE LONG BCryptGetProperty IN BCrypt;LONG hObject,;STRING pszProperty,;LONG @pbOutput,;LONG cbOutput,;LONG @pcbResult,;LONG dwFlagsDECLARE LONG BCryptCreateHash IN BCrypt;LONG hAlgorithm,;LONG @phHash,;STRING @pbHashObject,;LONG cbHashObject,;STRING pbSecret,;LONG cbSecret,;LONG dwFlagsDECLARE LONG BCryptHashData IN BCrypt;LONG hHash,;STRING pbInput,;LONG cbInput,;LONG dwFlagsDECLARE LONG BCryptFinishHash IN BCrypt;LONG hHash,;STRING @pbOutput,;LONG cbOutput,;LONG dwFlagsDECLARE LONG BCryptDestroyHash IN BCrypt;LONG hHashDECLARE LONG BCryptDestroyKey IN BCrypt;LONG hKeyDECLARE LONG BCryptCloseAlgorithmProvider IN BCrypt;LONG hAlgorithm,;LONG dwFlags*------------------------ KernelDECLARE INTEGER GetLastError IN Kernel32DECLARE LONG FormatMessage IN Kernel32;LONG dwFlags,;STRING @lpSource,;LONG dwMessageId,;LONG dwLanguageId,;STRING @lpBuffer,;LONG nSize,;LONG ArgumentsDECLARE LONG GetProcessHeap IN Kernel32DECLARE LONG HeapAlloc IN Kernel32;LONG hHeap,;LONG dwFlags,;LONG dwBytesDECLARE LONG HeapFree IN Kernel32;LONG hHeap,;LONG dwFlags,;LONG lpMem*------------------------ CONSTANTES#DEFINE CERT_STORE_PROV_SYSTEM 10#DEFINE CERT_SYSTEM_STORE_CURRENT_USER 0x00010000#DEFINE CRYPT_ACQUIRE_ALLOW_NCRYPT_KEY_FLAG 0x00010000#DEFINE CRYPT_ACQUIRE_PREFER_NCRYPT_KEY_FLAG 0x00020000#DEFINE CRYPT_ACQUIRE_ONLY_NCRYPT_KEY_FLAG 0x00040000#DEFINE CERT_NCRYPT_KEY_SPEC 0xFFFFFFFF#DEFINE PUBLICKEYBLOB 0x6#DEFINE PRIVATEKEYBLOB 0x7#DEFINE BCRYPT_RSA_ALGORITHM STRCONV("RSA" + CHR(0), 5)#DEFINE BCRYPT_PRIVATE_KEY_BLOB STRCONV("PRIVATEBLOB" + CHR(0), 5)#DEFINE LEGACY_RSAPRIVATE_BLOB STRCONV("CAPIPRIVATEBLOB" + CHR(0), 5)#DEFINE BCRYPT_SHA1_ALGORITHM STRCONV("SHA1" + CHR(0), 5)#DEFINE BCRYPT_PAD_PKCS1 0x00000002#DEFINE BCRYPT_PAD_PSS 0x00000008#DEFINE FORMAT_MESSAGE_FROM_SYSTEM 0x00001000*----------------------- MAINLOCAL hStorepvPara = STRCONV("MY" + CHR(0), 5)hStore = CertOpenStore(CERT_STORE_PROV_SYSTEM, 0, 0, CERT_SYSTEM_STORE_CURRENT_USER, pvPara)pCertContext=0cTitulo=STRCONV("ATENCION: Seleccione su Certificado"+CHR(0),5)cMensaje=STRCONV("Por favor haga clic en su certificado y Aceptar"+CHR(0),5)pCertContext=CryptUIDlgSelectCertificateFromStore(hStore , 0, cTitulo, cMensaje, 1, 0, null)IF pCertContext=0=CertCloseStore(hStore, 0)RETURN .F.ENDIFtcParKey = GetPrivateKey(pCertContext)IF EMPTY(tcParKey)MESSAGEBOX("NO SE PUDO EXPORTAR EL PAR DE CLAVES, PROBABLEMENTE ESTA MARCADO COMO NO EXPORTABLE")=CertCloseStore(hStore, 0)RETURN .F.ENDIFtcDataSign = GetDigestValue("<ds:Inicio>Texto que se desea firmar</inicio>", "SHA1")IF EMPTY(tcDataSign)MESSAGEBOX("NO SE CREO EL HASH...NI MODO")=CertCloseStore(hStore, 0)RETURN .F.ENDIFtcSigned = GetSignHash(tcDataSign, tcParKey)IF EMPTY(tcSigned)MESSAGEBOX("NO SE FIRMO ESTA VAINA")=CertCloseStore(hStore, 0)RETURN .F.ENDIF? "Digest Value SHA1: " + TRANSFORM(tcDataSign)?? "Signature: " + STRCONV(tcSigned,13)?? "Longitud de firma: " + TRANSFORM(LEN(STRCONV(tcSigned,13)))?=CertCloseStore(hStore, 0)PROCEDURE GetPrivateKey(pCertContext)hCryptProv = 0dwKeySpec = 0pfCFreProv = 0nResCPrivK = CryptAcquireCertificatePrivateKey(pCertContext, CRYPT_ACQUIRE_ALLOW_NCRYPT_KEY_FLAG, 0, @hCryptProv, @dwKeySpec, @pfCFreProv)phUserKey = 0nResCGUK = CryptGetUserKey(hCryptProv, dwKeySpec, @phUserKey)pdwDataLen = 0nRespEK = CryptExportKey(phUserKey , 0, PRIVATEKEYBLOB, 0, NULL, @pdwDataLen)pbData = SPACE(pdwDataLen)nRespEK = CryptExportKey(phUserKey , 0, PRIVATEKEYBLOB, 0, @pbData, @pdwDataLen)IF EMPTY(pbData)MESSAGEBOX("NO SE PUDO EXPORTAR EL PAR DE CLAVES")ENDIFRETURN pbDataENDPROCPROCEDURE GetDigestValue(tcData, tcHashAlg)lnAlg = 0nRespBCOAP = BCryptOpenAlgorithmProvider(@lnAlg, STRCONV(tcHashAlg,5)+CHR(0), NULL, 0)IF nRespBCOAP<>0MESSAGEBOX("ERROR AL ABRIR ALGORITMO")RETURN ""ENDIF*----- Determinamos cuántos bytes necesitamos para almacenar el objeto hashlnSizeObj = 0lnData = 0nRespNCGP = BCryptGetProperty(lnAlg, STRCONV("ObjectLength",5)+CHR(0), @lnSizeObj, 4, @lnData, 0)IF nRespNCGP<>0MESSAGEBOX("ERROR AL OBTENER PROPIEDAD DE ENCRIPTACION")RETURN ""ENDIF*----- Determinamos la longitud de valor hashlnSizeHash = 0nRespNCGP = BCryptGetProperty(lnAlg, STRCONV("HashDigestLength",5)+CHR(0), @lnSizeHash, 4, @lnData, 0)IF nRespNCGP<>0MESSAGEBOX("ERROR AL OBTENER PROPIEDAD DE ENCRIPTACION")RETURN ""ENDIF*----- Creamos un objeto HashLOCAL lnHash, lcHashObjlnHash = 0lcHashObj = SPACE(lnSizeObj)nRespBCCH = BCryptCreateHash(lnAlg, @lnHash, @lcHashObj, lnSizeObj, NULL, 0, 0)IF nRespBCCH<>0MESSAGEBOX("ERROR AL CREAR OBJETO HASH")RETURN ""ENDIF*----- Para crear el valor hash agregamos datos al objeto hash. Puede repetir este paso según sea necesarionLenData = LEN(tcData)nRespBCHD = BCryptHashData(lnHash, tcData, nLenData, 0)IF nRespBCHD<>0nRespBCHD = BCryptHashData(lnHash, tcData, nLenData, 0)IF nRespBCHD<>0=GetMensajeError(nRespBCHD)RETURN ""ENDIFENDIF*----- Indicamos al objeto hash que hemos terminado. El algoritmo ahora calcula el valor de hash y lo devuelve.lcHash = SPACE(lnSizeHash)=BCryptFinishHash(lnHash, @lcHash, lnSizeHash, 0)IF lnAlg<>0BCryptCloseAlgorithmProvider(lnAlg, 0)ENDIFIF lnHash<>0BCryptDestroyHash(lnHash)ENDIFlcHash15 = STRCONV(lcHash,13) && HexBinary ~ 16 formatRETURN lcHash15ENDPROCPROCEDURE GetSignHash(tcDataSign, tcParKey)lcSigned = ""lnAlg = 0lnRes = BCryptOpenAlgorithmProvider(@lnAlg, BCRYPT_RSA_ALGORITHM, NULL, 0)lnKey = 0lnRes = BCryptImportKeyPair(lnAlg, 0, LEGACY_RSAPRIVATE_BLOB, @lnKey, tcParKey, LEN(tcParKey), 0)IF lnRes = 0lnAlgoString = HeapAlloc(GetProcessHeap(), 0, LEN(BCRYPT_SHA1_ALGORITHM))IF lnAlgoString <> 0SYS(2600, lnAlgoString, LEN(BCRYPT_SHA1_ALGORITHM), BCRYPT_SHA1_ALGORITHM)lnSize = 0lnRes = BCryptSignHash(lnKey, @lnAlgoString, tcDataSign, LEN(tcDataSign), NULL, 0, @lnSize, 8)IF lnRes = 0*---- Firmamos la cadena de datoslcSigned = SPACE(lnSize)lnRes = BCryptSignHash(lnKey, @lnAlgoString, tcDataSign, LEN(tcDataSign), @lcSigned, lnSize, @lnSize, 8)IF lnRes = 0*---- EXITO!lcSigned = LEFT(lcSigned, lnSize)ELSE*---- fracasolcSigned = ""ENDIFENDIFHeapFree(GetProcessHeap(), 0, lnAlgoString)ENDIFBCryptDestroyKey(lnKey)ENDIFBCryptCloseAlgorithmProvider(lnAlg, 0)RETURN lcSignedENDPROCPROCEDURE GetMensajeError(tcNumError)IF VARTYPE(tcNumError)=="N"lnErrorCode = tcNumErrorELSElnErrorCode = GetLastError()ENDIFlpBuffer = SPACE(128)=FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 'WINERROR.H', lnErrorCode, 0, @lpBuffer, 128 , 0)=MESSAGEBOX(lpBuffer, 16, "Error: " + TRANSFORM(lnErrorCode,"@0"))ENDPROC
Hola Fernando.
Agregando Info a lo q quiere hacer Diego, la firma de AFIP en Argentina, a parte de ser en b64, el xml contiene un certificado + una clave privada de 2048, lo veo complicado de resolver, pero… todo es posible.
Ojalá se pudiera sacar, actualmente esto lo resuelve en forma excelente el OpenSsl, pero sería genial resolverlo desde VFP con Apis.
Saludos
Esteban
*--------------- CryptoApi CSP
DECLARE LONG CertOpenSystemStore IN crypt32; LONG hprov,; STRING szSubsystemProtocol
DECLARE LONG CryptUIDlgSelectCertificateFromStore IN Cryptui; LONG hCertStore,; LONG hWnd,; STRING @pwszTitle,; STRING @pwszDisplayString,; LONG dwDontUseColumn,; LONG dwFlags,; STRING pvReserved
DECLARE LONG CryptSignMessage IN Crypt32; STRING @pSignPara,; LONG fDetachedSignature,; INTEGER cToBeSigned,; STRING @rgpbToBeSigned,; STRING @rgcbToBeSigned,; STRING @pbSignedBlob,; LONG @pcbSignedBlob
DECLARE LONG CryptVerifyMessageSignature IN Crypt32; STRING @pVerifyPara,; LONG dwSignerIndex,; STRING pbSignedBlob,; LONG cbSignedBlob,; STRING @pbDecoded,; LONG pcbDecoded,; LONG ppSignerCert
DECLARE LONG CertFreeCertificateContext IN Crypt32; LONG pCertContext
DECLARE LONG CertCloseStore IN Crypt32; LONG hCertStore,; LONG dwFlag
*--------------- KernelDECLARE LONG GetLastError IN Kernel32
DECLARE LONG FormatMessage IN Kernel32; LONG dwFlags,; STRING @lpSource,; LONG dwMessageId,; LONG dwLanguageId,; STRING @lpBuffer,; LONG nSize,; LONG Arguments
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
*------------ Constantes#DEFINE PKCS_7_ASN_ENCODING 0x00010000 #DEFINE X509_ASN_ENCODING 0x00000001#DEFINE FORMAT_MESSAGE_FROM_SYSTEM 0x00001000
*------------ MaincFileXML=GETFILE("XML", "Xml a Firmar")IF EMPTY(cFileXML) RETURN .F.ENDIFhStore = CertOpenSystemStore(0, "MY")pCertContext=CryptUIDlgSelectCertificateFromStore(hStore , 0, NULL, NULL, 1, 0, NULL)
IF pCertContext=0 =CertCloseStore(hStore, 0) RETURN .F.ENDIF
lcSignature=GetSignXml(cFileXML, pCertContext)IF !EMPTY(lcSignature) ? STRCONV(lcSignature,13) lbReturn=.T.ELSE lbReturn=.F.ENDIF=CertCloseStore(hStore, 0)=CertFreeCertificateContext(pCertContext)RETURN lbReturn
*--------------- Región de ProceduresPROCEDURE GetSignXml(tcPathFileXml, tpCertContext) *SET STEP ON lcCertInfo = GetCertInfoStructure(tpCertContext) lcOID = GetSignatureAlgorithm(lcCertInfo) IF EMPTY(lcOID) MESSAGEBOX("No se encontró un algoritmo de firma en este certificado", 16, _SCREEN.Caption) RETURN "" ENDIF *----- Creamos Puntero de Memoria y colocamos el algoritmo de firma lpOID = HeapAlloc(GetProcessHeap(), 0, LEN(lcOID)) RtlMoveMemory(lpOID, @lcOID, LEN(lcOID)) *----- Creamos Puntero de Memoria y colocamos el Certificado lpCertificate = 0h + BINTOC(tpCertContext,"4RS") lpRgpMsgCert = HeapAlloc(GetProcessHeap(), 0, LEN(lpCertificate)) RtlMoveMemory(lpRgpMsgCert, @lpCertificate, LEN(lpCertificate)) *----- Armamos la Estructura CRYPT_SIGN_MESSAGE_PARA lnLenSP = 68 && (17 estructuras * 4 ) nMsgCert = 1 cbSize = BINTOC(lnLenSP,"4RS") dwMsgEncodingType = BINTOC(BITOR(PKCS_7_ASN_ENCODING, X509_ASN_ENCODING),"4RS") pSigningCert = BINTOC(tpCertContext,"4RS") HashAlgorithm = BINTOC(lpOID,"4RS") pvHashAuxInfo = REPLICATE(CHR(0), 12) && Se probo 4,8,12, funciona 12 ¿¿?? cMsgCert = BINTOC(nMsgCert,"4RS") rgpMsgCert = BINTOC(lpRgpMsgCert,"4RS") *----- Resto de estructuras opcionales, rellenar con CHR(0) *cMsgCrl, rgpMsgCrl, cAuthAttr, rgAuthAttr, cUnauthAttr, rgUnauthAttr, *dwFlags, dwInnerContentType, HashEncryptionAlgorithm, pvHashEncryptionAuxInfo pSignPara = 0h + cbSize + dwMsgEncodingType + pSigningCert + HashAlgorithm + pvHashAuxInfo + cMsgCert + rgpMsgCert nlenpSign = LEN(pSignPara) pSignPara = pSignPara + REPLICATE(CHR(0), lnLenSP-nlenpSign) *----- Cargamos el archivo Xml a Firmar lcFileXmlIn = tcPathFileXml lcXmlString = FILETOSTR(lcFileXmlIn) *----- Colocamos la cadena Xml dentro de un puntero lpByToSigned = HeapAlloc(GetProcessHeap(), 0, LEN(lcXmlString)) RtlMoveMemory(lpByToSigned, @lcXmlString, LEN(lcXmlString)) *----- Procedemos a Firmar el Xml rgpbToBeSigned = 0h + BINTOC(lpByToSigned, "4RS") lnXmlStrLen = LEN(lcXmlString) rgcbToBeSigned = 0h + BINTOC(lnXmlStrLen, "4RS") pcbSignedBlob = 0 pbSignedBlob = "" IF CryptSignMessage(@pSignPara, 1, 1, @rgpbToBeSigned, @rgcbToBeSigned, @pbSignedBlob, @pcbSignedBlob)=0 pbSignedBlob = SPACE(pcbSignedBlob) IF CryptSignMessage(@pSignPara, 1, 1, @rgpbToBeSigned, @rgcbToBeSigned, @pbSignedBlob, @pcbSignedBlob)=0 =GetMensajeError() ENDIF ENDIF *----- Liberamos los punteros de memoria HeapFree(GetProcessHeap(), 0, lpByToSigned) HeapFree(GetProcessHeap(), 0, lpRgpMsgCert) HeapFree(GetProcessHeap(), 0, lpOID) RETURN pbSignedBlobENDPROC
PROCEDURE GetCertInfoStructure(pCertContext) lcCERT_CONTEXT = SYS(2600, pCertContext, 20) lcCertInfo = SUBSTR(lcCERT_CONTEXT, 13, 4) lpCertInfo = CTOBIN(lcCertInfo, "4RS") lcCERT_INFO = SYS(2600, lpCertInfo, 112) RETURN lcCERT_INFOENDPROC
PROCEDURE GetSignatureAlgorithm(lcCERT_INFO) lcSignAlgoritm = SUBSTR(lcCERT_INFO,13,12) lpSignAlgoritm1 = CTOBIN(SUBSTR(lcSignAlgoritm, 1, 4),"4RS") lpSignAlgoritm2 = CTOBIN(SUBSTR(lcSignAlgoritm, 5, 4),"4RS") lpSignAlgoritm3 = CTOBIN(SUBSTR(lcSignAlgoritm, 9, 4),"4RS") lStrSignAlgorit = SYS(2600, lpSignAlgoritm1, 25) lStrParaAlgorit = SYS(2600, lpSignAlgoritm3, lpSignAlgoritm2) cStrSignAlgorit = STRTRAN(STREXTRACT(lStrSignAlgorit,LEFT(lStrSignAlgorit,1),CHR(0),1,4),CHR(0),"") cStrParaAlgorit = TRANSFORM(STRCONV(lStrParaAlgorit,15)) RETURN cStrSignAlgorit
? "Longitud de firma en b64: " + TRANSFORM(LEN(STRCONV(lcSignature,13)))
lbReturn=.T.ELSE lbReturn=.F.ENDIF=CertCloseStore(hStore, 0)=CertFreeCertificateContext(pCertContext)RETURN lbReturn
*--------------- Región de ProceduresPROCEDURE GetSignXml(tcPathFileXml, tpCertContext)
SET STEP ON *----- Creamos Puntero de Memoria, colocamos el algoritmo de firma y armamos estructura CRYPT_ALGORITHM_IDENTIFIER lcOID = "1.2.840.113549.1.1.5" && szOID_RSA_SHA1RSA
lpOID = HeapAlloc(GetProcessHeap(), 0, LEN(lcOID)) RtlMoveMemory(lpOID, @lcOID, LEN(lcOID))
CRYPT_ALGORITHM_IDENTIFIER = 0h + BINTOC(lpOID,"4RS") + BINTOC(0, "4RS")
*----- Creamos Puntero de Memoria y colocamos el Certificado lpCertificate = 0h + BINTOC(tpCertContext,"4RS") lpRgpMsgCert = HeapAlloc(GetProcessHeap(), 0, LEN(lpCertificate)) RtlMoveMemory(lpRgpMsgCert, @lpCertificate, LEN(lpCertificate)) *----- Armamos la Estructura CRYPT_SIGN_MESSAGE_PARA lnLenSP = 68 && (17 estructuras * 4 ) nMsgCert = 1 cbSize = BINTOC(lnLenSP,"4RS") dwMsgEncodingType = BINTOC(BITOR(PKCS_7_ASN_ENCODING, X509_ASN_ENCODING),"4RS") pSigningCert = BINTOC(tpCertContext,"4RS")
HashAlgorithm = CRYPT_ALGORITHM_IDENTIFIER *pvHashAuxInfo = REPLICATE(CHR(0), 8) && Se probo 4,8,12, ¿¿?? pvHashAuxInfo = BINTOC(0, "4RS") + BINTOC(0, "4RS")
cMsgCert = BINTOC(nMsgCert,"4RS") rgpMsgCert = BINTOC(lpRgpMsgCert,"4RS") *----- Resto de estructuras opcionales, rellenar con CHR(0) *cMsgCrl, rgpMsgCrl, cAuthAttr, rgAuthAttr, cUnauthAttr, rgUnauthAttr, *dwFlags, dwInnerContentType, HashEncryptionAlgorithm, pvHashEncryptionAuxInfo pSignPara = 0h + cbSize + dwMsgEncodingType + pSigningCert + HashAlgorithm + pvHashAuxInfo + cMsgCert + rgpMsgCert nlenpSign = LEN(pSignPara) pSignPara = pSignPara + REPLICATE(CHR(0), lnLenSP-nlenpSign)
*----- Cargamos el archivo Xml a Firmar teminado en NULO (probar) lcFileXmlIn = tcPathFileXml lcXmlString = FILETOSTR(lcFileXmlIn)+CHR(0)
PROCEDURE GetImportPFX PARAMETERS tcArchivoPfx AS String, tcPassword AS String IF EMPTY(tcArchivoPfx) MESSAGEBOX("Ingrese un archivo de certificado digital para importar", 16, _SCREEN.Caption) RETURN 0 ENDIF *----- Armamos la Estructura CRYPT_DATA_BLOB StrPfx = FILETOSTR(tcArchivoPfx) cbData = LEN(StrPfx)
pbData = HeapAlloc(GetProcessHeap(), 0, cbData)
RtlMoveMemory(pbData, @StrPfx, cbData)
pPFX = 0h + BINTOC(cbData,"4RS") + BINTOC(pbData, "4RS")
*----- Verificamos que el archivo sea certificado Pfx, P12 IF PFXIsPFXBlob(pPFX)=0 MESSAGEBOX( "El archivo no es un PFX/P12 válido", 16, _SCREEN.Caption) HeapFree(GetProcessHeap(), 0, pbData) RETURN .F. ENDIF *----- Capturamos el Password cPassword = STRCONV(tcPassword,5) + CHR(0) *----- Verificamos el Password IF PFXVerifyPassword(pPFX, cPassword, 0)=0 MESSAGEBOX("Contraseña incorrecta", 16, _SCREEN.Caption) HeapFree(GetProcessHeap(), 0, pbData) RETURN 0 ENDIF *----- Importamos el o los certificados (pueden venir varios epaquetados en un P12 o PFX) hStoreHandle = 0 hStoreHandle = PFXImportCertStore(pPFX, cPassword, CRYPT_EXPORTABLE) cPassword = "" pPFX = "" HeapFree(GetProcessHeap(), 0, pbData) IF hStoreHandle=0 THIS.GetMessageError() RETURN 0 ENDIF RETURN hStoreHandleENDPROC
Felicitaciones p Diego y tb p vos Fernando, q diste el puntapié inicial p poder lograr esto en VFP.
Yo actualmente firmo el xml con OpenSSL, lo cierto es q VFP no necesita q el certificado sea en formato PFX/P12, con el OpenSSL y el archivo crt + la Key es suficiente p hacer el firmado. ( AFIP Argentina )
Donde disponga de + tiempo, voy a mirar bien lo q Diego ha logrado con la modificación de tu código inicial.
Saludos
Esteban
PROCEDURE GetImportPrivateKeyToCng
PARAMETERS tcFileKey AS String
SET STEP ON
cStringKey = ALLTRIM(FILETOSTR(tcFileKey))
IF EMPTY(cStringKey)
MESSAGEBOX("El archivo esta vacio", 16, _SCREEN.Caption)
RETURN 0
ENDIF
*------- Decodificamos el archivo
dwBufferLen=0
pdwSkip=0
pdwFlags=0
nResp = CryptStringToBinary(cStringKey, 0, CRYPT_STRING_ANY, NULL, @dwBufferLen, @pdwSkip, @pdwFlags)
DO CASE
CASE pdwFlags=0
*------- Base64, with certificate beginning and ending headers.
lcPrivKey=STREXTRACT(cStringKey, "-----BEGIN RSA PRIVATE KEY-----", "-----END RSA PRIVATE KEY-----")
IF EMPTY(lcPrivKey)
lcPrivKey=STREXTRACT(cStringKey, "-----BEGIN ENCRYPTED PRIVATE KEY-----", "-----END ENCRYPTED PRIVATE KEY-----")
ENDIF
lcPrivKey=STRCONV(lcPrivKey,14)
CASE pdwFlags=1
*------- Base64, without headers.
lcPrivKey=STRCONV(cStringKey,14)
CASE pdwFlags=2
*------- Pure binary copy.
lcPrivKey=cStringKey
ENDCASE
*------- Decodificamos la cadena ASN1
dwCertEncodingType = BITOR(PKCS_7_ASN_ENCODING, X509_ASN_ENCODING)
lpszStructType = "43" + CHR(0)
pbEncoded = lcPrivKey
cbEncoded = LEN(lcPrivKey)
cbKeyBlob = 0
nResp=CryptDecodeObjectEx(dwCertEncodingType, lpszStructType, pbEncoded, cbEncoded, 0, NULL, NULL, @cbKeyBlob)
IF cbKeyBlob=0
THIS.GetMessageerror()
RETURN 0
ENDIF
pbKeyBlob = SPACE(pbKeyBlob)
nResp=CryptDecodeObjectEx(dwCertEncodingType, lpszStructType, pbEncoded, cbEncoded, 0, NULL, @pbKeyBlob, @cbKeyBlob)
*------- Adqurimos un proveedor criptografico
hProv=0
nResp=CryptAcquireContext(@hProv, NULL, MS_ENHANCED_PROV, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT)
hKey=0
CryptImportKey(hProv, lcPrivKey, cbEncoded, 0, 0, @hKey)
*------- Abrimos un proveedor de algoritmo
pszAlgId = STRCONV("RSA" + CHR(0), 5)
lnAlg = 0
lnRes = BCryptOpenAlgorithmProvider(@lnAlg, pszAlgId, NULL, 0)
IF lnRes <> 0
MESSAGEBOX("No se pudo apertura el proveedor de algoritmo", 16, _SCREEN.Caption)
RETURN 0
ENDIF
*-------- Importamos el par de claves, probamos con varios formatos
pszBlobType01 = STRCONV("PRIVATEBLOB" + CHR(0), 5)
pszBlobType02 = STRCONV("CAPIPRIVATEBLOB" + CHR(0), 5)
pszBlobType03 = STRCONV("DHPRIVATEBLOB" + CHR(0), 5)
pszBlobType04 = STRCONV("DSAPRIVATEBLOB" + CHR(0), 5)
pszBlobType05 = STRCONV("ECCPRIVATEBLOB" + CHR(0), 5)
pszBlobType06 = STRCONV("RSAPRIVATEBLOB" + CHR(0), 5)
pszBlobType07 = STRCONV("CAPIDHPRIVATEBLOB" + CHR(0), 5)
pszBlobType08 = STRCONV("CAPIDSAPRIVATEBLOB" + CHR(0), 5)
pszBlobType09 = STRCONV("V2CAPIDSAPRIVATEBLOB" + CHR(0), 5)
lnKey = 0
DO CASE
CASE BCryptImportKeyPair(lnAlg, 0, pszBlobType01, @lnKey, lcPrivKey, LEN(lcPrivKey), 0)==0
CASE BCryptImportKeyPair(lnAlg, 0, pszBlobType02, @lnKey, lcPrivKey, LEN(lcPrivKey), 0)==0
CASE BCryptImportKeyPair(lnAlg, 0, pszBlobType03, @lnKey, lcPrivKey, LEN(lcPrivKey), 0)==0
CASE BCryptImportKeyPair(lnAlg, 0, pszBlobType04, @lnKey, lcPrivKey, LEN(lcPrivKey), 0)==0
CASE BCryptImportKeyPair(lnAlg, 0, pszBlobType05, @lnKey, lcPrivKey, LEN(lcPrivKey), 0)==0
CASE BCryptImportKeyPair(lnAlg, 0, pszBlobType06, @lnKey, lcPrivKey, LEN(lcPrivKey), 0)==0
CASE BCryptImportKeyPair(lnAlg, 0, pszBlobType07, @lnKey, lcPrivKey, LEN(lcPrivKey), 0)==0
CASE BCryptImportKeyPair(lnAlg, 0, pszBlobType08, @lnKey, lcPrivKey, LEN(lcPrivKey), 0)==0
CASE BCryptImportKeyPair(lnAlg, 0, pszBlobType09, @lnKey, lcPrivKey, LEN(lcPrivKey), 0)==0
OTHERWISE
MESSAGEBOX("No se pudo importar el par de claves."+CHR(13)+"revise que el archivo key tenga el formato correcto", 16, _SCREEN.Caption)
ENDCASE
BCryptCloseAlgorithmProvider(lnAlg, 0)
RETURN lnKey
ENDPROC
PROCEDURE GetImportCert(tcFilePemOrCer AS String) cStringCert=FILETOSTR(tcFilePemOrCer) IF EMPTY(cStringCert)
MESSAGEBOX("El archivo esta vacio", 16, _SCREEN.Caption) RETURN 0 ENDIF
dwCertEncodingType = BITOR(PKCS_7_ASN_ENCODING, X509_ASN_ENCODING) pCertContext = 0 IF "BEGIN CERTIFICATE"$cStringCert pbCertEncoded=STREXTRACT(cStringCert, "-----BEGIN CERTIFICATE-----", "-----END CERTIFICATE-----") IF EMPTY(pbCertEncoded) MESSAGEBOX("No se detecto datos en el certificado", 16, _SCREEN.Caption) RETURN 0 ENDIF pbCertEncoded = STRCONV(ALLTRIM(STRTRAN(pbCertEncoded, CHR(0), "")),14) cbCertEncoded = LEN(pbCertEncoded) pCertContext = CertCreateCertificateContext(dwCertEncodingType, pbCertEncoded, cbCertEncoded) ELSE pbCertEncoded = cStringCert cbCertEncoded = LEN(pbCertEncoded) pCertContext = CertCreateCertificateContext(dwCertEncodingType, pbCertEncoded, cbCertEncoded) IF pCertContext=0 pbCertEncoded = STRCONV(cStringCert,14) cbCertEncoded = LEN(pbCertEncoded) pCertContext = CertCreateCertificateContext(dwCertEncodingType, pbCertEncoded, cbCertEncoded) ENDIF ENDIF IF pCertContext=0 MESSAGEBOX("No se pudo importar el certificado", 16, _SCREEN.Caption) ENDIF RETURN pCertContextENDPROC
*------------ CRYPTO API CSP (Cryptographic Service Providers)*------------ Crypt32.DLLDECLARE LONG CertCreateCertificateContext IN Crypt32; LONG dwCertEncodingType,; STRING pbCertEncoded,; LONG cbCertEncoded
DECLARE LONG CryptBinaryToString IN Crypt32; STRING pbBinary, ; LONG cbBinary, ; LONG dwFlags,; STRING @pszString, ; LONG @pcchString
DECLARE LONG CryptStringToBinary IN Crypt32; STRING @pszString, ; LONG cchString, ; LONG dwFlags,; STRING @pbBinary, ; LONG @pcbBinary,; LONG @pdwSkip, ; LONG @pdwFlags
DECLARE LONG CryptEncodeObject IN Crypt32; LONG dwCertEncodingType,; STRING lpszStructType,; STRING pvStructInfo,; STRING @pbEncoded,; LONG @pcbEncoded
DECLARE LONG CryptEncodeObjectEx IN Crypt32; LONG dwCertEncodingType,; STRING lpszStructType,; STRING pvStructInfo,; LONG dwFlags,; STRING pEncodePara,; STRING @pvEncoded,; LONG @pcbEncoded
DECLARE LONG CryptDecodeObject IN Crypt32; LONG dwCertEncodingType,; STRING lpszStructType,; STRING pbEncoded,; LONG cbEncoded,; LONG dwFlags,; STRING @pvStructInfo,; LONG @pcbStructInfo
DECLARE LONG CryptDecodeObjectEx IN Crypt32; LONG dwCertEncodingType,; STRING lpszStructType,; STRING pbEncoded,; LONG cbEncoded,; LONG dwFlags,; STRING pDecodePara,; STRING @pvStructInfo,; LONG @pcbStructInfo
DECLARE LONG CryptAcquireCertificatePrivateKey IN Crypt32;
LONG pCert,; LONG dwFlags,; LONG pvParameters,; LONG @phCryptProvOrNCryptKey,; LONG @pdwKeySpec,; LONG @pfCallerFreeProvOrNCryptKey
*------- CRYPTO API CNG (Cryptography Next Generation)*------- BCrypt.DLL
DECLARE LONG BCryptOpenAlgorithmProvider IN BCrypt; LONG @phAlgorithm, ; STRING pszAlgId, ; STRING pszImplementation, ; LONG dwFlags
DECLARE LONG BCryptImportKeyPair IN BCrypt; LONG hAlgorithm, ; LONG hImportKey, ; STRING pszBlobType, ; LONG @phKey, ; STRING pbInput, ; LONG cbInput, ; LONG dwFlags
DECLARE LONG BCryptCloseAlgorithmProvider IN BCrypt; LONG hAlgorithm, ; LONG dwFlags
DECLARE LONG BCryptDestroyKey IN BCrypt; LONG hKey
*------------ Kernel32.DLL
DECLARE LONG GetLastError IN Kernel32
DECLARE LONG FormatMessage IN Kernel32; LONG dwFlags, ; STRING @lpSource, ; LONG dwMessageId, ; LONG dwLanguageId, ; STRING @lpBuffer, ; LONG nSize, ; LONG Arguments
*------------ Constantes#DEFINE X509_ASN_ENCODING 1 #DEFINE PKCS_7_ASN_ENCODING 0x00010000#DEFINE FORMAT_MESSAGE_FROM_SYSTEM 0x00001000#DEFINE CRYPT_STRING_ANY 0x00000007
*------------ MainlcFileKey = GETFILE("KEY")IF EMPTY(lcFileKey) RETURN 0ENDIFlpParKey = GetImportPrivateKeyToCng(lcFileKey)IF lpParKey<>0 ? "Exito!, puntero: " + TRANSFORM(lpParKey) BCryptDestroyKey(lpParKey)ELSE ? "No se pudo importar el par de claves"ENDIF
*------------ Región de procedures*/// Recibe la ruta de un archivo de intercambio de claves publico/privada (KEY)*/// Si tiene éxito devuelve un puntero al par de claves importadas, listo para firmarPROCEDURE GetImportPrivateKeyToCng(tcFileKey AS String)
SET STEP ON cStringKey = ALLTRIM(FILETOSTR(tcFileKey)) IF EMPTY(cStringKey)
MESSAGEBOX("El archivo esta vacio", 16, _SCREEN.Caption) RETURN 0 ENDIF
*----- Decodificamos el archivo
dwBufferLen=0 pdwSkip=0 pdwFlags=0 nResp = CryptStringToBinary(cStringKey, 0, CRYPT_STRING_ANY, NULL, @dwBufferLen, @pdwSkip, @pdwFlags) DO CASE CASE pdwFlags=0
*----- Archivo Base64, con encabezados de inicio y fin, convertir a ASN1
lcPrivKey=STREXTRACT(cStringKey, "-----BEGIN RSA PRIVATE KEY-----", "-----END RSA PRIVATE KEY-----") IF EMPTY(lcPrivKey) lcPrivKey=STREXTRACT(cStringKey, "-----BEGIN ENCRYPTED PRIVATE KEY-----", "-----END ENCRYPTED PRIVATE KEY-----") ENDIF lcPrivKey=STRCONV(lcPrivKey,14) CASE pdwFlags=1
*----- Archivo Base64, sin encabezados, convertir a ASN1 lcPrivKey=STRCONV(cStringKey,14) CASE pdwFlags=2 *------- Archivo ya en formato binario ASN1, NO convertir lcPrivKey=cStringKey ENDCASE *----- Decodificamos la cadena ASN1 dwCertEncodingType = BITOR(PKCS_7_ASN_ENCODING, X509_ASN_ENCODING) lpszStructType = "43" + CHR(0) && AQUI EL PROBLEMA, A ESTE PARAMETRO HAY QUE ENTRARLE A COMO SEA!
pbEncoded = lcPrivKey cbEncoded = LEN(lcPrivKey) cbKeyBlob = 0 nResp=CryptDecodeObjectEx(dwCertEncodingType, lpszStructType, pbEncoded, cbEncoded, 0, NULL, NULL, @cbKeyBlob) IF cbKeyBlob=0
GetMessageError()
RETURN 0 ENDIF pbKeyBlob = SPACE(pbKeyBlob) nResp=CryptDecodeObjectEx(dwCertEncodingType, lpszStructType, pbEncoded, cbEncoded, 0, NULL, @pbKeyBlob, @cbKeyBlob)
*----- Abrimos un proveedor de algoritmo
pszAlgId = STRCONV("RSA" + CHR(0), 5) lnAlg = 0 lnRes = BCryptOpenAlgorithmProvider(@lnAlg, pszAlgId, NULL, 0) IF lnRes <> 0
MESSAGEBOX("No se pudo apertura el proveedor de algoritmo", 16, _SCREEN.Caption) RETURN 0 ENDIF *------ Importamos el par de claves para CNG, probamos con varios formatos
PROCEDURE GetMessageError(tnNumError AS Long) IF VARTYPE(tcNumError)=="N" lnErrorCode = tnNumError
#include "pch.h"#include <iostream>#include <Windows.h>#include <stdio.h>#include <wincrypt.h>
#pragma comment (lib, "crypt32.lib" )#pragma comment (lib, "bcrypt.lib" )
const char* szPemPrivKey ="-----BEGIN RSA PRIVATE KEY-----""MIICXAIBAAKBgQCf6YAJOSBYPve1jpYDzq+w++8YVoATI/YCi/RKZaQk+l2ZfoUQ""g0qrYrfkzeoOa/qd5VLjTTvHEgwXnlDXMfo+vSgxosUxDOZXMTBqJGOViv5K2QBv""k8A1wi4k8tuo/7OWya29HvcfavUk3YXaV2YFe8V6ssaZjNcVWmDdjqNkXwIDAQAB""AoGALrd+ijNAOcebglT3ioE1XpUbUpbir7TPyAqvAZUUESF7er41jY9tnwgmBRgL""Cs+M1dgLERCdKBkjozrDDzswifFQmq6PrmYrBkFFqCoLJwepSYdWnK1gbZ/d43rR""2sXzSGZngscx0CxO7KZ7xUkwENGd3+lKXV7J6/vgzJ4XnkECQQDTP6zWKT7YDckk""We04hbhHyBuNOW068NgUUvoZdBewerR74MJx6nz28Tp+DeNvc0EveiQxsEnbV8u+""NRkX5y0xAkEAwcnEAGBn5kJd6SpU0ALA9XEpUv7tHTAGQYgCRbfTT59hhOq6I22A""ivjOCNG9c6E7EB2kcPVGuCpYUhy7XBIGjwJAK5lavKCqncDKoLwGn8HJdNcyCIWv""q5iFoDw37gTt1ricg2yx9PzmabkDz3xiUmBBNeFJkw/FToXiQRGIakyGIQJAJIem""PPPvYgZssYFbT4LVYO8d/Rk1FWVyKHQ9CWtnmADRXz7oK7l+m7PfEuaGsf9YpOcR""koGJ/TluQLxNzUNQnQJBAImwr/yYFenIx3HQ6UX/fCt6qpGDv0VfOLyR64MNeegx""o7DhNxHbFkIGzk4lKhMKcHKDrawZbdJtS9ie2geSwVQ=""-----END RSA PRIVATE KEY-----";
BCRYPT_KEY_HANDLE main(int argc){ DWORD dwBufferLen = 0, cbKeyBlob = 0, cbSignature = 0, i; LPBYTE pbBuffer = NULL, pbKeyBlob = NULL, pbSignature = NULL; HCRYPTPROV hProv = NULL; HCRYPTKEY hKey = NULL; HCRYPTHASH hHash = NULL; LPCSTR cadfer = ((LPCSTR) 43);
CryptStringToBinaryA(szPemPrivKey, 0, CRYPT_STRING_BASE64HEADER, NULL, &dwBufferLen, NULL, NULL); pbBuffer = (LPBYTE)LocalAlloc(0, dwBufferLen); CryptStringToBinaryA(szPemPrivKey, 0, CRYPT_STRING_BASE64HEADER, pbBuffer, &dwBufferLen, NULL, NULL);
CryptDecodeObjectEx(X509_ASN_ENCODING | PKCS_7_ASN_ENCODING, PKCS_RSA_PRIVATE_KEY, pbBuffer, dwBufferLen, 0, NULL, NULL, &cbKeyBlob); pbKeyBlob = (LPBYTE)LocalAlloc(0, cbKeyBlob); CryptDecodeObjectEx(X509_ASN_ENCODING | PKCS_7_ASN_ENCODING, PKCS_RSA_PRIVATE_KEY, pbBuffer, dwBufferLen, 0, NULL, pbKeyBlob, &cbKeyBlob);
printf("Esto son los bytes del par de claves importados %s \n", pbBuffer); BCRYPT_ALG_HANDLE lnAlg = 0; BCryptOpenAlgorithmProvider(&lnAlg, L"RSA", NULL, 0);
BCRYPT_KEY_HANDLE phKey = 0; BCryptImportKeyPair(lnAlg, 0, L"PRIVATEBLOB", &phKey, pbKeyBlob, cbKeyBlob, 0); if (phKey != 0) {std::cout << "PRIVATEBLOB!\n"; return phKey;} BCryptImportKeyPair(lnAlg, 0, L"CAPIPRIVATEBLOB", &phKey, pbKeyBlob, cbKeyBlob, 0); if (phKey != 0) {std::cout << "CAPIPRIVATEBLOB!\n"; return phKey;}
BCryptImportKeyPair(lnAlg, 0, L"DHPRIVATEBLOB", &phKey, pbKeyBlob, cbKeyBlob, 0); if (phKey != 0) {std::cout << "DHPRIVATEBLOB!\n"; return phKey;}
BCryptImportKeyPair(lnAlg, 0, L"DSAPRIVATEBLOB", &phKey, pbKeyBlob, cbKeyBlob, 0); if (phKey != 0) {std::cout << "DSAPRIVATEBLOB!\n"; return phKey;}
BCryptImportKeyPair(lnAlg, 0, L"ECCPRIVATEBLOB", &phKey, pbKeyBlob, cbKeyBlob, 0); if (phKey != 0) {std::cout << "ECCPRIVATEBLOB!\n"; return phKey;}
BCryptImportKeyPair(lnAlg, 0, L"RSAPRIVATEBLOB", &phKey, pbKeyBlob, cbKeyBlob, 0); if (phKey != 0) {std::cout << "RSAPRIVATEBLOB!\n"; return phKey;}
BCryptImportKeyPair(lnAlg, 0, L"CAPIDHPRIVATEBLOB", &phKey, pbKeyBlob, cbKeyBlob, 0); if (phKey != 0) {std::cout << "CAPIDHPRIVATEBLOB!\n"; return phKey;}
BCryptImportKeyPair(lnAlg, 0, L"CAPIDSAPRIVATEBLOB", &phKey, pbKeyBlob, cbKeyBlob, 0); if (phKey != 0) {std::cout << "CAPIDSAPRIVATEBLOB!\n"; return phKey;}
BCryptImportKeyPair(lnAlg, 0, L"V2CAPIDSAPRIVATEBLOB", &phKey, pbKeyBlob, cbKeyBlob, 0); if (phKey != 0) {std::cout << "V2CAPIDSAPRIVATEBLOB!\n"; return phKey;}
}
lpszStructType:
A pointer to an object identifier (OID) that defines the structure type. If the high-order word of the lpszStructType parameter is zero, the low-order word specifies the integer identifier for the type of the specified structure. Otherwise, this parameter is a long pointer to a null-terminated string.
Hay que declarar en la funcion CryptDecodeObjectEx a lpszStructType como LONG
DECLARE LONG CryptDecodeObjectEx IN Crypt32;
LONG dwCertEncodingType,;
LONG lpszStructType,;
STRING pbEncoded,;
LONG cbEncoded,;
LONG dwFlags,;
STRING pDecodePara,;
STRING @pvStructInfo,;
LONG @pcbStructInfo
Le asignas este valor....
lpszStructType = 43
Y lo pones asi en la funcion.....
nResp=CryptDecodeObjectEx(dwCertEncodingType, @lpszStructType, pbEncoded, cbEncoded, 0 , NULL, NULL, @cbKeyBlob)
Sin usar DLL externas, solo usando el proveedor criptografico original de Windows CryptoApi CSP y CNG, desde el almacén de certificados de Windows, es recomendable configurar sus librerías para hacerlo desde ahí, para que funcione tanto con firmas en archivo o token usb.podemos fácilmente decodificar el certificado, extraer el serial, Issuer, modulus, exponente, etc. Exportar el par de claves (pública y privada si va a usar CNG) para poder crear el o los hash y generar el firmado del mismo. Usando solo CSP puede firmar en MD2, MD5, Sha1, pero con CNG se pude firmar en formato Sha1, Sha256, Sha512, etc. Ahora bien, exportando el par de claves supongo que es posible (si de desea), usar otro proveedor criptografico (Openssl, Nss, etc) pero aun no lo he intentado. Esto ha funcionado excelente usando VFP9 con Windows 7 SP2, voy a probar en diferentes versiones de Windows, desde XP hasta 10 a ver como nos va, Si alguien esta interesando en este tema y desea orientación deje su correo para pasarle documentación.
Saludos Compas, a los primero foristas que solicitaron les envié mensajes de Correo, explicando el tema, cuando aún estaba explorando estas opciones que desconocía de las apis de Windows con la idea de que también revisen el tema y vean que resultados pueden tener por su parte. Luego comencé a publicar aquí mismo en este hilo todo lo que logre investigar del tema y lo que se necesitan para firmar un Xml, (Firma envuelta por ahora) revisen los mensajes aquí publicado de mi parte. ¿Que necesitan para el firmado? Crear hash (DIgestValues) de las regiones (URI) que les soliciten según el modelo de esquema que necesiten. La función GetDigestValue() hace eso, el código esta qui expuesto, luego ese Hash (DigestValue) se lo firma con el par de clave, revisen el ejemplo ¿por lo menos ya lo intentaron? Con esto respondo a la duda de Irwin, "talvez no es del todo gratis", compa, no tienen que pagar veinte centavos por usar el proveedor criptografico de windows, ES TOTALMENTE GRATIS. Con la dirección web que publique respecto a la canonicalización (palabra para hijue...) Solo tienen que armar su xml como cualquier archivo de texto, e ir colocando los resultados de los DigestValues y el firmado. Aquí les dejo un capture de un XML ya firmado usando el método 100% fox que esta en este hilo. Recién la semana pasada logre superar (con la ayuda de otro forista) el problema de la canonicalización, Ya logre firmar un XML enviar al SRI (Ecuador) y ya recibe la respuesta "AUTORIZADO", el firmado era lo único que supuestamente no se podía hacer con VFP, pero como ven SI SE PUEDE!... Ánimos compas, armen sus xml, SI VALE LA PENA INTENTARLO. En este momento estoy modificando mis aplicaciones para usar este método, en lugar de las librerias de net y java que son un asco.... controlar este proceso de forma directa con nuestro zorrito es lo mejor. Si necesitan ayuda en el proceso del armado de su xml con el firmado, me lo dicen, en que parte necesitan ayuda. Con excepción de Diego, nadie mas ha comentado si lo ha intentado.