Cobol Foro
Registrarse
Temas de Hoy
Enlaces
Registrarse
Preguntas Frecuentes
Lista de Usuarios
Calendario
Cobol Foro
Navegación en el Foro
Retroceder   Cobol Foro Entornos de desarrollo y compiladores Cobol Cocina Casera Cocina PowerCOBOL
Actualizar esta página [PowerCOBOL + COM/OLE] Ligar ao Site da União Europeia VAT Number
Cocina PowerCOBOL Rutinas y ejemplos codificados por nuestros foreros.
 
Otros temas que te pueden interesar
Tema Autor Foro Respuestas Último post
[Compilador] Chave NetCobol v11 - serial number LUIZ ANTONIO DE OLIVEIRA NetCOBOL 1 5 de enero de 2019 15:58
Gerar Serial Number Paulo Cocina Casera 4 4 de septiembre de 2018 14:58

Respuesta
Página 1 de 3 1 23
 
Herramientas

  #1
Antiguo 2 de marzo de 2015, 17:09
Rapinto
Gran amigo del Foro
Guru de COBOL
Activista del Foro: Activista del Foro - Issue reason: ¡Gracias! Agradecimientos: Por muchos agradecimientos de parte de los Foreros - Issue reason: Por ayudar mucho a los foreros Guru de los Gurus: Por solidos y amplios conocimientos - Issue reason: Por saber demasiado! 
Última Actividad 29.01.2018 20:23
Posts Posts: 240
Likes enviados Enviados: 19
Likes recibidos Recibidos: 224
Ligar ao Site da União Europeia VAT Number
6
Likes

Celina
fastpho
Hrmcobol
Kuk
Lascu
Socavi

 Inactivo Inactivo
Código para aceder ao Site da União Europeia, para validar se o Numero VAT é Válido.

No caso de Numeros VAT (NIF) Portugues, o site devolve o nome, morada e Código Postal a quem pertence o Numero.
No caso Espanhol, só devolve "válido" ou "inválido" .

De qualquer modo apenas pretendo dar uma ajuda na utilização do COM+ (OLE2).

O ficheiro ZIP anexo é um PPJ da versão 9 do Fujitsu Cobol.

Quem não tiver a versão 9, aqui vai o código.

Código COBOL:
  1. REPOSITORY
  2.     CLASS COM AS "*COM"
  3.     CLASS COMEXCEPTION AS "*COM-EXCEPTION".

