Fattura elettronica: estrarre un file con vba da p7m a XML

Procedura ‘semplice’ per estrarre una fattura elettronica da un file p7m che incapsula XML.

Procedura ‘semplice’ per estrarre una fattura elettronica da un file XML incapsulato in un file firmato p7m.
Libreria CRYPT32.DLL di Windows.
In sintesi i passi da seguire:

  • Riferimento libreria (Declare)
  • Definizione struttura dati (Type)
  • Lettura del file e decodifica (CryptDecodeMessage)
  • Caricamento oggetto XML (XML.Load)

Costanti

Const CMSG_DATA_FLAG = 2                    ' Raw data with no particular formatting
Const CMSG_SIGNED_FLAG = 4                  ' Signed message
Const CMSG_ENVELOPED_FLAG = 8               ' Enveloped (encrypted) message
Const CMSG_SIGNED_AND_ENVELOPED_FLAG = 16   ' Signed and encrypted message
Const CMSG_HASHED_FLAG = 32                 ' Hashed message
Const CMSG_ENCRYPTED_FLAG = 64              ' Encrypted message
Const CMSG_DATA = 1                         ' Raw data with no particular formatting
Const CMSG_SIGNED = 2                       ' Signed message
Const CMSG_ENVELOPED = 3                    ' Enveloped (encrypted) message
Const CMSG_SIGNED_AND_ENVELOPED = 4         ' Signed and encrypted message
Const CMSG_HASHED = 5                       ' Hashed message
Const CMSG_ENCRYPTED = 6                    ' Encrypted message

Const CERT_FIND_ANY = 0
Const CERT_FIND_EXISTING = &HD0000
Const CERT_FIND_ISSUER_OF = &HC0000
Const CERT_FIND_ISSUER_STR = &H70004
Const CERT_FIND_KEY_SPEC = &H90000
Const CERT_FIND_PROPERTY = &H50000
Const CERT_FIND_SUBJECT_STR = &H70007
Const X509_ASN_ENCODING = &H1               ' X.509 Encoding
Const PKCS_7_ASN_ENCODING = &H10000         ' PKCS #7 Message Formatting

Strutture dati

Public Type CRYPT_DECRYPT_MESSAGE_PARA
    cbSize As Long
    dwMsgAndCertEncodingType As Long
    cCertStore As Long                      ' hCryptProv As Long
    pfnGetSignerCertificate As Long         ' Pointer to callback function    HCERTSTORE *rghCertStore;
    dwFlags As Long                         ' pvGetArg As Long  ' void Pointer
End Type

Public Type CRYPT_VERIFY_MESSAGE_PARA
    cbSize As Long
    dwMsgAndCertEncodingType As Long
    hCryptProv As Long                      ' HCRYPTPROV_LEGACY hCryptProv;
    pfnGetSignerCertificate As Long         ' Pointer to callback function PFN_CRYPT_GET_SIGNER_CERTIFICATE pfnGetSignerCertificate;
    pvGetArg As Long                        ' void Pointer
End Type

Riferimento librerie – Dichiarazione

Public Declare Function CryptDecodeMessage Lib "Crypt32.dll" (ByVal dwMsgTypeFlags As Long, _
                                            pDecryptPara As CRYPT_DECRYPT_MESSAGE_PARA, _
                                            pVerifyPara As CRYPT_VERIFY_MESSAGE_PARA, _
                                            ByVal dwSignerIndex As Long, ByVal pbEncodedBlob As String, _
                                            ByVal cbEncodedBlob As Long, ByVal dwPrevInnerContentType As Long, _
                                            pdwMsgType As Long, pdwInnerContentType As Long, _
                                            ByVal pbDecoded As String, pcbDecoded As Long, _
                                            ppXchgCert As Long, ppSignerCert As Long) As Long

Utilizzo

