ainda tem um erro na assinatura que não consegui descobrir, mas consegui evoluir até aqui
Código: Selecionar todos
#include "hbclass.ch"
#include "minigui.ch"
#include "common.ch"
#ifdef __XHARBOUR__
#include "hb2xhb.ch"
#endif
#define CAPICOM_AUTHENTICATED_ATTRIBUTE_SIGNING_TIME 0
#define CAPICOM_AUTHENTICATED_ATTRIBUTE_DOCUMENT_NAME 1
#define CAPICOM_AUTHENTICATED_ATTRIBUTE_DOCUMENT_DESCRIPTION 2
#define CAPICOM_CERTIFICATE_FIND_SHA1_HASH 0
#define CAPICOM_CERTIFICATE_FIND_SUBJECT_NAME 1
#define CAPICOM_CERTIFICATE_FIND_ISSUER_NAME 2
#define CAPICOM_CERTIFICATE_FIND_ROOT_NAME 3
#define CAPICOM_CERTIFICATE_FIND_TEMPLATE_NAME 4
#define CAPICOM_CERTIFICATE_FIND_EXTENSION 5
#define CAPICOM_CERTIFICATE_FIND_EXTENDED_PROPERTY 6
#define CAPICOM_CERTIFICATE_FIND_APPLICATION_POLICY 7
#define CAPICOM_CERTIFICATE_FIND_CERTIFICATE_POLICY 8
#define CAPICOM_CERTIFICATE_FIND_TIME_VALID 9
#define CAPICOM_CERTIFICATE_FIND_TIME_NOT_YET_VALID 10
#define CAPICOM_CERTIFICATE_FIND_TIME_EXPIRED 11
#define CAPICOM_CERTIFICATE_FIND_KEY_USAGE 12
#define CAPICOM_CERTIFICATE_INCLUDE_CHAIN_EXCEPT_ROOT 0
#define CAPICOM_CERTIFICATE_INCLUDE_WHOLE_CHAIN 1
#define CAPICOM_CERTIFICATE_INCLUDE_END_ENTITY_ONLY 2
// CAPICOM Chain check flag
#define CAPICOM_CHECK_NONE &H00000000
#define CAPICOM_CHECK_TRUSTED_ROOT &H00000001
#define CAPICOM_CHECK_TIME_VALIDITY &H00000002
#define CAPICOM_CHECK_SIGNATURE_VALIDITY &H00000004
#define CAPICOM_CHECK_ONLINE_REVOCATION_STATUS &H00000008
#define CAPICOM_CHECK_OFFLINE_REVOCATION_STATUS &H00000010
#define CAPICOM_CHECK_COMPLETE_CHAIN &H00000020
#define CAPICOM_CHECK_NAME_CONSTRAINTS &H00000040
#define CAPICOM_CHECK_BASIC_CONSTRAINTS &H00000080
#define CAPICOM_CHECK_NESTED_VALIDITY_PERIOD &H00000100
#define CAPICOM_CHECK_ONLINE_ALL &H000001EF
#define CAPICOM_CHECK_OFFLINE_ALL &H000001F7
#define CAPICOM_ENCRYPTION_ALGORITHM_RC2 0
#define CAPICOM_ENCRYPTION_ALGORITHM_RC4 1
#define CAPICOM_ENCRYPTION_ALGORITHM_DES 2
#define CAPICOM_ENCRYPTION_ALGORITHM_3DES 3
#define CAPICOM_ENCRYPTION_ALGORITHM_AES 4 // v2.0
#define CAPICOM_ENCRYPTION_KEY_LENGTH_MAXIMUM 0
#define CAPICOM_ENCRYPTION_KEY_LENGTH_40_BITS 1
#define CAPICOM_ENCRYPTION_KEY_LENGTH_56_BITS 2
#define CAPICOM_ENCRYPTION_KEY_LENGTH_128_BITS 3
#define CAPICOM_ENCRYPTION_KEY_LENGTH_192_BITS 4 // AES v2.0
#define CAPICOM_ENCRYPTION_KEY_LENGTH_256_BITS 5 // AES v2.0
#define CAPICOM_ENCODE_ANY 0xffffffff
#define CAPICOM_ENCODE_BASE64 0
#define CAPICOM_ENCODE_BINARY 1
#define CAPICOM_EXPORT_DEFAULT 0
#define CAPICOM_EXPORT_IGNORE_PRIVATE_KEY_NOT_EXPORTABLE_ERROR 1
#define CAPICOM_HASH_ALGORITHM_SHA1 0
#define CAPICOM_HASH_ALGORITHM_MD2 1
#define CAPICOM_HASH_ALGORITHM_MD4 2
#define CAPICOM_HASH_ALGORITHM_MD5 3
#define CAPICOM_HASH_ALGORITHM_SHA_256 4
#define CAPICOM_HASH_ALGORITHM_SHA_384 5
#define CAPICOM_HASH_ALGORITHM_SHA_512 6
#define CAPICOM_KEY_STORAGE_DEFAULT 0
#define CAPICOM_KEY_STORAGE_EXPORTABLE 1
#define CAPICOM_KEY_STORAGE_USER_PROTECTED 2
#define CAPICOM_MY_STORE "My"
#define CAPICOM_PROPID_KEY_PROV_INFO 2
#define CAPICOM_STORE_OPEN_READ_ONLY 0
#define CAPICOM_STORE_OPEN_READ_WRITE 1
#define CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED 2
#define CAPICOM_STORE_OPEN_EXISTING_ONLY 128
#define CAPICOM_STORE_OPEN_INCLUDE_ARCHIVED 256
#define CAPICOM_STORE_SAVE_AS_SERIALIZED 0
#define CAPICOM_STORE_SAVE_AS_PKCS7 1
#define CAPICOM_STORE_SAVE_AS_PFX 2
#define CAPICOM_MEMORY_STORE 0
#define CAPICOM_LOCAL_MACHINE_STORE 1
#define CAPICOM_CURRENT_USER_STORE 2
#define CAPICOM_ACTIVE_DIRECTORY_USER_STORE 3
#define CAPICOM_SMART_CARD_USER_STORE 4
// CAPICOM Chain check flag
#define CAPICOM_TRUST_IS_NOT_TIME_VALID &H00000001
#define CAPICOM_TRUST_IS_NOT_TIME_NESTED &H00000002
#define CAPICOM_TRUST_IS_REVOKED &H00000004
#define CAPICOM_TRUST_IS_NOT_SIGNATURE_VALID &H00000008
#define CAPICOM_TRUST_IS_NOT_VALID_FOR_USAGE &H00000010
#define CAPICOM_TRUST_IS_UNTRUSTED_ROOT &H00000020
#define CAPICOM_TRUST_REVOCATION_STATUS_UNKNOWN &H00000040
#define CAPICOM_TRUST_IS_CYCLIC &H00000080
#define CAPICOM_TRUST_INVALID_EXTENSION &H00000100
#define CAPICOM_TRUST_INVALID_POLICY_CONSTRAINTS &H00000200
#define CAPICOM_TRUST_INVALID_BASIC_CONSTRAINTS &H00000400
#define CAPICOM_TRUST_INVALID_NAME_CONSTRAINTS &H00000800
#define CAPICOM_TRUST_HAS_NOT_SUPPORTED_NAME_CONSTRAINT &H00001000
#define CAPICOM_TRUST_HAS_NOT_DEFINED_NAME_CONSTRAINT &H00002000
#define CAPICOM_TRUST_HAS_NOT_PERMITTED_NAME_CONSTRAINT &H00004000
#define CAPICOM_TRUST_HAS_EXCLUDED_NAME_CONSTRAINT &H00008000
#define CAPICOM_TRUST_IS_OFFLINE_REVOCATION &H01000000
#define CAPICOM_TRUST_NO_ISSUANCE_CHAIN_POLICY &H02000000
#define CAPICOM_TRUST_IS_PARTIAL_CHAIN &H00010000
#define CAPICOM_TRUST_CTL_IS_NOT_TIME_VALID &H00020000
#define CAPICOM_TRUST_CTL_IS_NOT_SIGNATURE_VALID &H00040000
#define CAPICOM_TRUST_CTL_IS_NOT_VALID_FOR_USAGE &H00080000
#define KNOWN_TRUST_STATUS_MASK &H030FFFFF
#define CAPICOM_VERIFY_SIGNATURE_ONLY 0
#define CAPICOM_VERIFY_SIGNATURE_AND_CERTIFICATE 1
Procedure Main()
Local cCert
Private oESocial:= ESocialClass():New()
BEGIN SEQUENCE WITH __BreakBlock()
cCert:= CapicomEscolheCertificado()
If Upper(cCert) # [NENHUM]
oESocial:cCertificado:= cCert
Endif
ENDSEQUENCE
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PTISO
REQUEST HB_CODEPAGE_PT850 &&& PARA INDEXAR CAMPOS ACENTUADOS
REQUEST DBFCDX, DBFFPT
HB_LangSelect([PT])
HB_SETCODEPAGE([PT850]) &&& PARA INDEXAR CAMPOS ACENTUADOS
RDDSETDEFAULT([DBFCDX])
Set Wrap On
Set Talk Off
Set Date Briti &&& data no formato dd/mm/aaaados
Set Dele On &&& ignora registros marcados por deleção
Set Score Off
Set Exact On
Setcancel(.F.) &&& evitar cancelar sistema c/ ALT + C
Set Cent On &&& ano com 4 dígitos
Set Epoch to 2000 &&& ano a partir de 2000
Set Excl Off &&& abre arquivos em modo compartilhado
Set Navigation Extended &&& enter no lugar do tab
Set Language to Portuguese &&& mensagens em português
Set Multiple Off Warning &&& abrir 1 cópia somente
Set Browsesync On &&& para o comando browse funcionar ok
Set Tooltip On
Set Tooltipballoon On
Set Tooltipstyle Balloon &&& para mensagem dos campos em forma de balão
Set Menustyle Extended &&& padrão é standard, extended estilo Office 2007
Set Programmaticchange Off &&& introduzida na build 1.9.94
DEFINE WINDOW f_Esocial AT 0, 0 WIDTH 600 HEIGHT 300 TITLE [Teste Esocial] ICON [demo.ico] MAIN NOSIZE
DEFINE TEXTBOX Txt_Protocolo
ROW 50
COL 100
WIDTH 220
HEIGHT 20
TOOLTIP "Número do Protocolo"
ONENTER {|| Iif(This.Value > 0 .or. This.Value >= 30, _SetFocus([BTN_Enviar], [f_Esocial]), This.SetFocus())}
VALUE [123456789012345678901234567890]
MAXLENGTH 30
END TEXTBOX
DEFINE BUTTON BTN_Enviar
ROW 150
COL 120
WIDTH 100
HEIGHT 28
ACTION {|| fTestar(1, GetProperty([f_Esocial], [Txt_Protocolo], [Value]))}
CAPTION "Enviar"
FONTBOLD .T.
END BUTTON
ON KEY ESCAPE ACTION {|| Thiswindow.Release}
END WINDOW
DoMethod([f_Esocial], [Center])
DoMethod([f_Esocial], [Activate])
Return (Nil)
STATIC FUNCTION AssinaLoadCertificado( cCertCN, oCert, oCapicomStore, cPassword, cRetorno )
LOCAL lOk := .F.
IF Upper( Right( cCertCN, 4 ) ) == ".PFX"
IF ! File( cCertCn )
cRetorno := "Erro assinatura: Arquivo PFX não encontrado"
RETURN .F.
ENDIF
IF cPassword == NIL .OR. Empty( cPassword )
cRetorno := "Erro assinatura: Falta senha do arquivo PFX"
RETURN .F.
ENDIF
oCert := win_OleCreateObject( "CAPICOM.Certificate" )
oCert:Load( cCertCN, cPassword, 1, 0 )
ELSE
oCert := CapicomCertificado( cCertCn )
ENDIF
IF oCert == NIL
cRetorno := "Erro Assinatura: Certificado não encontrado"
msginfo(cretorno, [nessa parte])
RETURN .F.
ENDIF
BEGIN SEQUENCE WITH __BreakBlock()
oCapicomStore := win_OleCreateObject( "CAPICOM.Store" )
oCapicomStore:open( _CAPICOM_MEMORY_STORE, 'Memoria', _CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED )
oCapicomStore:Add( oCert )
lOk := .T.
ENDSEQUENCE
IF ! lOk
cRetorno := "Erro assinatura: Problemas no uso do certificado"
RETURN .F.
ENDIF
RETURN .T.
// Anotação: carregar PFX e instalar via Capicom
// oCertStore := win_OleCreateObject( "CAPICOM.Store" )
// oCert := win_OleCreateObject( "CAPICOM.Certificate" )
// oCert:Load( "c:\path\file.pfx", "password", 1, 0 )
// oCert:Add( oCert )
STATIC FUNCTION AssinaAjustaAssinado( cXml )
LOCAL nPosIni, nPosFim
cXml := StrTran( cXml, Chr(10), "" )
cXml := StrTran( cXml, Chr(13), "" )
nPosIni := RAt( [<SignatureValue>], cXml ) + Len( [<SignatureValue>] )
cXml := Substr( cXml, 1, nPosIni - 1 ) + StrTran( Substr( cXml, nPosIni ), " ", "" )
// Ocorrência estranha: <X509Data> duplicado num cliente com A3
nPosIni := At( "</X509Data><X509Data>", cXml )
IF nPosIni != 0
nPosFim := hb_At( "</X509Data>", cXml, nPosIni + 5 )
cXml := Substr( cXml, 1, nPosIni - 1 ) + Substr( cXml, nPosFim )
ENDIF
RETURN cXml
Static Procedure fTestar(nTipo, cChave)
Local nHandle
cChave:= Alltrim(cChave)
If Empty(cChave)
MsgInfo([Protocolo Inválido], [Erro])
Return (Nil)
Endif
oEsocial:cAmbiente:= [1]
If nTipo == 1
oESocial:EnviarLoteEventos(cChave)
Else
oESocial:ConsultaRetornoLote(cChave)
Endif
If XmlNode(oESocial:cXmlRetorno, [cdResposta]) $ [201, 202]
hb_MemoWrit(cChave + [-Retorno.xml], fRetiraAcento(oESocial:cXmlRetorno))
/* If (nHandle:= fCreate(cChave + [-Retorno.xml], 0)) == -1
MsgInfo([Erro de Criação: Erro DOS ] + Strzero(fError(), 2), [Erro])
Return (Nil)
Else
fWrite(nHandle, oESocial:cXmlRetorno)
fClose(nHandle)
Endif
*/ Else
hb_MemoWrit(cChave + [-Erro.xml], hb_AnsiToOem(oESocial:cXmlRetorno))
MsgExclamation([Erro: ] + hb_OsNewLine() + ;
[Status: ] + hb_OemToAnsi(XmlNode(oESocial:cXmlRetorno, [cdResposta])) + hb_OsNewLine() + ;
[Descrição da Resposta: ] + hb_OemToAnsi(XmlNode(oESocial:cXmlRetorno, [descResposta])) + hb_OsNewLine() + ;
[Código da Ocorrência: ] + hb_OemToAnsi(XmlNode(oESocial:cXmlRetorno, [codigo])) + hb_OsNewLine() + ;
[Tipo da Ocorrência: ] + hb_OemToAnsi(XmlNode(oESocial:cXmlRetorno, [tipo])) + hb_OsNewLine() + ;
[Descricao da Ocorrência: ] + hb_OemToAnsi(XmlNode(oESocial:cXmlRetorno, [descricao])), [Erro])
Endif
Return (Nil)
CREATE CLASS ESocialClass
VAR cCertificado INIT ""
VAR cUrl INIT ""
VAR cSoapAction INIT ""
VAR cXmlDocumento INIT ""
VAR cXmlEnvelope INIT ""
VAR cXmlRetorno INIT ""
VAR cAmbiente INIT [1] // 1 - Produção 2 - Homologação
var cPassword INIT [123456]
VAR cStatus INIT Space(3) // Status obtido da resposta final da Fazenda
VAR cRecibo INIT "" // Número do recibo
VAR cMotivo INIT "" // Motivo constante no Recibo
METHOD ConsultaRetornoLote( cChave, cCertificado)
METHOD EnviarLoteEventos(cChave)
* METHOD EnviarLoteEventos(cChave, cCertificado)
METHOD MicrosoftXmlSoapPost()
METHOD AssinaXml()
ENDCLASS
METHOD EnviarLoteEventos(cChave, cCertificado) CLASS ESocialClass
If cCertificado # Nil
::cCertificado := cCertificado
Endif
If ::cAmbiente == [1]
::cUrl:= [https://webservices.envio.esocial.gov.br/servicos/empregador/enviarloteeventos/WsEnviarLoteEventos.svc]
Else
::cUrl:= [https://webservices.producaorestrita.esocial.gov.br/servicos/empregador/enviarloteeventos/WsEnviarLoteEventos.svc]
Endif
::cSOAPAction := "http://www.esocial.gov.br/servicos/empregador/lote/eventos/envio/v1_1_0/ServicoEnviarLoteEventos/EnviarLoteEventos"
::cXmlDocumento:= [<eSocial xmlns="http://www.esocial.gov.br/schema/lote/eventos/envio/v1_1_1"><envioLoteEventos grupo="2"><ideEmpregador><tpInsc>1</tpInsc><nrInsc>38969309</nrInsc></ideEmpregador><ideTransmissor><tpInsc>1</tpInsc><nrInsc>15527739000123</nrInsc></ideTransmissor><eventos><evento Id="ID1389693090000002024031419175500001"><eSocial xmlns="http://www.esocial.gov.br/schema/evt/evtMonit/v_S_01_02_00"><evtMonit Id="ID1389693090000002024031419175500001"><ideEvento><indRetif>1</indRetif><tpAmb>1</tpAmb><procEmi>1</procEmi><verProc>SGOWIN_Versao24022</verProc></ideEvento><ideEmpregador><tpInsc>1</tpInsc><nrInsc>38969309</nrInsc></ideEmpregador><ideVinculo><cpfTrab>21840640847</cpfTrab><matricula>7</matricula></ideVinculo><exMedOcup><tpExameOcup>1</tpExameOcup><aso><dtAso>2024-02-14</dtAso><resAso>1</resAso><exame><dtExm>2024-02-14</dtExm><procRealizado>0295</procRealizado><indResult>1</indResult></exame><medico><nmMed>RENAN RODRIGUES BOLDORINI</nmMed><nrCRM>219303</nrCRM><ufCRM>SP</ufCRM></medico></aso><respMonit><nmResp>Antonio Sergio Alvarez Nicolas</nmResp><nrCRM>045761</nrCRM><ufCRM>SP</ufCRM></respMonit></exMedOcup></evtMonit></eSocial></evento></eventos></envioLoteEventos></eSocial>]
::cXmlEnvelope := [<?xml version="1.0" encoding="UTF-8"?>] + ;
[<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" ] + ;
[xmlns:v1="http://www.esocial.gov.br/servicos/empregador/lote/eventos/envio/v1_1_0">] + ;
[<soap:Header/>] + ;
[<soap:Body>] + ;
[<EnviarLoteEventos>] + ;
[<loteEventos>] + ;
::cXmlDocumento + ;
[</loteEventos>] + ;
[</EnviarLoteEventos>] + ;
[</soap:Body>] + ;
[</soap:Envelope>]
hb_MemoWrit(cChave + [-enviar.xml] , ::cXmlEnvelope)
::AssinaXml()
* msginfo(::cXmlRetorno)
* msginfo(::cXmlDocumento)
hb_MemoWrit(cChave + [-assinado.xml] , ::cXmlRetorno)
hb_MemoWrit(cChave + [-assinado1.xml] , ::cXmlDocumento)
::MicrosoftXmlSoapPost()
Return(::cXmlRetorno)
METHOD ConsultaRetornoLote( cChave, cCertificado ) CLASS ESocialClass
IF cCertificado != NIL
::cCertificado := cCertificado
ENDIF
If ::cAmbiente == [1]
::cUrl:= "https://webservices.consulta.esocial.gov.br/servicos/empregador/consultarloteeventos/WsConsultarLoteEventos.svc"
Else
::cUrl:= "https://webservices.producaorestrita.esocial.gov.br/servicos/empregador/consultarloteeventos/WsConsultarLoteEventos.svc"
Endif
::cSOAPAction := "http://www.esocial.gov.br/servicos/empregador/lote/eventos/envio/consulta/retornoProcessamento/v1_1_0/ServicoConsultarLoteEventos/ConsultarLoteEventos"
::cXmlDocumento := ;
[<eSocial xmlns="http://www.esocial.gov.br/schema/lote/eventos/envio/consulta/retornoProcessamento/v1_0_0">] + ;
[<consultaLoteEventos>] + ;
[<protocoloEnvio>] + cChave + [</protocoloEnvio>] + ;
[</consultaLoteEventos>] + ;
[</eSocial>]
::cXmlEnvelope := [<?xml version="1.0" encoding="UTF-8"?>] + ;
[<soapenv:Envelope xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" ] + ;
[xmlns:v1="http://www.esocial.gov.br/servicos/empregador/lote/eventos/envio/consulta/retornoProcessamento/v1_1_0">] + ;
[<soapenv:Header/>] + ;
[<soapenv:Body>] + ;
[<consultaLoteEventos>] + ;
[<consulta>] + ::cXmlDocumento + [</consulta>] + ;
[</consultaLoteEventos>] + ;
[</soapenv:Body>] + ;
[</soapenv:Envelope>]
::MicrosoftXmlSoapPost()
RETURN ::cXmlRetorno
METHOD MicrosoftXmlSoapPost() CLASS ESocialClass
Local oComunicacao
TRY
oComunicacao = win_OleCreateObject( 'MSXML2.ServerXMLHTTP.6.0' ) // passa aqui 6 para 5
CATCH
oComunicacao = win_OleCreateObject( 'MSXML2.XMLHTTP' )
END
* oComunicacao = win_OleCreateObject( "MSXML2.ServerXMLHTTP" ) // win_OleCreateObject
oComunicacao:setOption( 3, "CURRENT_USER\MY\" + ::cCertificado )
*oComunicacao:SetProxy(2, "proxy:8080")
oComunicacao:open( "POST", ::cUrl, .F. )
oComunicacao:SetRequestHeader( "SOAPAction", ::cSOAPAction )
oComunicacao:SetRequestHeader( "Content-Type", "text/xml; charset=utf-8" )
oComunicacao:send( ::cXmlEnvelope )
Inkey(0.5)
::cXmlRetorno := oComunicacao:responseText
Return NIL
METHOD AssinaXml() CLASS ESocialClass
::cXmlRetorno := CapicomAssinaXml( @::cXmlDocumento, ::cCertificado, ,::cPassword )
IF ::cXmlRetorno != "OK"
::cStatus := "999"
::cMotivo := ::cXmlRetorno
::cXmlRetorno := [<erro text="] + "*erro* " + ::cXmlRetorno + ["</erro>]
ENDIF
RETURN ::cXmlRetorno
FUNCTION XmlNode( cXml, cNode, lComTag )
LOCAL nInicio, nFim, cResultado := ""
hb_Default( @lComTag, .F. )
nInicio := At( "<" + cNode, cXml )
// a linha abaixo é depois de pegar o início, senão falha
IF " " $ cNode
cNode := Substr( cNode, 1, At( " ", cNode ) - 1 )
ENDIF
IF nInicio != 0
IF ! lComTag
nInicio := nInicio + Len( cNode ) + 2
IF nInicio != 1 .AND. Substr( cXml, nInicio - 1, 1 ) != ">" // Quando tem elementos no bloco
nInicio := hb_At( ">", cXml, nInicio ) + 1
ENDIF
ENDIF
nFim := hb_At( "</" + cNode + ">", cXml, nInicio )
IF nFim != 0
nFim -=1
IF lComTag
nFim := nFim + Len( cNode ) + 3
ENDIF
cResultado := Substr( cXml, nInicio, nFim - nInicio + 1 )
ENDIF
ENDIF
RETURN cResultado
********************* Retira Acentos e Letras de uma String ********************
Function fRetiraAcento(cStr)
Local aLetraCAc:= {[Á],[À],[Ä],[Ã],[Â],[É],[È],[Ë],[Ê],[&],[Í],[Ì],[Ï],[Î],[Ó],[Ò],[Ö],[Õ],[Ô],[Ú],[Ù],[Ü],[Û],[Ç],[Ñ],[Ý],[á],[à],[ä],[ã],[â],[é],[è],[ë],[ê],[í],[ì],[ï],[î],[ó],[ò],[ö],[õ],[ô],[ú],[ù],[ü],[û],[ç],[ñ],[ý],[ÿ],[º] ,[ª] ,[‡],[Æ],[¡],[£],[ÿ],[ ],[á],[ ],[ ],[ ]}
Local aLetraSAc:= {[A],[A],[A],[A],[A],[E],[E],[E],[E],[E],[I],[I],[I],[I],[O],[O],[O],[O],[O],[U],[U],[U],[U],[C],[N],[Y],[a],[a],[a],[a],[a],[e],[e],[e],[e],[i],[i],[i],[i],[o],[o],[o],[o],[o],[u],[u],[u],[u],[c],[n],[y],[y],[o.],[a.],[c],[a],[i],[u],[a],[a],[a],[E ],[a],[ ]}, i
hb_Default(@cStr, [])
For i:= 1 To Len(aLetraCAc)
cStr:= StrTran(cStr, aLetraCAc[i], aLetraSAc[i])
Next
Return (cStr)
********************* Fim da Função Retira Acentos e Letras de uma String ******
FUNCTION CapicomAssinaXml( cTxtXml, cCertCN, lRemoveAnterior, cPassword, lComURI )
LOCAL oDOMDocument, xmldsig, oCert, oCapicomStore
LOCAL SIGNEDKEY, DSIGKEY
LOCAL cXmlTagInicial, cXmlTagFinal, cRetorno := ""
LOCAL cDllFile, acDllList := { "msxml5.dll", "msxml5r.dll", "capicom.dll" }
hb_Default( @lRemoveAnterior, .T. )
hb_Default( @lComURI, .T. )
AssinaRemoveAssinatura( @cTxtXml, lRemoveAnterior )
AssinaRemoveDeclaracao( @cTxtXml )
IF ! AssinaAjustaInformacao( @cTxtXml, @cXmlTagInicial, @cXmlTagFinal, @cRetorno, @lComURI )
RETURN cRetorno
ENDIF
IF ! AssinaLoadXml( @oDOMDocument, cTxtXml, @cRetorno )
RETURN cRetorno
ENDIF
IF ! AssinaLoadCertificado( cCertCN, @ocert, @oCapicomStore, cPassword, @cRetorno )
msginfo(cretorno, [parei aqui])
RETURN cRetorno
ENDIF
BEGIN SEQUENCE WITH __BreakBlock()
cRetorno := "Erro Assinatura: Não carregado MSXML2.MXDigitalSignature.5.0"
#ifdef __XHARBOUR__
xmldsig := xhb_CreateObject( "MSXML2.MXDigitalSignature.5.0" )
#else
xmldsig := win_OleCreateObject( "MSXML2.MXDigitalSignature.5.0" )
#endif
cRetorno := "Erro Assinatura: Template de assinatura não encontrado"
xmldsig:signature := oDOMDocument:selectSingleNode(".//ds:Signature")
cRetorno := "Erro assinatura: Certificado pra assinar XmlDSig:Store"
xmldsig:store := oCapicomStore
dsigKey := xmldsig:CreateKeyFromCSP( oCert:PrivateKey:ProviderType, oCert:PrivateKey:ProviderName, oCert:PrivateKey:ContainerName, 0 )
IF ( dsigKey = NIL )
cRetorno := "Erro assinatura: Ao criar a chave do CSP."
BREAK
ENDIF
cRetorno := "Erro assinatura: assinar XmlDSig:Sign()"
SignedKey := XmlDSig:Sign( DSigKey, 2 )
IF signedKey == NIL
cRetorno := "Erro Assinatura: Assinatura Falhou."
BREAK
ENDIF
cTxtXml := AssinaAjustaAssinado( oDOMDocument:Xml )
cRetorno := "OK"
ENDSEQUENCE
IF cRetorno != "OK" .OR. ! "<Signature" $ cTxtXml
IF Empty( cRetorno )
cRetorno := "Erro Assinatura "
ENDIF
FOR EACH cDllFile IN acDllList
IF ! File( "c:\windows\system32\" + cDllFile ) .AND. ! File( "c:\windows\syswow64\" + cDllFile )
cRetorno += ", verifique " + cDllFile
ENDIF
NEXT
ENDIF
RETURN cRetorno
STATIC FUNCTION AssinaBlocoAssinatura( cURI, lComURI )
LOCAL cSignatureNode := ""
* IF lComURI
cURI := "#" + cURI
* ENDIF
cSignatureNode += [<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">]
cSignatureNode += [<SignedInfo>]
cSignatureNode += [<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>]
* cSignatureNode += [<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1" />]
cSignatureNode += [<SignatureMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#rsa-sha256" />]
cSignatureNode += [<Reference URI="] + cURI + [">]
cSignatureNode += [<Transforms>]
cSignatureNode += [<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature" />]
cSignatureNode += [<Transform Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315" />]
cSignatureNode += [</Transforms>]
* cSignatureNode += [<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1" />]
cSignatureNode += [<DigestMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#rsa-sha256" />]
cSignatureNode += [<DigestValue>]
cSignatureNode += [</DigestValue>]
cSignatureNode += [</Reference>]
cSignatureNode += [</SignedInfo>]
cSignatureNode += [<SignatureValue>]
cSignatureNode += [</SignatureValue>]
cSignatureNode += [<KeyInfo>]
cSignatureNode += [</KeyInfo>]
cSignatureNode += [</Signature>]
cSignatureNode += [</eSocial>]
cSignatureNode += [</evento>]
cSignatureNode += [</eventos>]
cSignatureNode += [</envioLoteEventos>]
* cSignatureNode += [</eSocial>]
RETURN cSignatureNode
FUNCTION CapicomEscolheCertificado( dValidFrom, dValidTo )
LOCAL oCertificado, oCapicomStore, cNomeCertificado := "NENHUM", oColecao
oCapicomStore := win_oleCreateObject( "CAPICOM.Store" )
oCapicomStore:Open( CAPICOM_CURRENT_USER_STORE, 'My', CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED )
oColecao := oCapicomStore:Certificates()
DO CASE
CASE oColecao:Count() == 1
oCertificado := oColecao:item(1)
dValidFrom := oCertificado:ValidFromDate
dValidTo := oCertificado:ValidToDate
cNomeCertificado := oCertificado:SubjectName
CASE oColecao:Count() > 1
oCertificado := oColecao:Select( "Selecione o certificado para uso da Nfe","Selecione o certificado", .F. )
dValidFrom := oCertificado:item(1):ValidFromDate
dValidTo := oCertificado:item(1):ValidToDate
cNomeCertificado := oCertificado:item(1):SubjectName
ENDCASE
IF "CN=" $ cNomeCertificado
cNomeCertificado := Substr( cNomeCertificado, At( "CN=", cNomeCertificado ) + 3 )
IF "," $ cNomeCertificado
cNomeCertificado := Substr( cNomeCertificado, 1, At( ",", cNomeCertificado ) - 1 )
ENDIF
ENDIF
// oCapicomStore:Close()
RETURN cNomeCertificado
FUNCTION CapicomCertificado( cNomeCertificado, dValidFrom, dValidTo )
LOCAL oCapicomStore, oColecao, oCertificado, nCont //, aList
oCapicomStore := Win_OleCreateObject( "CAPICOM.Store" )
oCapicomStore:Open( CAPICOM_CURRENT_USER_STORE, "My", CAPICOM_STORE_OPEN_MAXIMUM_ALLOWED )
oColecao := oCapicomStore:Certificates()
//aList := oColecao:Find( CAPICOM_CERTIFICATE_FIND_ISSUER_NAME, cNomeCertificado, .T. )
FOR nCont = 1 TO oColecao:Count()
IF cNomeCertificado $ oColecao:Item( nCont ):SubjectName
IF oColecao:Item( nCont ):ValidFromDate <= Date() .AND. oColecao:Item( nCont ):ValidToDate >= Date()
oCertificado := oColecao:Item( nCont )
dValidFrom := oCertificado:ValidFromDate
dValidTo := oCertificado:ValidToDate
EXIT
ENDIF
ENDIF
NEXT
oCapicomStore:Close()
//IF aList:Count() > 0
// oCertificado := aList:Item(0)
// dValidFrom := oCertificado:ValidFromDate
// dValidTo := oCertificado:ValidToDate
//ENDIF
RETURN oCertificado
STATIC FUNCTION AssinaRemoveAssinatura( cTxtXml, lRemoveAnterior )
LOCAL nPosIni, nPosFim
// Remove assinatura anterior - atenção pra NFS que usa multiplas assinaturas
IF lRemoveAnterior
DO WHILE "<Signature" $ cTxtXml .AND. "</Signature>" $ cTxtXml
nPosIni := At( "<Signature", cTxtXml ) - 1
nPosFim := At( "</Signature>", cTxtXml ) + 12
cTxtXml := Substr( cTxtXml, 1, nPosIni ) + Substr( cTxtXml, nPosFim )
ENDDO
ENDIF
RETURN cTxtXml
STATIC FUNCTION AssinaRemoveDeclaracao( cTxtXml )
IF "<?XML" $ Upper( cTxtXml ) .AND. "?>" $ cTxtXml
cTxtXml := Substr( cTxtXml, At( "?>", cTxtXml ) + 2 )
DO WHILE Substr( cTxtXml, 1, 1 ) $ hb_Eol()
cTxtXml := Substr( cTxtXml, 2 )
ENDDO
ENDIF
RETURN cTxtXml
STATIC FUNCTION AssinaAjustaInformacao( cTxtXml, cXmlTagInicial, cXmlTagFinal, cRetorno, lComURI )
LOCAL aDelimitadores, nPos, nPosIni, nPosFim, cURI
aDelimitadores := { ;
{ "<enviMDFe", "</MDFe></enviMDFe>" }, ;
{ "<eventoMDFe", "</eventoMDFe>" }, ;
{ "<eventoCTe", "</eventoCTe>" }, ;
{ "<infMDFe", "</MDFe>" }, ;
{ "<infCte", "</CTe>" }, ;
{ "<infNFe", "</NFe>" }, ;
{ "<infDPEC", "</envDPEC>" }, ;
{ "<infInut", "<inutNFe>" }, ;
{ "<infCanc", "</cancNFe>" }, ;
{ "<infInut", "</inutNFe>" }, ;
{ "<infInut", "</inutCTe>" }, ;
{ "<infEvento", "</evento>" }, ;
{ "<evtInfoEmpregador", "</eSocial>" }, ;
{ "<EnviarLoteEventos" , "</eSocial>" }, ;
{ "<evtCAT", "</eSocial>" }, ;
{ "<evtMonit", "</eSocial>" }, ;
{ "<evtExpRisco", "</eSocial>" }, ;
{ "<PedidoEnvioLoteRPS", "</RPS>" }, ;
{ "<PedidoEnvioRPS", "</RPS>" }, ;
{ "<infPedidoCancelamento", "</Pedido>" }, ; // NFSE ABRASF Cancelamento
{ "<LoteRps", "</EnviarLoteRpsEnvio>" }, ; // NFSE ABRASF Lote
{ "<infRps", "</Rps>" } } // NFSE ABRASF RPS
// Define Tipo de Documento
IF ( nPos := hb_AScan( aDelimitadores, { | oElement | oElement[ 1 ] $ cTxtXml .AND. oElement[ 2 ] $ cTxtXml } ) ) == 0
cRetorno := "Erro Assinatura: Não identificado documento"
RETURN .F.
ENDIF
cXmlTagFinal := aDelimitadores[ nPos, 2 ]
// Pega URI
nPosIni := At( [Id=], cTxtXml )
IF nPosIni = 0
cRetorno := "Erro Assinatura: Não encontrado início do URI: Id= (com I maiúsculo)"
RETURN .F.
ENDIF
nPosIni := hb_At( ["], cTxtXml, nPosIni + 2 )
IF nPosIni = 0
cRetorno := "Erro Assinatura: Não encontrado início do URI: aspas inicial"
RETURN .F.
ENDIF
nPosFim := hb_At( ["], cTxtXml, nPosIni + 1 )
IF nPosFim = 0
cRetorno := "Erro Assinatura: Não encontrado início do URI: aspas final"
RETURN .F.
ENDIF
cURI := Substr( cTxtXml, nPosIni + 1, nPosFim - nPosIni - 1 )
// Adiciona bloco de assinatura no local apropriado
IF cXmlTagFinal $ cTxtXml
cTxtXml := Substr( cTxtXml, 1, At( cXmlTagFinal, cTxtXml ) - 1 ) + AssinaBlocoAssinatura( cURI, lComURI ) + cXmlTagFinal
ENDIF
IF ! "</Signature>" $ cTxtXml
cRetorno := "Erro Assinatura: Bloco Assinatura não encontrado"
RETURN .F.
ENDIF
HB_SYMBOL_UNUSED( cXmlTagInicial )
RETURN .T.
STATIC FUNCTION AssinaLoadXml( oDomDocument, cTxtXml, cRetorno )
LOCAL lOk := .F.
BEGIN SEQUENCE WITH __BreakBlock()
#ifdef __XHARBOUR__
oDOMDocument := xhb_CreateObject( "MSXML2.DOMDocument.5.0" )
#else
oDOMDocument := win_OleCreateObject( "MSXML2.DOMDocument.5.0" )
#endif
oDOMDocument:async := .F.
oDOMDocument:resolveExternals := .F.
oDOMDocument:validateOnParse := .T.
oDOMDocument:preserveWhiteSpace := .T.
lOk := .T.
ENDSEQUENCE
IF ! lOk
cRetorno := "Erro Assinatura: Não carregado MSXML2.DomDocument"
RETURN .F.
ENDIF
lOk := .F.
BEGIN SEQUENCE WITH __BreakBlock()
oDOMDocument:LoadXML( cTxtXml )
oDOMDocument:setProperty( "SelectionNamespaces", [xmlns:ds="http://www.w3.org/2000/09/xmldsig#"] )
lOk := .T.
ENDSEQUENCE
IF ! lOk
IF oDOMDocument:parseError:errorCode <> 0 // XML não carregado
cRetorno := "Erro Assinatura: Não foi possivel carregar o documento pois ele não corresponde ao seu Schema" + HB_EOL()
cRetorno += " Linha: " + Str( oDOMDocument:parseError:line ) + HB_EOL()
cRetorno += " Caractere na linha: " + Str( oDOMDocument:parseError:linepos ) + HB_EOL()
cRetorno += " Causa do erro: " + oDOMDocument:parseError:reason + HB_EOL()
cRetorno += "code: " + Str( oDOMDocument:parseError:errorCode )
RETURN .F.
ENDIF
cRetorno := "Erro Assinatura: Não foi possível carregar documento"
RETURN .F.
ENDIF
RETURN .T.