Criar 2 textbox como "CmPais-ISO" e "CMNRCONTR"
Criar + 3 textbox como "CMNOME" "CMMORADA" "CMCODP"
Criar um botão e no "Click" colocar o código:
Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01 WINHTTP               PIC X(128) VALUE "WinHttp.WinHttpRequest.5.1".
  5.  01 WSDL                  PIC X(256) VALUE "http://ec.europa.eu/taxation_customs/vies/checkVatService.wsdl".
  6.  01 xTraffic-Conditions.
  7.     03 xtr01 pic x(060) value "<?xml version=""1.0"" encoding=""UTF-8""?>".
  8.     03 xtr02 pic x(080) value "<SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"">".
  9.     03 xtr03 pic x(019) value "  <SOAP-ENV:Body>".
  10.     03 xtr04 pic x(086) value "    <tns1:checkVat xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types"">".
  11.     03 xtr05 pic x(024) value "      <tns1:countryCode>".
  12.     03 xtrPais PIC X(02) VALUE "PT".
  13.     03 XTR05A PIC X(20) VALUE  "</tns1:countryCode>".
  14.     03 xtr06 pic x(022) value "      <tns1:vatNumber>".
  15.     03 XTRNIF  PIC X(050) VALUE SPACE.
  16.     03 xtr07 pic x(022) value "    </tns1:checkVat>".
  17.     03 xtr08 pic x(020) value "  </SOAP-ENV:Body>".
  18.     03 xtr09 pic x(022) value "</SOAP-ENV:Envelope>".
  19.  01 Traffic-Conditions redefines xTraffic-Conditions pic x(386).
  20.  
  21.  01 WEBSERVICE USAGE OBJECT REFERENCE COM.
  22.  
  23.  01 OP1 PIC X(256) VALUE "POST".
  24.  01 OP2 PIC X(256) VALUE "http://ec.europa.eu/taxation_customs/vies/services/checkVatService/".
  25.  01 OP3 PIC X(256) VALUE "FALSE".
  26. *
  27.  01 OP4 PIC X(256) VALUE "Content-Type".
  28.  01 OP5 PIC X(256) VALUE "text/xml; charset=utf-8".
  29.  01 OP6 PIC X(256) VALUE "SOAPAction".
  30.  
  31.  01 COUNTER     pic s9(09) comp-5.
  32.  01 DMICON      pic s9(09) comp-5.
  33.  01 returnvalue pic s9(09) comp-5.
  34.  01 RESPOSTA    PIC X(8192).
  35.  01 NOME        PIC X(0064).
  36.  01 MORADA      PIC X(0256).
  37.  01 WMORADA     PIC X(0256).
  38.  01 MOR         PIC X(100).
  39.  01 LOCP        PIC X(100).
  40.  01 CODP        PIC X(012).
  41. *
  42.  01   MSG.
  43.     03  MSG01     PIC X(016)   VALUE "O resultado é: " .
  44.     03  MSG02     PIC X(015)   VALUE SPACE.
  45.     03  MSG03     PIC X(006)   VALUE "Nome: ".
  46.     03  MSG04     PIC X(061)   VALUE SPACE.
  47.     03  MSG05     PIC X(008)   VALUE "Morada: ".
  48.     03  MSG06     PIC X(061)   VALUE SPACE.
  49.     03  MSG07     PIC X(010)   VALUE "C.Postal:".
  50.     03  MSG08     PIC X(010)   VALUE SPACE.
  51.     03  MSG09     PIC X(080)   VALUE "Se pretende passar os dados para a Ficha, pressione o botão SIM.".
  52. *
  53.  
  54. *
  55.  PROCEDURE       DIVISION. 
  56.  MAIN SECTION.
  57.  MAIN-00.
  58.     MOVE SPACE TO XTRNIF.
  59.     IF "text" OF CmPais-ISO NOT = SPACE MOVE "text" OF CmPais-ISO TO xtrPais
  60.          ELSE 
  61.             MOVE ZERO TO DMICON
  62.             INVOKE POW-SELF "DisplayMessage" USING "Não tem País definido!"  "Teste" POW-DMICONINFORMATION
  63.             GO TO MAIN-99-EXIT.
  64.     IF "TEXT" OF CMNRCONTR NOT = SPACE MOVE "TEXT" OF CMNRCONTR TO XTRNIF
  65.         ELSE 
  66.         GO TO MAIN-99-EXIT.
  67.     MOVE ZERO TO COUNTER.
  68.     INSPECT XTRNIF TALLYING COUNTER  FOR ALL SPACES.
  69.     SUBTRACT COUNTER FROM 50 GIVING COUNTER. ADD 1 TO COUNTER. 
  70.     MOVE "</tns1:vatNumber>" TO XTRNIF(COUNTER:).
  71. *   INVOKE ButtonPlus1 "OpenWebsite" USING sAddress.
  72.     INVOKE COM "CREATE-OBJECT" USING WINHTTP RETURNING WEBSERVICE.
  73. *
  74.     INVOKE WEBSERVICE "OPEN" USING op1 op2 op3.
  75. *
  76.     INVOKE WEBSERVICE "setRequestHeader" USING OP6 OP4 .
  77.     INVOKE WEBSERVICE "setRequestHeader" USING OP6 OP5 .
  78.     INVOKE WEBSERVICE "setRequestHeader" using OP6 OP4 .
  79. *
  80.     INVOKE WEBSERVICE "send" USING TRAFFIC-CONDITIONS.
  81. *
  82.     INVOKE WEBSERVICE "get-Responsetext" RETURNING RESPOSTA.
  83. *****
  84.     MOVE RESPOSTA TO XMLLINHA.
  85.     MOVE "valid" TO XMLFIELDSEARCH.
  86.     CALL "GETXMLFIELD".
  87.     MOVE XMLFIELDRESULT TO OK.
  88.     IF XMLFIELDRESULT = "true" MOVE " VALIDO " TO MSG02
  89.          ELSE   MOVE "INVALIDO" TO MSG02.
  90.     MOVE X"0A0A0A" TO MSG02(12:3).
  91. *
  92.     MOVE "name" TO XMLFIELDSEARCH.
  93.     CALL "GETXMLFIELD".
  94.     move XMLFIELDRESULT TO MSG04.
  95. *
  96.     MOVE "address" TO XMLFIELDSEARCH.
  97.     CALL "GETXMLFIELD".
  98.     move XMLFIELDRESULT TO MORADA.
  99. *
  100.     MOVE X"0A" TO MSG04(60:1).
  101.     UNSTRING MORADA DELIMITED BY "<" INTO WMORADA.
  102.     UNSTRING WMORADA DELIMITED BY X"0A" INTO MOR  COUNT IN COUNTER
  103.                                              LOCP COUNT IN COUNTER
  104.                                              CODP COUNT IN COUNTER.
  105.     MOVE MOR TO MSG06.
  106.     MOVE CODP TO MSG08.
  107.     MOVE SPACE TO MSG08(9:).
  108.     MOVE X"0D0A" TO MSG06(60:1).
  109.  MAIN-70.
  110.     IF OK NOT = "t" GO TO MAIN-80.
  111.     IF "ENABLED" OF CMNOME = POW-FALSE GO TO MAIN-80.
  112.     MOVE X"0A0A" TO MSG09.
  113.     MOVE "  Se pretende passar os dados para a Ficha, pressione o botão SIM." TO MSG09.
  114.     MOVE X"0A0A" TO MSG09(1:2).
  115.     MOVE ZERO TO DMICON.
  116.     ADD POW-DMICONINFORMATION POW-DMYESNO POW-DMDEFBUTTON2 TO DMICON.
  117.     INVOKE POW-SELF "DisplayMessage" USING MSG "R.P.S. - Faturação" DMICON
  118.                RETURNING ReturnValue.
  119.     IF RETURNVALUE = POW-DMRYES
  120.          MOVE MSG04 TO "TEXT" OF CMNOME
  121.          MOVE MSG06 TO "TEXT" OF CMMORADA
  122.          MOVE MSG08 TO "TEXT" OF CMCODP.
  123.     GO TO MAIN-90.
  124.  MAIN-80.
  125.     MOVE SPACE TO MSG09.
  126.     MOVE ZERO TO DMICON.
  127.     INVOKE POW-SELF "DisplayMessage" USING MSG "R.P.S. - Faturação" POW-DMICONINFORMATION
  128.                RETURNING ReturnValue.
  129.  MAIN-90.
  130.     SET WEBSERVICE TO NULL.
  131.     MOVE SPACE TO NOME MOR LOCP CODP RESPOSTA.
  132.  MAIN-99-EXIT.
  133.     EXIT PROGRAM.