Public Function leggiFileFirmato(ByVal NomeFile As String) As String
    ' Funzione per leggere il contenuto di un file firmato p7m
    ' [NomeFile] nome del file da leggere completo di percorso
    ' Restituisce il contenuto del file firmato

    On Error Resume Next
    Dim dwMsgTypeFlags As Long, i As Long
    Dim pDecryptPara As CRYPT_DECRYPT_MESSAGE_PARA
    Dim pVerifyPara As CRYPT_VERIFY_MESSAGE_PARA
    Dim dwSignerIndex As Long
    Dim dwPrevInnerContentType As Long
    Dim pdwMsgType As Long, pdwInnerContentType As Long
    Dim ppXchgCert As Long, ppSignerCert As Long
    Dim m_lHCryptProv As Long               ' Handle for the cryptographic service provider (CSP)

    Dim messaggioFirmato As String
    Dim messaggioFirmato_L As Long          ' Lunghezza messaggio
    Dim messaggioDecodificato As String
    Dim messaggioDecodificato_L As Long

    Dim iFile As Integer
    iFile = FreeFile
    Open NomeFile For Binary Access Read As #iFile
    messaggioFirmato = Input(LOF(iFile), iFile)
    Close #iFile

    messaggioDecodificato = Base64Decode(messaggioFirmato)  ' Verifica codifica base64
    If Err.Number <> 0 Then     ' = -2147467259  "Errore durante l'analisi di "..." come tipo di dati bin.base64."
        Err.Clear
    Else
        messaggioFirmato = messaggioDecodificato
    End If
    messaggioFirmato_L = Len(messaggioFirmato)  ' Lunghezza
    messaggioDecodificato = String(messaggioFirmato_L, vbNullChar)
    messaggioDecodificato_L = 0 'Len(messaggioDecodificato)

    ' strutture dati
    pVerifyPara.cbSize = 20
    pVerifyPara.dwMsgAndCertEncodingType = X509_ASN_ENCODING Or PKCS_7_ASN_ENCODING  '--- The encoding type
    pVerifyPara.hCryptProv = m_lHCryptProv      '--- The CSP handle
    ' -
    pDecryptPara.cbSize = 16
    pDecryptPara.dwMsgAndCertEncodingType = pVerifyPara.dwMsgAndCertEncodingType    'X509_ASN_ENCODING Or PKCS_7_ASN_ENCODING
    'pDecryptPara.cCertStore = 0  '1000
    pDecryptPara.dwFlags = CMSG_SIGNED_AND_ENVELOPED
    pdwMsgType = CMSG_DATA_FLAG
    dwMsgTypeFlags = CMSG_SIGNED_FLAG    ' CMSG_DATA_FLAG
    pdwInnerContentType = 0

    i = CryptDecodeMessage(dwMsgTypeFlags, pDecryptPara, _
                             pVerifyPara, dwSignerIndex, _
                             messaggioFirmato, messaggioFirmato_L, _
                             dwPrevInnerContentType, pdwMsgType, _
                             pdwInnerContentType, messaggioDecodificato, _
                             messaggioDecodificato_L, ppXchgCert, ppSignerCert)
    i = CryptDecodeMessage(dwMsgTypeFlags, pDecryptPara, _
                             pVerifyPara, dwSignerIndex, _
                             messaggioFirmato, messaggioFirmato_L, _
                             dwPrevInnerContentType, pdwMsgType, _
                             pdwInnerContentType, messaggioDecodificato, _
                             messaggioDecodificato_L, ppXchgCert, ppSignerCert)
    Dim alfa As String
    alfa = " 0 Then
        messaggioDecodificato = Mid(messaggioDecodificato, i)
    End If
    If Err.Number = 0 Then
        leggiFileFirmato = messaggioDecodificato
    End If

End Function

Function Base64Decode(ByVal vCode)
    On Error Resume Next
    Dim oXML, oNode
    Set oXML = CreateObject(lb_XML_DOM)
    Set oNode = oXML.createElement("base64")
    oNode.DataType = "bin.base64"
    oNode.Text = vCode
    If Err.Number = 0 Then
        Base64Decode = Stream_BinaryToString(oNode.nodeTypedValue)
    End If
    Set oNode = Nothing: Set oXML = Nothing
End Function

Foto di Lorenzo Cafaro da Pixabay

Documentazione ufficiale Microsoft
https://docs.microsoft.com/en-us/windows/win32/api/wincrypt/nf-wincrypt-cryptdecodemessage

Manuale ben scritto per la gestione della crittografia con Visual Basic.
Davis Chapman – Sams Publishing

Developing Secure Applicati… by madmhackz on Scribd

Potrebbe interessarti: https://resch.pro/catalogo-relazionale/