Faz um tempo que necessitei trabalhar com calculo de "hash" e também com "assinatura digital". Para isso, tentei usar o "CAPICOM SDK" da Microsoft mas me deparei com problemas que até hoje eu não tinha encontrado uma solução.
1 - O primeiro problema que encontrei foi com o método "Hash" da classe "HashedData". Percebi que o calculo retornado não estava correto. Depois de pesquisar sobre o caso identifiquei que alterando o tipo do parâmetro do método "Hash" de "WideString" para "String", o problema foi resolvido.
Vejam como o Delphi mapeia o tipo do parâmetro quando fizemos a importação da capicom.dll:
----------------------------------------------
IHashedData = interface(IDispatch)
['{9F7F23E8-06F4-42E8-B965-5CBD044BF27F}']
function Get_Value: WideString; safecall;
function Get_Algorithm: CAPICOM_HASH_ALGORITHM; safecall;
procedure Set_Algorithm(pVal: CAPICOM_HASH_ALGORITHM); safecall;
procedure Hash(const newVal: WideString); safecall;
property Value: WideString read Get_Value;
property Algorithm: CAPICOM_HASH_ALGORITHM read Get_Algorithm write Set_Algorithm;
end;
----------------------------------------------
Agora, vejam a alteração que fiz na "CAPICOM_TLB.pas" para funcionar corretamente:
----------------------------------------------
IHashedData = interface(IDispatch)
['{9F7F23E8-06F4-42E8-B965-5CBD044BF27F}']
function Get_Value: WideString; safecall;
function Get_Algorithm: CAPICOM_HASH_ALGORITHM; safecall;
procedure Set_Algorithm(pVal: CAPICOM_HASH_ALGORITHM); safecall;
procedure Hash(const newVal: String); safecall;
property Value: WideString read Get_Value;
property Algorithm: CAPICOM_HASH_ALGORITHM read Get_Algorithm write Set_Algorithm;
end;
----------------------------------------------
2 - O segundo problema que encontrei foi com o método "Sign" da classe "SignedData". Percebi que a assinatura retornada não estava correta. Depois de pesquisar ainda muito mais que no primeiro caso identifiquei que alterando o tipo da propriedade "Content" de "WideString" para "String" e alterar a implementação do método "Set_Content", o problema foi resolvido.
Vejam como o Delphi mapeia o tipo da propriedade quando fizemos a importação da capicom.dll:
----------------------------------------------
ISignedData = interface(IDispatch)
['{AE9C454B-FC65-4C10-B130-CD9B45BA948B}']
procedure Set_Content(const pVal: WideString); safecall;
function Get_Content: WideString; safecall;
function Get_Signers: ISigners; safecall;
function Get_Certificates: ICertificates; safecall;
function Sign(const pSigner: ISigner; bDetached: WordBool; EncodingType: CAPICOM_ENCODING_TYPE): WideString; safecall;
function CoSign(const pSigner: ISigner; EncodingType: CAPICOM_ENCODING_TYPE): WideString; safecall;
procedure Verify(const SignedMessage: WideString; bDetached: WordBool;
VerifyFlag: CAPICOM_SIGNED_DATA_VERIFY_FLAG); safecall;
property Content: WideString read Get_Content write Set_Content;
property Signers: ISigners read Get_Signers;
property Certificates: ICertificates read Get_Certificates;
end;
----------------------------------------------
Agora, vejam a alteração que fiz na "CAPICOM_TLB.pas" para funcionar corretamente:
----------------------------------------------
ISignedData = interface(IDispatch)
['{AE9C454B-FC65-4C10-B130-CD9B45BA948B}']
procedure Set_Content(const pVal: String); safecall;
function Get_Content: String; safecall;
function Get_Signers: ISigners; safecall;
function Get_Certificates: ICertificates; safecall;
function Sign(const pSigner: ISigner; bDetached: WordBool; EncodingType: CAPICOM_ENCODING_TYPE): WideString; safecall;
function CoSign(const pSigner: ISigner; EncodingType: CAPICOM_ENCODING_TYPE): WideString; safecall;
procedure Verify(const SignedMessage: WideString; bDetached: WordBool;
VerifyFlag: CAPICOM_SIGNED_DATA_VERIFY_FLAG); safecall;
property Content: String read Get_Content write Set_Content;
property Signers: ISigners read Get_Signers;
property Certificates: ICertificates read Get_Certificates;
end;
----------------------------------------------
Vejam como o Delphi implementa o método "Set_Content" quando fizemos a importação da capicom.dll:
----------------------------------------------
procedure TSignedData.Set_Content(const pVal: WideString);
{ Warning: The property Content has a setter and a getter whose
types do not match. Delphi was unable to generate a property of
this sort and so is using a Variant as a passthrough. }
var
InterfaceVariant: OleVariant;
begin
InterfaceVariant := DefaultInterface;
InterfaceVariant.Content := pVal;
end;
----------------------------------------------
Agora, vejam a alteração que fiz na "CAPICOM_TLB.pas" para funcionar corretamente:
----------------------------------------------
procedure TSignedData.Set_Content(const pVal: WideString);
{ Warning: The property Content has a setter and a getter whose
types do not match. Delphi was unable to generate a property of
this sort and so is using a Variant as a passthrough. }
var
InterfaceVariant: ISignedData;
begin
InterfaceVariant := DefaultInterface;
InterfaceVariant.Content := pVal;
end;
----------------------------------------------
Em relação ao problema 1, tenho certeza de ter corrigido pois pude comparar o calculo do hash com outras ferramentas.
Em relação ao problema 2, o único parâmetro que tive até agora para comparar e decretar que o problema foi resolvido, foi fazer a verificação da assinatura gerada pelo CAPICOM em outro software, o Bry Signer (http://www.bry.com.br/). Como o Bry Signer já é utilizado em produção e vendido no mercado, é certo que a assinatura digital realizada por ele funciona corretamente, portanto, devido a uma assinatura digital gerada pela CAPICOM ser verificada e validada com sucesso através dele, concluí que o problema foi resolvido.
Quem passou pelo mesmo problema e aplicou uma solução diferente, por favor, deixe seu comentário.
Abraço!
10 de junho de 2013
10 de janeiro de 2013
SpeechMagic e SpeechMike
Na empresa onde trabalho, acabei de concluir a integração entre nosso software, que é construído com o Delphi e o software de reconhecimento de voz da Nuance: "SpeechMagic". Alem disso, também integrei o microfone da Philips: "SpeechMike". O editor usado na integração é o TRichEdit.
Quem representa e revende o "SpeechMagic" e o "SpeechMike" aqui no Brasil é a Macsym (www.macsym.com.br).
Quem tiver interesse, pode entrar em contato :)
Abraço a todos!
Quem representa e revende o "SpeechMagic" e o "SpeechMike" aqui no Brasil é a Macsym (www.macsym.com.br).
Quem tiver interesse, pode entrar em contato :)
Abraço a todos!
28 de agosto de 2009
Criar mensagem TISS em formato XML conforme padrão da ANS com o Caché
Atualmente trabalho em uma empresa que desenvolve softwares para gestão hospitalar e como todos que trabalham com isso ja precisei desenvolver algo relacionado ao novo modelo de faturamento hospitalar para convenios (planos de saude).
Vou dar uma breve explicação de, o que é o tal TISS, porem, não vou entrar em detalhes. A ANS (www.ans.gov.br) ou Agencia Nacional de Saude Suplementar criou um modelo que os hospitais (prestadores de serviços) devem usar para poder cobrar dos convenios (planos de saude) suas faturas (serviços prestados aos conveniados/pacientes). Este modelo se resume a um arquivo XML definido por um padrão especificado em um schema.
Aqui na empresa utilizamos o banco de dados Caché da InterSystems para realizar o trabalho de criação do arquivo XML contendo o faturamento eletronico do hospital para ser enviado ao convenio.
Vou mostrar abaixo um exemplo pratico de como fazer isso. Para esta tarefa utilizarei o Caché na versão 2009.1.
Vamos la:
1 - Acesse este link onde contem os schemas XML que descrevem como os arquivos XMLs devem ser criados. Crie uma pasta em seu computador, como por exemplo "C:\schemastiss" e faça o download para dentro dela dos seguintes arquivos:
tissCancelaGuiaV2_01_03.wsdl
tissComplexTypesV2_01_03.xsd
tissGuiasV2_01_03.xsd
tissLoteGuiasV2_01_03.wsdl
tissnetV2_01_03.xsd
tissSimpleTypesV2_01_03.xsd
tissSolicitacaoDemonstrativoRetornoV2_01_03.wsdl
tissSolicitacaoProcedimentoV2_01_03.wsdl
tissSolicitacaoStatusAutorizacaoV2_01_03.wsdl
tissSolicitacaoStatusProtocoloV2_01_03.wsdl
tissTransmiteMensagemV2_01_03.wsdl
tissTransmiteMensagemZIPV2_01_03.wsdl
tissV2_01_03.xsd
tissVerificaElegibilidadeV2_01_03.wsdl
2 - Agora que temos os schemas baixados, vamos importalos no Caché para que ele crie as classes relacionadas. Abra o studio do Caché e va em "Ferramentas->Suplementos->Suplementos". Selecione a opção "Assistente de Criação de Esquema XML". Redimensione a tela que abrir para usar todo seu desktop pois ficará mais facil a visualização. No campo "Arquivo de Esquema:" selcione ele e informe o caminho do arquivo principal/raiz dos schemas que é o "C:\schemastiss\tissV2_01_03.xsd". Clique em "Avançar". Será mostrado o conteudo do arquivo, clique em "Avançar" novamente. Selecione a opção "Adicionar Parâmetro de Classe NAMESPACE" e clique em "Avançar". Serão listadas todas as classes que o Caché irá criar, role até abaixo e clique em "Avançar". Pronto, deve mostrar todas as classes que foram salvas, role até abaixo e clique em "Terminar". O Caché irá abrir todas as classes criadas e compila-las, por isso deve demorar um pouco e parecer que o studio esta travado, porem, basta aguardar um pouco.
3 - Agora ja temos tudo que precisamos para popular nossa mensagem TISS e exporta-la para XML. Agora crie uma nova classe no Caché igual a esta abaixo:
******************************************************************************
Class TISS.Mensagem [ Abstract ]
{
ClassMethod Criar()
{
#Dim objMensagemTISS As ans.mensagemTISS
#Dim objCabecalhoTransacao As ans.cabecalhoTransacao
#Dim objIdentificacaoTransacao As ans.identificacaoTransacao
#Dim objStatus As %Status
#Dim objOrigem As ans.origem
#Dim objIdentificacaoPrestadorExecutante As ans.ctidentificacaoPrestadorExecutante
#Dim objDestino As ans.destino
#Dim objGuiaConsulta As ans.ctguiaConsulta
#Dim objCabecalhoGuia As ans.ctcabecalhoGuia
#Dim objBeneficiario As ans.ctbeneficiario
#Dim objContratado As ans.ctcontratado
#Dim objIdentificacaoPrestadorExecutante2 As ans.ctidentificacaoPrestadorExecutante
#Dim objIdentificacaoProfissional As ans.ctidentificacaoProfissional
#Dim objConselhoProfissional As ans.ctconselhoProfissional
#Dim objDadosAtendimento As ans.dadosAtendimento
#Dim objProcedimento As ans.procedimento
#Dim objPrestadorParaOperadora As ans.prestadorParaOperadora
#Dim objLoteGuias As ans.ctloteGuias
#Dim objGuiaFaturamento As ans.guiaFaturamento
#Dim objGuias2 As ans.guias2
#Dim objEpilogo As ans.epilogo
/// Vamos identificar que "tipo de transação" nossa mensagem tiss vai ser.
Set objIdentificacaoTransacao = ##class(ans.identificacaoTransacao).%New()
Set objIdentificacaoTransacao.tipoTransacao = "ENVIO_LOTE_GUIAS"
Set objIdentificacaoTransacao.sequencialTransacao = 1
Set objIdentificacaoTransacao.dataRegistroTransacao = "28/08/2009"
Set objIdentificacaoTransacao.horaRegistroTransacao = "10:00"
Set objStatus = objIdentificacaoTransacao.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Vamos identificar a "origem" da nossa mensagem tiss (geralmente o hospital que esta enviando).
Set objIdentificacaoPrestadorExecutante = ##class(ans.ctidentificacaoPrestadorExecutante).%New()
Set objIdentificacaoPrestadorExecutante.codigoPrestadorNaOperadora = "12345"
Set objStatus = objIdentificacaoPrestadorExecutante.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objOrigem = ##class(ans.origem).%New()
Set objOrigem.codigoPrestadorNaOperadora = objIdentificacaoPrestadorExecutante
Set objStatus = objOrigem.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Vamos identificar o "destino" da nossa mensagem tiss (geralmente o convenio).
Set objDestino = ##class(ans.destino).%New()
Set objDestino.registroANS = "123456"
Set objStatus = objDestino.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Com as informações populadas acima ja podemos montar o cabeçalho da mensagem TISS.
Set objCabecalhoTransacao = ##class(ans.cabecalhoTransacao).%New()
Set objCabecalhoTransacao.identificacaoTransacao = objIdentificacaoTransacao
Set objCabecalhoTransacao.origem = objOrigem
Set objCabecalhoTransacao.destino = objDestino
Set objCabecalhoTransacao.versaoPadrao = "2.01.03"
Set objStatus = objCabecalhoTransacao.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Agora vou popular a instancia que conterá minha guia para faturar uma consulta medica.
; Cabeçalho da guia.
Set objCabecalhoGuia = ##class(ans.ctcabecalhoGuia).%New()
Set objCabecalhoGuia.registroANS = "123456"
Set objCabecalhoGuia.dataEmissaoGuia = "28/08/2009"
Set objCabecalhoGuia.numeroGuiaPrestador = "1"
Set objStatus = objCabecalhoGuia.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Paciente que recebeu o atendimento.
Set objBeneficiario = ##class(ans.ctbeneficiario).%New()
Set objBeneficiario.numeroCarteira = "1"
Set objBeneficiario.nomeBeneficiario = "Alexandre da Silva"
Set objBeneficiario.nomePlano = "Basico"
Set objStatus = objBeneficiario.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Pessoa / empresa que vai receber o valor cobrado na guia (pode ser o proprio hospital, uma clinica terceirizada ou o proprio medico que fez o atendimento).
Set objIdentificacaoPrestadorExecutante2 = ##class(ans.ctidentificacaoPrestadorExecutante).%New()
Set objIdentificacaoPrestadorExecutante2.codigoPrestadorNaOperadora = "12345"
Set objStatus = objIdentificacaoPrestadorExecutante2.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objContratado = ##class(ans.ctcontratado).%New()
Set objContratado.identificacao = objIdentificacaoPrestadorExecutante2
Set objContratado.nomeContratado = "Hospital XYZ"
Set objStatus = objContratado.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Medico que atendeu o paciente (executou o serviço).
Set objConselhoProfissional = ##class(ans.ctconselhoProfissional).%New()
Set objConselhoProfissional.siglaConselho = "CRM"
Set objConselhoProfissional.numeroConselho = "123456789"
Set objConselhoProfissional.ufConselho = "SC"
Set objStatus = objConselhoProfissional.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objIdentificacaoProfissional = ##class(ans.ctidentificacaoProfissional).%New()
Set objIdentificacaoProfissional.nomeProfissional = "Humberto"
Set objIdentificacaoProfissional.conselhoProfissional = objConselhoProfissional
Set objStatus = objIdentificacaoProfissional.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Dados/detalhes do atendimento medico.
Set objProcedimento = ##class(ans.procedimento).%New()
Set objProcedimento.codigoTabela = "01"
Set objProcedimento.codigoProcedimento = "12345678"
Set objStatus = objProcedimento.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objDadosAtendimento = ##class(ans.dadosAtendimento).%New()
Set objDadosAtendimento.dataAtendimento = "28/08/2009"
Set objDadosAtendimento.procedimento = objProcedimento
Set objDadosAtendimento.tipoConsulta = "1"
Set objDadosAtendimento.tipoSaida = "1"
Set objStatus = objDadosAtendimento.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Identificar que diz que é uma de faturamento normal (pode ser de reapresentação).
Set objGuiaFaturamento = ##class(ans.guiaFaturamento).%New()
Set objStatus = objGuiaFaturamento.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objGuiaConsulta = ##class(ans.ctguiaConsulta).%New()
Set objGuiaConsulta.identificacaoGuia = objCabecalhoGuia
Set objGuiaConsulta.beneficiario = objBeneficiario
Set objGuiaConsulta.dadosContratado = objContratado
Set objGuiaConsulta.profissionalExecutante = objIdentificacaoProfissional
Set objGuiaConsulta.dadosAtendimento = objDadosAtendimento
Set objGuiaConsulta.guiaFaturamento = objGuiaFaturamento
Set objStatus = objGuiaConsulta.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Vamos criar agora alguns objetos que são necessarios para complementar a estrutura
/// da mensagem tiss.
; Lote (uma mensagem tiss pode ter um lote com varias guias).
Set objGuias2 = ##class(ans.guias2).%New()
Set objGuias2.guiaFaturamento = objGuiaFaturamento
Set objStatus = objGuias2.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objLoteGuias = ##class(ans.ctloteGuias).%New()
Set objLoteGuias.numeroLote = 1
Set objLoteGuias.guias = objGuias2
Set objStatus = objLoteGuias.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// E finalmente a mensagem TISS.
; Identificar que diz que esta mensagem TISS é uma mensagem de HOSPITAL PARA CONVENIO (pode ser o inverso tambem).
Set objPrestadorParaOperadora = ##class(ans.prestadorParaOperadora).%New()
Set objPrestadorParaOperadora.loteGuias = objLoteGuias
Set objStatus = objPrestadorParaOperadora.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; A mensagem TISS contem um calculo de HASH sobre os valores de cada TAG.
Set objEpilogo = ##class(ans.epilogo).%New()
Set objEpilogo.hash = "¥"
Set objStatus = objEpilogo.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objMensagemTISS = ##class(ans.mensagemTISS).%New()
Set objMensagemTISS.cabecalho = objCabecalhoTransacao
Set objMensagemTISS.prestadorParaOperadora = objPrestadorParaOperadora
Set objMensagemTISS.epilogo = objEpilogo
Set objStatus = objMensagemTISS.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Agora ja temos nosso objeto contendo uma mensagem TISS quase pronto para ser exportado
/// para XML. Antes de exportar, vamos fazer o calculo do HASH correto e atribuir novamente
/// o valor a propriedade correspondente.
Set objStatus = ..CalcularHASH(objMensagemTISS)
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objStatus = ..ExportarParaArquivoXML(objMensagemTISS)
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Write "MENSAGEM TISS CRIADA COM SUCESSO!"
}
ClassMethod CalcularHASH(pobjMensagemTISS As ans.mensagemTISS) As %Status [ Private ]
{
#Dim objStream As %Stream.Object
#Dim objStatus As %Status
#Dim objTextReader As %XML.TextReader
#Dim vTexto As %String
#Dim vlCalculoHash As %String
#Dim vlHash16Bytes As %String
Set objStatus = pobjMensagemTISS.XMLExportToStream(.objStream)
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = ##class(%XML.TextReader).ParseStream(objStream,.objTextReader)
if $$$ISERR(objStatus) {Quit objStatus}
Set vTexto = ""
while objTextReader.Read() {
if ((objTextReader.Value '= "") && (objTextReader.Value '= "¥")) {
Set vTexto = vTexto_objTextReader.Value
}
}
Set vlHash16Bytes = ##class(%SYSTEM.Encryption).MD5Hash(vTexto)
Set vlCalculoHash=""
for i=1:1:$Length(vlHash16Bytes) {
Set vlCalculoHash=vlCalculoHash_$Translate($Justify($ZHex($Ascii(vlHash16Bytes,i)),2)," ","0")
}
Set pobjMensagemTISS.epilogo.hash = $ZCONVERT(vlCalculoHash,"L")
Set objStatus = pobjMensagemTISS.epilogo.%Save()
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = pobjMensagemTISS.%Save()
if $$$ISERR(objStatus) {Quit objStatus}
Quit $$$OK
}
ClassMethod ExportarParaArquivoXML(pobjMensagemTISS As ans.mensagemTISS) As %Status [ Private ]
{
#Dim objBinaryStream As %FileBinaryStream
#Dim objXmlWriter As %XML.Writer
#Dim objStatus As %Status
#Dim objFile As %File
Set objBinaryStream = ##class(%FileBinaryStream).%New()
Set objXmlWriter = ##class(%XML.Writer).%New()
Set objXmlWriter.Charset = "UTF-8"
Set objXmlWriter.SuppressXmlns = 1
Set objStatus = objXmlWriter.AddNamespace("http://www.ans.gov.br/padroes/tiss/schemas","ans")
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = objXmlWriter.OutputToStream(.objBinaryStream)
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = objXmlWriter.RootObject(pobjMensagemTISS)
if $$$ISERR(objStatus) {Quit objStatus}
Set objXmlWriter=""
Set objFile = ##class(%File).%New("C:\schemastiss\mensagem\mensagemtiss.xml")
Set objStatus = objFile.Open("WSN")
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = objFile.CopyFrom(objBinaryStream)
if $$$ISERR(objStatus) {Quit objStatus}
do objFile.Close()
Set objFile = ""
Set objBinaryStream = ""
Quit $$$OK
}
}
******************************************************************************
Não esqueça de compilar sua classe apos cria-la
Quando eu coloco o fonte aqui no editor do BLOG as identações são perdidas :(. Caso alguem tenha dificuldade solicite o codigo fonte por e-mail que envio.
4 - Abra o terminal do Caché e mande compilar todas as classes do pacote da "ans". O comando a ser executado é este: do ##class(%SYSTEM.OBJ).CompilePackage("ans").
5 - Dentro da pasta onde estão os schemas, crie uma subpasta chamada "mensagem". Será dentro desta pasta que o arquivo XML será criado pelo codigo da classe. Se vc quizer, pode alterar.
6 - Agora basta acessar o terminal do Caché e executar nosso metodo para criar o arquivo XML com a mensagem TISS. O comando a ser executado é este: do ##class(TISS.Mensagem).Criar().
Pronto, se tudo ocorreu corretamente ja temos nossa mensagem tiss no formato XML pronta em "C:\schemastiss\mensagem\mensagemtiss.xml".
Abraço a todos!
Vou dar uma breve explicação de, o que é o tal TISS, porem, não vou entrar em detalhes. A ANS (www.ans.gov.br) ou Agencia Nacional de Saude Suplementar criou um modelo que os hospitais (prestadores de serviços) devem usar para poder cobrar dos convenios (planos de saude) suas faturas (serviços prestados aos conveniados/pacientes). Este modelo se resume a um arquivo XML definido por um padrão especificado em um schema.
Aqui na empresa utilizamos o banco de dados Caché da InterSystems para realizar o trabalho de criação do arquivo XML contendo o faturamento eletronico do hospital para ser enviado ao convenio.
Vou mostrar abaixo um exemplo pratico de como fazer isso. Para esta tarefa utilizarei o Caché na versão 2009.1.
Vamos la:
1 - Acesse este link onde contem os schemas XML que descrevem como os arquivos XMLs devem ser criados. Crie uma pasta em seu computador, como por exemplo "C:\schemastiss" e faça o download para dentro dela dos seguintes arquivos:
tissCancelaGuiaV2_01_03.wsdl
tissComplexTypesV2_01_03.xsd
tissGuiasV2_01_03.xsd
tissLoteGuiasV2_01_03.wsdl
tissnetV2_01_03.xsd
tissSimpleTypesV2_01_03.xsd
tissSolicitacaoDemonstrativoRetornoV2_01_03.wsdl
tissSolicitacaoProcedimentoV2_01_03.wsdl
tissSolicitacaoStatusAutorizacaoV2_01_03.wsdl
tissSolicitacaoStatusProtocoloV2_01_03.wsdl
tissTransmiteMensagemV2_01_03.wsdl
tissTransmiteMensagemZIPV2_01_03.wsdl
tissV2_01_03.xsd
tissVerificaElegibilidadeV2_01_03.wsdl
2 - Agora que temos os schemas baixados, vamos importalos no Caché para que ele crie as classes relacionadas. Abra o studio do Caché e va em "Ferramentas->Suplementos->Suplementos". Selecione a opção "Assistente de Criação de Esquema XML". Redimensione a tela que abrir para usar todo seu desktop pois ficará mais facil a visualização. No campo "Arquivo de Esquema:" selcione ele e informe o caminho do arquivo principal/raiz dos schemas que é o "C:\schemastiss\tissV2_01_03.xsd". Clique em "Avançar". Será mostrado o conteudo do arquivo, clique em "Avançar" novamente. Selecione a opção "Adicionar Parâmetro de Classe NAMESPACE" e clique em "Avançar". Serão listadas todas as classes que o Caché irá criar, role até abaixo e clique em "Avançar". Pronto, deve mostrar todas as classes que foram salvas, role até abaixo e clique em "Terminar". O Caché irá abrir todas as classes criadas e compila-las, por isso deve demorar um pouco e parecer que o studio esta travado, porem, basta aguardar um pouco.
3 - Agora ja temos tudo que precisamos para popular nossa mensagem TISS e exporta-la para XML. Agora crie uma nova classe no Caché igual a esta abaixo:
******************************************************************************
Class TISS.Mensagem [ Abstract ]
{
ClassMethod Criar()
{
#Dim objMensagemTISS As ans.mensagemTISS
#Dim objCabecalhoTransacao As ans.cabecalhoTransacao
#Dim objIdentificacaoTransacao As ans.identificacaoTransacao
#Dim objStatus As %Status
#Dim objOrigem As ans.origem
#Dim objIdentificacaoPrestadorExecutante As ans.ctidentificacaoPrestadorExecutante
#Dim objDestino As ans.destino
#Dim objGuiaConsulta As ans.ctguiaConsulta
#Dim objCabecalhoGuia As ans.ctcabecalhoGuia
#Dim objBeneficiario As ans.ctbeneficiario
#Dim objContratado As ans.ctcontratado
#Dim objIdentificacaoPrestadorExecutante2 As ans.ctidentificacaoPrestadorExecutante
#Dim objIdentificacaoProfissional As ans.ctidentificacaoProfissional
#Dim objConselhoProfissional As ans.ctconselhoProfissional
#Dim objDadosAtendimento As ans.dadosAtendimento
#Dim objProcedimento As ans.procedimento
#Dim objPrestadorParaOperadora As ans.prestadorParaOperadora
#Dim objLoteGuias As ans.ctloteGuias
#Dim objGuiaFaturamento As ans.guiaFaturamento
#Dim objGuias2 As ans.guias2
#Dim objEpilogo As ans.epilogo
/// Vamos identificar que "tipo de transação" nossa mensagem tiss vai ser.
Set objIdentificacaoTransacao = ##class(ans.identificacaoTransacao).%New()
Set objIdentificacaoTransacao.tipoTransacao = "ENVIO_LOTE_GUIAS"
Set objIdentificacaoTransacao.sequencialTransacao = 1
Set objIdentificacaoTransacao.dataRegistroTransacao = "28/08/2009"
Set objIdentificacaoTransacao.horaRegistroTransacao = "10:00"
Set objStatus = objIdentificacaoTransacao.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Vamos identificar a "origem" da nossa mensagem tiss (geralmente o hospital que esta enviando).
Set objIdentificacaoPrestadorExecutante = ##class(ans.ctidentificacaoPrestadorExecutante).%New()
Set objIdentificacaoPrestadorExecutante.codigoPrestadorNaOperadora = "12345"
Set objStatus = objIdentificacaoPrestadorExecutante.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objOrigem = ##class(ans.origem).%New()
Set objOrigem.codigoPrestadorNaOperadora = objIdentificacaoPrestadorExecutante
Set objStatus = objOrigem.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Vamos identificar o "destino" da nossa mensagem tiss (geralmente o convenio).
Set objDestino = ##class(ans.destino).%New()
Set objDestino.registroANS = "123456"
Set objStatus = objDestino.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Com as informações populadas acima ja podemos montar o cabeçalho da mensagem TISS.
Set objCabecalhoTransacao = ##class(ans.cabecalhoTransacao).%New()
Set objCabecalhoTransacao.identificacaoTransacao = objIdentificacaoTransacao
Set objCabecalhoTransacao.origem = objOrigem
Set objCabecalhoTransacao.destino = objDestino
Set objCabecalhoTransacao.versaoPadrao = "2.01.03"
Set objStatus = objCabecalhoTransacao.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Agora vou popular a instancia que conterá minha guia para faturar uma consulta medica.
; Cabeçalho da guia.
Set objCabecalhoGuia = ##class(ans.ctcabecalhoGuia).%New()
Set objCabecalhoGuia.registroANS = "123456"
Set objCabecalhoGuia.dataEmissaoGuia = "28/08/2009"
Set objCabecalhoGuia.numeroGuiaPrestador = "1"
Set objStatus = objCabecalhoGuia.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Paciente que recebeu o atendimento.
Set objBeneficiario = ##class(ans.ctbeneficiario).%New()
Set objBeneficiario.numeroCarteira = "1"
Set objBeneficiario.nomeBeneficiario = "Alexandre da Silva"
Set objBeneficiario.nomePlano = "Basico"
Set objStatus = objBeneficiario.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Pessoa / empresa que vai receber o valor cobrado na guia (pode ser o proprio hospital, uma clinica terceirizada ou o proprio medico que fez o atendimento).
Set objIdentificacaoPrestadorExecutante2 = ##class(ans.ctidentificacaoPrestadorExecutante).%New()
Set objIdentificacaoPrestadorExecutante2.codigoPrestadorNaOperadora = "12345"
Set objStatus = objIdentificacaoPrestadorExecutante2.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objContratado = ##class(ans.ctcontratado).%New()
Set objContratado.identificacao = objIdentificacaoPrestadorExecutante2
Set objContratado.nomeContratado = "Hospital XYZ"
Set objStatus = objContratado.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Medico que atendeu o paciente (executou o serviço).
Set objConselhoProfissional = ##class(ans.ctconselhoProfissional).%New()
Set objConselhoProfissional.siglaConselho = "CRM"
Set objConselhoProfissional.numeroConselho = "123456789"
Set objConselhoProfissional.ufConselho = "SC"
Set objStatus = objConselhoProfissional.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objIdentificacaoProfissional = ##class(ans.ctidentificacaoProfissional).%New()
Set objIdentificacaoProfissional.nomeProfissional = "Humberto"
Set objIdentificacaoProfissional.conselhoProfissional = objConselhoProfissional
Set objStatus = objIdentificacaoProfissional.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Dados/detalhes do atendimento medico.
Set objProcedimento = ##class(ans.procedimento).%New()
Set objProcedimento.codigoTabela = "01"
Set objProcedimento.codigoProcedimento = "12345678"
Set objStatus = objProcedimento.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objDadosAtendimento = ##class(ans.dadosAtendimento).%New()
Set objDadosAtendimento.dataAtendimento = "28/08/2009"
Set objDadosAtendimento.procedimento = objProcedimento
Set objDadosAtendimento.tipoConsulta = "1"
Set objDadosAtendimento.tipoSaida = "1"
Set objStatus = objDadosAtendimento.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; Identificar que diz que é uma de faturamento normal (pode ser de reapresentação).
Set objGuiaFaturamento = ##class(ans.guiaFaturamento).%New()
Set objStatus = objGuiaFaturamento.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objGuiaConsulta = ##class(ans.ctguiaConsulta).%New()
Set objGuiaConsulta.identificacaoGuia = objCabecalhoGuia
Set objGuiaConsulta.beneficiario = objBeneficiario
Set objGuiaConsulta.dadosContratado = objContratado
Set objGuiaConsulta.profissionalExecutante = objIdentificacaoProfissional
Set objGuiaConsulta.dadosAtendimento = objDadosAtendimento
Set objGuiaConsulta.guiaFaturamento = objGuiaFaturamento
Set objStatus = objGuiaConsulta.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Vamos criar agora alguns objetos que são necessarios para complementar a estrutura
/// da mensagem tiss.
; Lote (uma mensagem tiss pode ter um lote com varias guias).
Set objGuias2 = ##class(ans.guias2).%New()
Set objGuias2.guiaFaturamento = objGuiaFaturamento
Set objStatus = objGuias2.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objLoteGuias = ##class(ans.ctloteGuias).%New()
Set objLoteGuias.numeroLote = 1
Set objLoteGuias.guias = objGuias2
Set objStatus = objLoteGuias.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// E finalmente a mensagem TISS.
; Identificar que diz que esta mensagem TISS é uma mensagem de HOSPITAL PARA CONVENIO (pode ser o inverso tambem).
Set objPrestadorParaOperadora = ##class(ans.prestadorParaOperadora).%New()
Set objPrestadorParaOperadora.loteGuias = objLoteGuias
Set objStatus = objPrestadorParaOperadora.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
; A mensagem TISS contem um calculo de HASH sobre os valores de cada TAG.
Set objEpilogo = ##class(ans.epilogo).%New()
Set objEpilogo.hash = "¥"
Set objStatus = objEpilogo.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objMensagemTISS = ##class(ans.mensagemTISS).%New()
Set objMensagemTISS.cabecalho = objCabecalhoTransacao
Set objMensagemTISS.prestadorParaOperadora = objPrestadorParaOperadora
Set objMensagemTISS.epilogo = objEpilogo
Set objStatus = objMensagemTISS.%Save()
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
/// Agora ja temos nosso objeto contendo uma mensagem TISS quase pronto para ser exportado
/// para XML. Antes de exportar, vamos fazer o calculo do HASH correto e atribuir novamente
/// o valor a propriedade correspondente.
Set objStatus = ..CalcularHASH(objMensagemTISS)
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Set objStatus = ..ExportarParaArquivoXML(objMensagemTISS)
if $$$ISERR(objStatus) {
do ##class(%SYSTEM.Status).DisplayError(objStatus)
Quit
}
Write "MENSAGEM TISS CRIADA COM SUCESSO!"
}
ClassMethod CalcularHASH(pobjMensagemTISS As ans.mensagemTISS) As %Status [ Private ]
{
#Dim objStream As %Stream.Object
#Dim objStatus As %Status
#Dim objTextReader As %XML.TextReader
#Dim vTexto As %String
#Dim vlCalculoHash As %String
#Dim vlHash16Bytes As %String
Set objStatus = pobjMensagemTISS.XMLExportToStream(.objStream)
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = ##class(%XML.TextReader).ParseStream(objStream,.objTextReader)
if $$$ISERR(objStatus) {Quit objStatus}
Set vTexto = ""
while objTextReader.Read() {
if ((objTextReader.Value '= "") && (objTextReader.Value '= "¥")) {
Set vTexto = vTexto_objTextReader.Value
}
}
Set vlHash16Bytes = ##class(%SYSTEM.Encryption).MD5Hash(vTexto)
Set vlCalculoHash=""
for i=1:1:$Length(vlHash16Bytes) {
Set vlCalculoHash=vlCalculoHash_$Translate($Justify($ZHex($Ascii(vlHash16Bytes,i)),2)," ","0")
}
Set pobjMensagemTISS.epilogo.hash = $ZCONVERT(vlCalculoHash,"L")
Set objStatus = pobjMensagemTISS.epilogo.%Save()
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = pobjMensagemTISS.%Save()
if $$$ISERR(objStatus) {Quit objStatus}
Quit $$$OK
}
ClassMethod ExportarParaArquivoXML(pobjMensagemTISS As ans.mensagemTISS) As %Status [ Private ]
{
#Dim objBinaryStream As %FileBinaryStream
#Dim objXmlWriter As %XML.Writer
#Dim objStatus As %Status
#Dim objFile As %File
Set objBinaryStream = ##class(%FileBinaryStream).%New()
Set objXmlWriter = ##class(%XML.Writer).%New()
Set objXmlWriter.Charset = "UTF-8"
Set objXmlWriter.SuppressXmlns = 1
Set objStatus = objXmlWriter.AddNamespace("http://www.ans.gov.br/padroes/tiss/schemas","ans")
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = objXmlWriter.OutputToStream(.objBinaryStream)
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = objXmlWriter.RootObject(pobjMensagemTISS)
if $$$ISERR(objStatus) {Quit objStatus}
Set objXmlWriter=""
Set objFile = ##class(%File).%New("C:\schemastiss\mensagem\mensagemtiss.xml")
Set objStatus = objFile.Open("WSN")
if $$$ISERR(objStatus) {Quit objStatus}
Set objStatus = objFile.CopyFrom(objBinaryStream)
if $$$ISERR(objStatus) {Quit objStatus}
do objFile.Close()
Set objFile = ""
Set objBinaryStream = ""
Quit $$$OK
}
}
******************************************************************************
Não esqueça de compilar sua classe apos cria-la
Quando eu coloco o fonte aqui no editor do BLOG as identações são perdidas :(. Caso alguem tenha dificuldade solicite o codigo fonte por e-mail que envio.
4 - Abra o terminal do Caché e mande compilar todas as classes do pacote da "ans". O comando a ser executado é este: do ##class(%SYSTEM.OBJ).CompilePackage("ans").
5 - Dentro da pasta onde estão os schemas, crie uma subpasta chamada "mensagem". Será dentro desta pasta que o arquivo XML será criado pelo codigo da classe. Se vc quizer, pode alterar.
6 - Agora basta acessar o terminal do Caché e executar nosso metodo para criar o arquivo XML com a mensagem TISS. O comando a ser executado é este: do ##class(TISS.Mensagem).Criar().
Pronto, se tudo ocorreu corretamente ja temos nossa mensagem tiss no formato XML pronta em "C:\schemastiss\mensagem\mensagemtiss.xml".
Abraço a todos!
27 de agosto de 2009
Acessar propriedade de objeto Caché atravez do Delphi dinamicamente
A muito tempo que tive a necessidade de acessar uma propriedade de um objeto Caché no Delphi (via ActiveX) de forma dinamica e esta semana consegui com ajuda de algumas pesquisas na internet.
Os testes que realizei foram utilizando Delphi 2007 e Caché 5.0.21, porem, creio que pode funcionar em qualquer versão de Delphi e Caché.
O codigo abaixo demonstra como obter o valor de uma propriedade:
uses
ComObj, ActiveX;
procedure TForm1.Button1Click(Sender: TObject);
var
objFactory:variant;
obj:OleVariant;
nmProperty:PWideChar;
vParam:Pointer;
idDisp:integer;
vlProperty:variant;
idUserDefaultLC:integer;
begin
/// Objeto que fará a conexão com o banco de dados.
objFactory := CreateOleObject('CacheObject.Factory');
/// Aqui selecionar o namespace "SAMPLES".
objFactory.Connect(objFactory.ConnectDlg('Conexão'));
/// Abro um objeto do banco de dados.
obj := objFactory.OpenId('Sample.Person',10);
/// Esta vai ser a propriedade que vou acessar de forma dinamica (atravez do nome).
nmProperty := 'Name';
idUserDefaultLC := GetUserDefaultLCID;
IDispatch(obj).GetIDsOfNames(GUID_NULL, @nmProperty, 1, idUserDefaultLC, @idDisp);
vParam := nil;
IDispatch(Obj).Invoke(idDisp, GUID_NULL, idUserDefaultLC, DISPATCH_PROPERTYGET, vParam, @vlProperty, nil, nil);
/// Aqui mostro o valor da propriedade que foi recuperado.
ShowMessage(vlProperty);
end;
E este codigo abaixo demonstra como atribuir o valor a uma propriedade:
uses
ComObj, ActiveX;
procedure TForm1.Button2Click(Sender: TObject);
var
objFactory:variant;
obj:OleVariant;
nmProperty:PWideChar;
idDisp:integer;
idUserDefaultLC:integer;
rDispParams:TDispParams;
vlNew:OleVariant;
begin
/// Objeto que fará a conexão com o banco de dados.
objFactory := CreateOleObject('CacheObject.Factory');
/// Aqui selecionar o namespace "SAMPLES".
objFactory.Connect(objFactory.ConnectDlg('Conexão'));
/// Abro um objeto do banco de dados.
obj := objFactory.OpenId('Sample.Person',10);
/// Valor antes de alterar.
ShowMessage(obj.Name);
/// Esta vai ser a propriedade que vou acessar/alterar de forma dinamica (atravez do nome).
nmProperty := 'Name';
idUserDefaultLC := GetUserDefaultLCID;
IDispatch(obj).GetIDsOfNames(GUID_NULL, @nmProperty, 1, idUserDefaultLC, @idDisp);
/// Novo valor que vou atribuir na propriedade.
vlNew := 'alexandre';
with rDispParams do
begin
rgvarg := @vlNew;
rgdispidNamedArgs := @DispIDArgs;
cArgs := 1;
cNamedArgs := 1;
end;
IDispatch(obj).Invoke(idDisp, GUID_NULL, 0, DISPATCH_PROPERTYPUT, rDispParams, nil, nil, nil);
/// Valor depois de alterar.
ShowMessage(obj.Name);
end;
É isso ;) Agora quem gostar e for utilizar é só usar a imaginação para adicionar mais funcionalidades.
Obrigado a todos por lerem meu primeiro post, e fiquem a vontade para comentar e entrar em contato comigo para mais informações a respeito.
Os testes que realizei foram utilizando Delphi 2007 e Caché 5.0.21, porem, creio que pode funcionar em qualquer versão de Delphi e Caché.
O codigo abaixo demonstra como obter o valor de uma propriedade:
uses
ComObj, ActiveX;
procedure TForm1.Button1Click(Sender: TObject);
var
objFactory:variant;
obj:OleVariant;
nmProperty:PWideChar;
vParam:Pointer;
idDisp:integer;
vlProperty:variant;
idUserDefaultLC:integer;
begin
/// Objeto que fará a conexão com o banco de dados.
objFactory := CreateOleObject('CacheObject.Factory');
/// Aqui selecionar o namespace "SAMPLES".
objFactory.Connect(objFactory.ConnectDlg('Conexão'));
/// Abro um objeto do banco de dados.
obj := objFactory.OpenId('Sample.Person',10);
/// Esta vai ser a propriedade que vou acessar de forma dinamica (atravez do nome).
nmProperty := 'Name';
idUserDefaultLC := GetUserDefaultLCID;
IDispatch(obj).GetIDsOfNames(GUID_NULL, @nmProperty, 1, idUserDefaultLC, @idDisp);
vParam := nil;
IDispatch(Obj).Invoke(idDisp, GUID_NULL, idUserDefaultLC, DISPATCH_PROPERTYGET, vParam, @vlProperty, nil, nil);
/// Aqui mostro o valor da propriedade que foi recuperado.
ShowMessage(vlProperty);
end;
E este codigo abaixo demonstra como atribuir o valor a uma propriedade:
uses
ComObj, ActiveX;
procedure TForm1.Button2Click(Sender: TObject);
var
objFactory:variant;
obj:OleVariant;
nmProperty:PWideChar;
idDisp:integer;
idUserDefaultLC:integer;
rDispParams:TDispParams;
vlNew:OleVariant;
begin
/// Objeto que fará a conexão com o banco de dados.
objFactory := CreateOleObject('CacheObject.Factory');
/// Aqui selecionar o namespace "SAMPLES".
objFactory.Connect(objFactory.ConnectDlg('Conexão'));
/// Abro um objeto do banco de dados.
obj := objFactory.OpenId('Sample.Person',10);
/// Valor antes de alterar.
ShowMessage(obj.Name);
/// Esta vai ser a propriedade que vou acessar/alterar de forma dinamica (atravez do nome).
nmProperty := 'Name';
idUserDefaultLC := GetUserDefaultLCID;
IDispatch(obj).GetIDsOfNames(GUID_NULL, @nmProperty, 1, idUserDefaultLC, @idDisp);
/// Novo valor que vou atribuir na propriedade.
vlNew := 'alexandre';
with rDispParams do
begin
rgvarg := @vlNew;
rgdispidNamedArgs := @DispIDArgs;
cArgs := 1;
cNamedArgs := 1;
end;
IDispatch(obj).Invoke(idDisp, GUID_NULL, 0, DISPATCH_PROPERTYPUT, rDispParams, nil, nil, nil);
/// Valor depois de alterar.
ShowMessage(obj.Name);
end;
É isso ;) Agora quem gostar e for utilizar é só usar a imaginação para adicionar mais funcionalidades.
Obrigado a todos por lerem meu primeiro post, e fiquem a vontade para comentar e entrar em contato comigo para mais informações a respeito.
Assinar:
Postagens (Atom)