Espero que ajude alguém.

Saludos,
Rui Pinto
Archivos Adjuntos
Tipo de Archivo: zip Site_UE.zip (7,9 KB)Descargas: 229
Rapinto is offline   Responder Con Cita
  #2
Antiguo 2 de marzo de 2015, 17:14
Rapinto
Gran amigo del Foro
Guru de COBOL
Activista del Foro: Activista del Foro - Issue reason: ¡Gracias! Agradecimientos: Por muchos agradecimientos de parte de los Foreros - Issue reason: Por ayudar mucho a los foreros Guru de los Gurus: Por solidos y amplios conocimientos - Issue reason: Por saber demasiado! 
Última Actividad 29.01.2018 20:23
Posts Posts: 240
Likes enviados Enviados: 19
Likes recibidos Recibidos: 224
Predeterminado
4
Likes

Celina
fastpho
Kuk
Lascu

 Inactivo Inactivo
Como já não aceitava mais vai neste Post o código para a "New Procedure" GETXMLFIELD":
Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01   WFIELDSEARCH            PIC X(0128).
  5.  01   WFIELDSEARCHEND         PIC X(0128).
  6.  01   XMLIDX.
  7.     03  XMLIDX1                 PIC S9(009).
  8.     03  XMLIDX2                 PIC S9(009).
  9.     03  XMLIDX3                 PIC S9(009).
  10.     03  XMLIDX8                 PIC S9(009).
  11.     03  XMLIDX9                 PIC S9(009).
  12. *
  13.  PROCEDURE       DIVISION.
  14.  MAIN SECTION.
  15.  MAIN-00.
  16. *
  17.     INITIALIZE XMLIDX WFIELDSEARCH WFIELDSEARCHEND XMLFIELDRESULT.
  18.     IF XMLLINHA = SPACE GO TO MAIN-99-EXIT.
  19.     IF XMLFIELDSEARCH = SPACE GO TO MAIN-99-EXIT.
  20.     MOVE "<" TO WFIELDSEARCH.
  21.     MOVE XMLFIELDSEARCH TO WFIELDSEARCH(2:)
  22.     PERFORM VARYING XMLIDX8 FROM 128 BY -1 UNTIL XMLIDX8 < 1
  23.          IF WFIELDSEARCH(XMLIDX8:1) NOT = SPACE
  24.               ADD 1 TO XMLIDX8
  25.               MOVE ">" TO WFIELDSEARCH(XMLIDX8:1)
  26.               EXIT PERFORM
  27.          END-IF
  28.     END-PERFORM.
  29. *   SUBTRACT XMLIDX8 FROM 128 GIVING XMLIDX8.
  30.     MOVE "</" TO WFIELDSEARCHEND.
  31.     MOVE WFIELDSEARCH(2:) TO WFIELDSEARCHEND(3:).
  32.     MOVE XMLIDX8  TO XMLIDX9.
  33.     ADD 1 TO XMLIDX9.
  34.  MAIN-05.
  35.     PERFORM VARYING XMLIDX1 FROM 1 BY 1 UNTIL XMLIDX1 > 8196
  36.           IF XMLLINHA(XMLIDX1:XMLIDX8) = WFIELDSEARCH
  37.               ADD XMLIDX8 TO XMLIDX1
  38.               EXIT PERFORM
  39.           END-IF 
  40.     END-PERFORM
  41.     IF XMLIDX1 > 8195 GO TO MAIN-99-EXIT.
  42.     PERFORM VARYING XMLIDX2 FROM XMLIDX1 BY 1 UNTIL XMLIDX2 > 8196
  43.           IF XMLLINHA(XMLIDX2:XMLIDX9) = WFIELDSEARCHEND
  44.               ADD 1 TO XMLIDX2
  45.               EXIT PERFORM
  46.           END-IF 
  47.           IF XMLLINHA(XMLIDX2:1) = "<" 
  48.                 MOVE "<" TO XMLFIELDRESULT
  49.                 MOVE 8186 TO XMLIDX2
  50.                 EXIT PERFORM
  51.           END-IF
  52.     END-PERFORM
  53.     IF XMLIDX2 > 8195 GO TO MAIN-99-EXIT.
  54.     SUBTRACT 1 FROM XMLIDX2.
  55.     SUBTRACT XMLIDX1 FROM XMLIDX2 GIVING XMLIDX3.
  56.     MOVE XMLLINHA(XMLIDX1:XMLIDX3) TO XMLFIELDRESULT.
  57.  MAIN-99-EXIT.
  58.     EXIT PROGRAM.  
Rapinto is offline   Responder Con Cita
  #3
Antiguo 29 de enero de 2018, 17:37
Joseg
El Foro es mi casa
Activista del Foro: Activista del Foro - Issue reason: Por participación activa Innovación: Por aportar innovaciones - Issue reason: Por aportar soluciones innovadoras en varias ocasiones 
Última Actividad 17.09.2026 18:23
Posts Posts: 401
Likes enviados Enviados: 130
Likes recibidos Recibidos: 179
Predeterminado
0
Likes

None...

Inactivo Inactivo
Citación del post de Rapinto Ver Mensaje
❞
Como já não aceitava mais vai neste Post o código para a "New Procedure" GETXMLFIELD":
Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01   WFIELDSEARCH            PIC X(0128).
  5.  01   WFIELDSEARCHEND         PIC X(0128).
  6.  01   XMLIDX.
  7.     03  XMLIDX1                 PIC S9(009).
  8.     03  XMLIDX2                 PIC S9(009).
  9.     03  XMLIDX3                 PIC S9(009).
  10.     03  XMLIDX8                 PIC S9(009).
  11.     03  XMLIDX9                 PIC S9(009).
  12. *
  13.  PROCEDURE       DIVISION.
  14.  MAIN SECTION.
  15.  MAIN-00.
  16. *
  17.     INITIALIZE XMLIDX WFIELDSEARCH WFIELDSEARCHEND XMLFIELDRESULT.
  18.     IF XMLLINHA = SPACE GO TO MAIN-99-EXIT.
  19.     IF XMLFIELDSEARCH = SPACE GO TO MAIN-99-EXIT.
  20.     MOVE "<" TO WFIELDSEARCH.
  21.     MOVE XMLFIELDSEARCH TO WFIELDSEARCH(2:)
  22.     PERFORM VARYING XMLIDX8 FROM 128 BY -1 UNTIL XMLIDX8 < 1
  23.          IF WFIELDSEARCH(XMLIDX8:1) NOT = SPACE
  24.               ADD 1 TO XMLIDX8
  25.               MOVE ">" TO WFIELDSEARCH(XMLIDX8:1)
  26.               EXIT PERFORM
  27.          END-IF
  28.     END-PERFORM.
  29. *   SUBTRACT XMLIDX8 FROM 128 GIVING XMLIDX8.
  30.     MOVE "</" TO WFIELDSEARCHEND.
  31.     MOVE WFIELDSEARCH(2:) TO WFIELDSEARCHEND(3:).
  32.     MOVE XMLIDX8  TO XMLIDX9.
  33.     ADD 1 TO XMLIDX9.
  34.  MAIN-05.
  35.     PERFORM VARYING XMLIDX1 FROM 1 BY 1 UNTIL XMLIDX1 > 8196
  36.           IF XMLLINHA(XMLIDX1:XMLIDX8) = WFIELDSEARCH
  37.               ADD XMLIDX8 TO XMLIDX1
  38.               EXIT PERFORM
  39.           END-IF 
  40.     END-PERFORM
  41.     IF XMLIDX1 > 8195 GO TO MAIN-99-EXIT.
  42.     PERFORM VARYING XMLIDX2 FROM XMLIDX1 BY 1 UNTIL XMLIDX2 > 8196
  43.           IF XMLLINHA(XMLIDX2:XMLIDX9) = WFIELDSEARCHEND
  44.               ADD 1 TO XMLIDX2
  45.               EXIT PERFORM
  46.           END-IF 
  47.           IF XMLLINHA(XMLIDX2:1) = "<" 
  48.                 MOVE "<" TO XMLFIELDRESULT
  49.                 MOVE 8186 TO XMLIDX2
  50.                 EXIT PERFORM
  51.           END-IF
  52.     END-PERFORM
  53.     IF XMLIDX2 > 8195 GO TO MAIN-99-EXIT.
  54.     SUBTRACT 1 FROM XMLIDX2.
  55.     SUBTRACT XMLIDX1 FROM XMLIDX2 GIVING XMLIDX3.
  56.     MOVE XMLLINHA(XMLIDX1:XMLIDX3) TO XMLFIELDRESULT.
  57.  MAIN-99-EXIT.
  58.     EXIT PROGRAM.  

Este código deixou de funcionar. Houve alterações?
Joseg is offline   Responder Con Cita
  #4
Antiguo 29 de enero de 2018, 19:53
Rapinto
Gran amigo del Foro
Guru de COBOL
Activista del Foro: Activista del Foro - Issue reason: ¡Gracias! Agradecimientos: Por muchos agradecimientos de parte de los Foreros - Issue reason: Por ayudar mucho a los foreros Guru de los Gurus: Por solidos y amplios conocimientos - Issue reason: Por saber demasiado! 
Última Actividad 29.01.2018 20:23
Posts Posts: 240
Likes enviados Enviados: 19
Likes recibidos Recibidos: 224
Predeterminado
1
Likes

Joseg

 Inactivo Inactivo
Joseg,

Depois de tanto tempo a funcionar, eles devem ter acertado qualquer coisa.
O erro parece-me ser no:
Código COBOL:
  1.  Traffic-Conditions redefines xTraffic-Conditions pic x(386).
tem que ter pic x(417)
Enganei-me a somar os tamanhos todos.
A string não chegava lá completa mas funcionava e eu nunca dei por ela.
Agora devem ter acertado alguma coisa e o programa queixou-se.

Um abraço,
Rui Pinto
Rapinto is offline   Responder Con Cita
  #5
Antiguo 30 de enero de 2018, 13:14
Joseg
El Foro es mi casa
Activista del Foro: Activista del Foro - Issue reason: Por participación activa Innovación: Por aportar innovaciones - Issue reason: Por aportar soluciones innovadoras en varias ocasiones 
Última Actividad 17.09.2026 18:23
Posts Posts: 401
Likes enviados Enviados: 130
Likes recibidos Recibidos: 179
Predeterminado
0
Likes

None...

Inactivo Inactivo
Citación del post de Rapinto Ver Mensaje
❞
Joseg,

Depois de tanto tempo a funcionar, eles devem ter acertado qualquer coisa.
O erro parece-me ser no:
Código COBOL:
  1.  Traffic-Conditions redefines xTraffic-Conditions pic x(386).
tem que ter pic x(417)
Enganei-me a somar os tamanhos todos.
A string não chegava lá completa mas funcionava e eu nunca dei por ela.
Agora devem ter acertado alguma coisa e o programa queixou-se.

Um abraço,
Rui Pinto

Obrigado, já esta ok

Abraço
Joseg is offline   Responder Con Cita
  #6
Antiguo 9 de noviembre de 2021, 17:41
Joseg
El Foro es mi casa
Activista del Foro: Activista del Foro - Issue reason: Por participación activa Innovación: Por aportar innovaciones - Issue reason: Por aportar soluciones innovadoras en varias ocasiones 
Última Actividad 17.09.2026 18:23
Posts Posts: 401
Likes enviados Enviados: 130
Likes recibidos Recibidos: 179
Predeterminado
0
Likes

None...

Inactivo Inactivo
Citación del post de Rapinto Ver Mensaje
❞
Código para aceder ao Site da União Europeia, para validar se o Numero VAT é Válido.

No caso de Numeros VAT (NIF) Portugues, o site devolve o nome, morada e Código Postal a quem pertence o Numero.
No caso Espanhol, só devolve "válido" ou "inválido" .

De qualquer modo apenas pretendo dar uma ajuda na utilização do COM+ (OLE2).

O ficheiro ZIP anexo é um PPJ da versão 9 do Fujitsu Cobol.

Quem não tiver a versão 9, aqui vai o código.

Código COBOL:
  1. REPOSITORY
  2.     CLASS COM AS "*COM"
  3.     CLASS COMEXCEPTION AS "*COM-EXCEPTION".

Criar 2 textbox como "CmPais-ISO" e "CMNRCONTR"
Criar + 3 textbox como "CMNOME" "CMMORADA" "CMCODP"
Criar um botão e no "Click" colocar o código:
Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01 WINHTTP               PIC X(128) VALUE "WinHttp.WinHttpRequest.5.1".
  5.  01 WSDL                  PIC X(256) VALUE "http://ec.europa.eu/taxation_customs/vies/checkVatService.wsdl".
  6.  01 xTraffic-Conditions.
  7.     03 xtr01 pic x(060) value "<?xml version=""1.0"" encoding=""UTF-8""?>".
  8.     03 xtr02 pic x(080) value "<SOAP-ENV:Envelope xmlns:SOAP-ENV=""http://schemas.xmlsoap.org/soap/envelope/"">".
  9.     03 xtr03 pic x(019) value "  <SOAP-ENV:Body>".
  10.     03 xtr04 pic x(086) value "    <tns1:checkVat xmlns:tns1=""urn:ec.europa.eu:taxud:vies:services:checkVat:types"">".
  11.     03 xtr05 pic x(024) value "      <tns1:countryCode>".
  12.     03 xtrPais PIC X(02) VALUE "PT".
  13.     03 XTR05A PIC X(20) VALUE  "</tns1:countryCode>".
  14.     03 xtr06 pic x(022) value "      <tns1:vatNumber>".
  15.     03 XTRNIF  PIC X(050) VALUE SPACE.
  16.     03 xtr07 pic x(022) value "    </tns1:checkVat>".
  17.     03 xtr08 pic x(020) value "  </SOAP-ENV:Body>".
  18.     03 xtr09 pic x(022) value "</SOAP-ENV:Envelope>".
  19.  01 Traffic-Conditions redefines xTraffic-Conditions pic x(386).
  20.  
  21.  01 WEBSERVICE USAGE OBJECT REFERENCE COM.
  22.  
  23.  01 OP1 PIC X(256) VALUE "POST".
  24.  01 OP2 PIC X(256) VALUE "http://ec.europa.eu/taxation_customs/vies/services/checkVatService/".
  25.  01 OP3 PIC X(256) VALUE "FALSE".
  26. *
  27.  01 OP4 PIC X(256) VALUE "Content-Type".
  28.  01 OP5 PIC X(256) VALUE "text/xml; charset=utf-8".
  29.  01 OP6 PIC X(256) VALUE "SOAPAction".
  30.  
  31.  01 COUNTER     pic s9(09) comp-5.
  32.  01 DMICON      pic s9(09) comp-5.
  33.  01 returnvalue pic s9(09) comp-5.
  34.  01 RESPOSTA    PIC X(8192).
  35.  01 NOME        PIC X(0064).
  36.  01 MORADA      PIC X(0256).
  37.  01 WMORADA     PIC X(0256).
  38.  01 MOR         PIC X(100).
  39.  01 LOCP        PIC X(100).
  40.  01 CODP        PIC X(012).
  41. *
  42.  01   MSG.
  43.     03  MSG01     PIC X(016)   VALUE "O resultado é: " .
  44.     03  MSG02     PIC X(015)   VALUE SPACE.
  45.     03  MSG03     PIC X(006)   VALUE "Nome: ".
  46.     03  MSG04     PIC X(061)   VALUE SPACE.
  47.     03  MSG05     PIC X(008)   VALUE "Morada: ".
  48.     03  MSG06     PIC X(061)   VALUE SPACE.
  49.     03  MSG07     PIC X(010)   VALUE "C.Postal:".
  50.     03  MSG08     PIC X(010)   VALUE SPACE.
  51.     03  MSG09     PIC X(080)   VALUE "Se pretende passar os dados para a Ficha, pressione o botão SIM.".
  52. *
  53.  
  54. *
  55.  PROCEDURE       DIVISION. 
  56.  MAIN SECTION.
  57.  MAIN-00.
  58.     MOVE SPACE TO XTRNIF.
  59.     IF "text" OF CmPais-ISO NOT = SPACE MOVE "text" OF CmPais-ISO TO xtrPais
  60.          ELSE 
  61.             MOVE ZERO TO DMICON
  62.             INVOKE POW-SELF "DisplayMessage" USING "Não tem País definido!"  "Teste" POW-DMICONINFORMATION
  63.             GO TO MAIN-99-EXIT.
  64.     IF "TEXT" OF CMNRCONTR NOT = SPACE MOVE "TEXT" OF CMNRCONTR TO XTRNIF
  65.         ELSE 
  66.         GO TO MAIN-99-EXIT.
  67.     MOVE ZERO TO COUNTER.
  68.     INSPECT XTRNIF TALLYING COUNTER  FOR ALL SPACES.
  69.     SUBTRACT COUNTER FROM 50 GIVING COUNTER. ADD 1 TO COUNTER. 
  70.     MOVE "</tns1:vatNumber>" TO XTRNIF(COUNTER:).
  71. *   INVOKE ButtonPlus1 "OpenWebsite" USING sAddress.
  72.     INVOKE COM "CREATE-OBJECT" USING WINHTTP RETURNING WEBSERVICE.
  73. *
  74.     INVOKE WEBSERVICE "OPEN" USING op1 op2 op3.
  75. *
  76.     INVOKE WEBSERVICE "setRequestHeader" USING OP6 OP4 .
  77.     INVOKE WEBSERVICE "setRequestHeader" USING OP6 OP5 .
  78.     INVOKE WEBSERVICE "setRequestHeader" using OP6 OP4 .
  79. *
  80.     INVOKE WEBSERVICE "send" USING TRAFFIC-CONDITIONS.
  81. *
  82.     INVOKE WEBSERVICE "get-Responsetext" RETURNING RESPOSTA.
  83. *****
  84.     MOVE RESPOSTA TO XMLLINHA.
  85.     MOVE "valid" TO XMLFIELDSEARCH.
  86.     CALL "GETXMLFIELD".
  87.     MOVE XMLFIELDRESULT TO OK.
  88.     IF XMLFIELDRESULT = "true" MOVE " VALIDO " TO MSG02
  89.          ELSE   MOVE "INVALIDO" TO MSG02.
  90.     MOVE X"0A0A0A" TO MSG02(12:3).
  91. *
  92.     MOVE "name" TO XMLFIELDSEARCH.
  93.     CALL "GETXMLFIELD".
  94.     move XMLFIELDRESULT TO MSG04.
  95. *
  96.     MOVE "address" TO XMLFIELDSEARCH.
  97.     CALL "GETXMLFIELD".
  98.     move XMLFIELDRESULT TO MORADA.
  99. *
  100.     MOVE X"0A" TO MSG04(60:1).
  101.     UNSTRING MORADA DELIMITED BY "<" INTO WMORADA.
  102.     UNSTRING WMORADA DELIMITED BY X"0A" INTO MOR  COUNT IN COUNTER
  103.                                              LOCP COUNT IN COUNTER
  104.                                              CODP COUNT IN COUNTER.
  105.     MOVE MOR TO MSG06.
  106.     MOVE CODP TO MSG08.
  107.     MOVE SPACE TO MSG08(9:).
  108.     MOVE X"0D0A" TO MSG06(60:1).
  109.  MAIN-70.
  110.     IF OK NOT = "t" GO TO MAIN-80.
  111.     IF "ENABLED" OF CMNOME = POW-FALSE GO TO MAIN-80.
  112.     MOVE X"0A0A" TO MSG09.
  113.     MOVE "  Se pretende passar os dados para a Ficha, pressione o botão SIM." TO MSG09.
  114.     MOVE X"0A0A" TO MSG09(1:2).
  115.     MOVE ZERO TO DMICON.
  116.     ADD POW-DMICONINFORMATION POW-DMYESNO POW-DMDEFBUTTON2 TO DMICON.
  117.     INVOKE POW-SELF "DisplayMessage" USING MSG "R.P.S. - Faturação" DMICON
  118.                RETURNING ReturnValue.
  119.     IF RETURNVALUE = POW-DMRYES
  120.          MOVE MSG04 TO "TEXT" OF CMNOME
  121.          MOVE MSG06 TO "TEXT" OF CMMORADA
  122.          MOVE MSG08 TO "TEXT" OF CMCODP.
  123.     GO TO MAIN-90.
  124.  MAIN-80.
  125.     MOVE SPACE TO MSG09.
  126.     MOVE ZERO TO DMICON.
  127.     INVOKE POW-SELF "DisplayMessage" USING MSG "R.P.S. - Faturação" POW-DMICONINFORMATION
  128.                RETURNING ReturnValue.
  129.  MAIN-90.
  130.     SET WEBSERVICE TO NULL.
  131.     MOVE SPACE TO NOME MOR LOCP CODP RESPOSTA.
  132.  MAIN-99-EXIT.
  133.     EXIT PROGRAM.

Espero que ajude alguém.

Saludos,
Rui Pinto

Este código deixou de funcionar
Alguém pode ajudar?

Saludos!
Joseg is offline   Responder Con Cita
  #7
Antiguo 9 de noviembre de 2021, 18:21
Kuk
Administrador
Última Actividad 19.09.2026 20:11
Posts Posts: 2.500
Likes enviados Enviados: 1037
Likes recibidos Recibidos: 1207
Predeterminado
0
Likes

None...

Inactivo Inactivo
@Joseg, qué error te sale? Esto ayudará entender qué es lo que falla.


NORMAS DEL FORO - para garantizar el buen funcionamiento del Foro.
¿Te han ayudado? NO TE OLVIDES de darle a
¿Quieres dirigirte a alguien en tu post? Notifícale haciendo clic en su Nick
Kuk is offline   Responder Con Cita
  #8
Antiguo 9 de noviembre de 2021, 19:12
Joseg
El Foro es mi casa
Activista del Foro: Activista del Foro - Issue reason: Por participación activa Innovación: Por aportar innovaciones - Issue reason: Por aportar soluciones innovadoras en varias ocasiones 
Última Actividad 17.09.2026 18:23
Posts Posts: 401
Likes enviados Enviados: 130
Likes recibidos Recibidos: 179
Predeterminado
0
Likes

None...

Inactivo Inactivo
Citación del post de Kuk Ver Mensaje
❞
@Joseg, qué error te sale? Esto ayudará entender qué es lo que falla.
Nesta linha:
Código COBOL:
  1. INVOKE WEBSERVICE "get-Responsetext" RETURNING RESPOSTA.

"RESPOSTA" é a seguinte:
Código XML:
  1. <soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"><soap:Body><soap:Fault><faultcode>soap:Server</faultcode><faultstring>The given SOAPAction
  2.  Content-Type does not match an operation.</faultstring></soap:Fault></soap:Body></soap:Envelope>
Joseg is offline   Responder Con Cita
  #9
Antiguo 9 de noviembre de 2021, 20:05
Kuk
Administrador
Última Actividad 19.09.2026 20:11
Posts Posts: 2.500
Likes enviados Enviados: 1037
Likes recibidos Recibidos: 1207
Predeterminado
1
Likes

Joseg

 Inactivo Inactivo
@Joseg, el tiene pinta de venir de aquí:

Código COBOL:
  1.  01 OP5 PIC X(256) VALUE "text/xml; charset=utf-8".

Te propongo que te descargues el programa SoapUI o hagas unos test en un cliente Soap Online como este: SOAP Web Client

Una vez hayas encontrado el problema, corrijas el código Cobol.


NORMAS DEL FORO - para garantizar el buen funcionamiento del Foro.
¿Te han ayudado? NO TE OLVIDES de darle a
¿Quieres dirigirte a alguien en tu post? Notifícale haciendo clic en su Nick
Kuk is offline   Responder Con Cita
  #10
Antiguo 9 de noviembre de 2021, 20:39
Joseg
El Foro es mi casa
Activista del Foro: Activista del Foro - Issue reason: Por participación activa Innovación: Por aportar innovaciones - Issue reason: Por aportar soluciones innovadoras en varias ocasiones 
Última Actividad 17.09.2026 18:23
Posts Posts: 401
Likes enviados Enviados: 130
Likes recibidos Recibidos: 179
Predeterminado
0
Likes

None...

Inactivo Inactivo
Citación del post de Kuk Ver Mensaje
❞
@Joseg, el tiene pinta de venir de aquí:

Código COBOL:
  1.  01 OP5 PIC X(256) VALUE "text/xml; charset=utf-8".

Te propongo que te descargues el programa SoapUI o hagas unos test en un cliente Soap Online como este: SOAP Web Client

Una vez hayas encontrado el problema, corrijas el código Cobol.
Gracias pela dica !!!!

Pode ser um problema no servidor, mas no link que me enviaste também não dá.

Consegues validar um NIF de Espanha, ou de outro país?

Saludos,
Joseg is offline   Responder Con Cita
Respuesta
Página 1 de 3 1 23

« Tema Anterior | Próximo Tema »


Derechos de Publicación
No puedes publicar nuevos temas
No puedes publicar posts/responder
No puedes adjuntar archivos
No puedes editar tus posts
BB code is habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 15:39.
Powered by: vBulletin, Versión 3.8.7
Derechos de Autor ©2000 - 2026, Jelsoft Enterprises Ltd.

Top
 Archivo - Cobol Foro
Webdesign by: vbdesigns.de
Contactar con Nosotros - Cobol Foro
Top