Gracias Rui Pinto (Rapinto)
COBOL Foro
Foro dedicado a COBOL, a la Programación y a la Informática.
  COBOL Foro > IDE-s y compiladores COBOL > Fujitsu COBOL > PowerCOBOL (ActiveX, v4 - v11)
PowerCOBOL (ActiveX, v4 - v11) Versiones del IDE basadas en ActiveX
Comunicados
Otros temas que te pueden interesar
Tema Autor Foro Respuestas Último post
[Componente] Generador de hash (Base64 u otro) Joseg PowerCOBOL (ActiveX, v4 - v11) 18 14 de julio de 2018 15:34
Respuesta
 
Herramientas

  #1
Antiguo 27 de diciembre de 2020, 19:58
IDENTIFICATION DIVISION
Lascu
 Novato Junior
ENVIRONMENT DIVISION
Avatar de Lascu
DATA DIVISION
noviembre 2015
Videla, Santa Fe
28.05.2021 01:27
PROCEDURE DIVISION
Posts: 31
Enviado: 49
Recibido: 16
Soluiones: 1
Reputación: 0
Lascu is on a distinguished road Lascu is on a distinguished road
Predeterminado OCX que codifique/decodifique en base64

Hola grupo

Alguien conoce un componente ocx que como acepte un campo alfanumérico (string) como entrada y devuelva ese campo codificado en base64 (y viceversa). Para los que son de Argentina, es para implementar la impresión del QR en las facturas electrónicas.
Gracias

Marcelo Lascurain
Lascu no ha iniciado sesión   Responder Con Cita
  #2
Antiguo 27 de diciembre de 2020, 23:21
IDENTIFICATION DIVISION
Kuk
 Administrador
ENVIRONMENT DIVISION
Avatar de Kuk
DATA DIVISION
diciembre 2014
Madrid
36 años
19.06.2021 11:02
PROCEDURE DIVISION
Posts: 1.755
Enviado: 552
Recibido: 722
Soluiones: 94
Reputación: 10
Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road
Predeterminado

@Lascu, has mirado esto: [Componente] Generador de hash (Base64 u otro) - COBOL Foro ?



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 no ha iniciado sesión   Responder Con Cita
Ha dicho Gracias : 1
Lascu (29 de diciembre de 2020)
  #3
Antiguo 28 de diciembre de 2020, 13:58
IDENTIFICATION DIVISION
Gusaiello
 Novato Senior
Concurso: Segundo puesto: Ganador/a del Segundo puesto en un concurso - Razón: Generador de código QR encriptado  Activista del Foro: Activista del Foro - Razón: Por aportar ejecrcicios para los novatos 
ENVIRONMENT DIVISION
Avatar de Gusaiello
DATA DIVISION
febrero 2015
Quilmes, Buenos Aires
66 años
19.06.2021 12:34
PROCEDURE DIVISION
Posts: 141
Enviado: 54
Recibido: 98
Soluiones: 7
Reputación: 16
Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road
Predeterminado

Cita del post de Lascu Ver Mensaje
QR en las facturas electrónicas.
QR en facturas electrónicas?.
Estoy desactualizado?, por que de acuerdo a lo último que leí en los instructivos de Afip, es un código 2 of 5 interleaved.

Te agradecería cualquier dato que me puedas pasar.
Gracias.
Gusaiello no ha iniciado sesión   Responder Con Cita
  #4
Antiguo 28 de diciembre de 2020, 14:59
IDENTIFICATION DIVISION
fastpho
 Novato Senior
Concurso: Primer puesto: Ganador/a del Primer puesto en un concurso - Razón: Acceso a datos Cobol vía web 
ENVIRONMENT DIVISION
Avatar de fastpho
DATA DIVISION
diciembre 2016
Mendoza
50 años
18.06.2021 19:58
PROCEDURE DIVISION
Posts: 146
Enviado: 99
Recibido: 84
Soluiones: 19
Reputación: 13
fastpho is an unknown quantity at this point fastpho is an unknown quantity at this point fastpho is an unknown quantity at this point fastpho is an unknown quantity at this point fastpho is an unknown quantity at this point fastpho is an unknown quantity at this point fastpho is an unknown quantity at this point
Predeterminado

@Lascu, Hola , te adjunto con ejemplo para convertir string a base64 y viceversa esta echo en vb6 , lo podes convertir a ocx , te paso el link https://www.vbforums.com/showthread....de-base64-text se llama CryptoBase64.zip lo probe y funciona
fastpho no ha iniciado sesión   Responder Con Cita
Ha dicho Gracias : 1
Lascu (29 de diciembre de 2020)
  #5
Antiguo 28 de diciembre de 2020, 19:15
IDENTIFICATION DIVISION
JCantero
 Novato Senior
ENVIRONMENT DIVISION
Avatar de JCantero
DATA DIVISION
junio 2016
Albacete
55 años
19.06.2021 20:23
PROCEDURE DIVISION
Posts: 181
Enviado: 53
Recibido: 120
Soluiones: 8
Reputación: 18
JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road
Predeterminado

Yo en linux lo hago con comandos del propio sistema.

En windows lo hago con un programa de cobol.

Me gusta hacer rutinas cuando no tengo algo estandard y fiable que funcione siempre sin depender de otros

Funciona con RM/Cobol y habria que adaptarlo para otros compiladores.
Si es de utilidad lo paso

---------- Post añadido : 20:15 ---------- Post anterior : 20:05 ----------

Código COBOL:
  1.        identification division.
  2.        program-id.  sibase64.
  3.      *
  4.      * CALL "sibase64" USING fichero fichero-dest
  5.      *  
  6.      * llamado desde windows por sivisors, en linux existe comando
  7.      *         ( jcantero )
  8.        environment division.                                                    
  9.        configuration section.                                                  
  10.        source-computer.  rmcobol-85.                                            
  11.        object-computer.  rmcobol-85.                                            
  12.        special-names.                                                          
  13.            decimal-point is comma.                                              
  14.      *                                                                        
  15.        input-output section.                                                    
  16.        file-control.                                                            
  17.      *                                                                        
  18.            select atr01 assign to random, nombre-atr01                          
  19.                   organization sequential                                  
  20.                   access mode is sequential                                    
  21.                   file status is fs-atr01.                                      
  22.            
  23.            select atr01j assign to random, nombre-atr01j                          
  24.                   organization sequential                                  
  25.                   access mode is sequential                                    
  26.                   file status is fs-atr01j.                                      
  27.            
  28.            
  29.                                                                                
  30.        
  31.        data division.
  32.        file section.                                                            
  33.      *                                                                        
  34.        fd  atr01.
  35.        01  reg-atr01.
  36.            02 atr-cabecera pic x(3).
  37.            
  38.        fd  atr01j.
  39.        01  reg-atr01j.
  40.            02 atr-cabeceraj pic x(4).
  41.        working-storage section.
  42.        01 nombre-atr01    pic x(80).                                            
  43.        01 nombre-atr01j    pic x(80).                                            
  44.        01 nombre-atr01jx    pic x(80).                                            
  45.        01 mensaje pic x(200).
  46.        
  47.        01 fs-atr01         pic xx.                                              
  48.               88 esta-atr01         value '00' '02'.                            
  49.               88 n-esta-atr01       value '23'.                                
  50.               88 fin-atr01          value '46'  '10'.                          
  51.               88 bloqueado-atr01    value '99'.                                
  52.               88 f-bloqueado-atr01  value '38' '93'.                            
  53.               88 f-noexiste-atr01   value '35'.                                
  54.        
  55.        01 fs-atr01j         pic xx.                                              
  56.               88 esta-atr01j         value '00' '02'.                            
  57.               88 n-esta-atr01j       value '23'.                                
  58.               88 fin-atr01j          value '46'  '10'.                          
  59.               88 bloqueado-atr01j    value '99'.                                
  60.               88 f-bloqueado-atr01j  value '38' '93'.                            
  61.               88 f-noexiste-atr01j   value '35'.                                
  62.        
  63.  
  64.        01  binary(2).
  65.            02  i                       pic 9(4).
  66.            02  j                       pic 9(4).
  67.            02  k                       pic 9(4).
  68.  
  69.        01  message-length              pic 9(6) binary.
  70.        01  base64-message-length       pic 9(6) binary.
  71.        01  triplet-count               pic 9(6) binary.
  72.        01  trailing-count              pic 9(6) binary.
  73.  
  74.  
  75.  
  76.        01  Base64-Alphabet             pic x(64) value
  77.                    "ABCDEFGHIJKLMNOPQRSTUVWXYZ" &
  78.                    "abcdefghijklmnopqrstuvwxyz" &
  79.                    "0123456789" &
  80.                    "+/".
  81.  
  82.        01  b64-triplet.
  83.            05  b64-4octets.
  84.                07                      pic x.
  85.                07  b64-3octets.
  86.                    09                  pic x.
  87.                    09  b64-2octets.
  88.                        11              pic x.
  89.                        11  b64-1octet  pic x.
  90.        01  redefines b64-triplet.
  91.            05  b64-octet           pic 999 binary(1) occurs 4.
  92.  
  93.        01  ARGUMENT-DESCRIPTION        BINARY(2).
  94.            02  ARGUMENT-TYPE           PIC 9(2).
  95.            02  ARGUMENT-LENGTH         PIC 9(8) BINARY(4).
  96.            02  ARGUMENT-DIGIT-COUNT    PIC 9(2).
  97.            02  ARGUMENT-SCALE          PIC S9(2).
  98.  
  99.        01  C-CARG-SUCCESS              PIC X.
  100.            88  IS-C-CARG-SUCCESS       VALUE "Y".
  101.        
  102.        01 carg usage binary.                                                    
  103.                  04 tipo pic 9(2).                                              
  104.                  04 longitudx pic 9(8) .                                        
  105.                  04 digitos pic 9(2).                                          
  106.                  04 escala pic s9(2).                                          
  107.        01 narg pic 9(3) binary.                                                
  108.        01 es-tipo pic x VALUE 'N'.                                              
  109.           88 es-tipo-ascii value 'y' 'Y'.                                      
  110.           88 es-tipo-num value 'n' 'N'.                                        
  111.        
  112.        linkage section.  
  113.        01 lk-par1 pic x.                                                        
  114.        01 lk-par1xx redefines lk-par1.                                          
  115.            03 lk-par1x pic x occurs 100.                                        
  116.        01 lk-par2 pic x.                                                        
  117.        01 lk-par2xx redefines lk-par2.                                          
  118.            03 lk-par2x pic x occurs 100.                                        
  119.        01 lk-par3 pic x.                                                        
  120.        01 lk-par3xx redefines lk-par3.                                          
  121.            03 lk-par3x pic x occurs 100.                                        
  122.        01 lk-par4 pic x.                                                        
  123.        01 lk-par4xx redefines lk-par4.                                          
  124.            03 lk-par4x pic x occurs 100.                                        
  125.                                                                                
  126. ------*                                                                        
  127.        PROCEDURE DIVISION using                                                
  128.               lk-par1 lk-par2 lk-par3 lk-par4.                                  
  129.                                                                                
  130. ------*                                                                        
  131.        declaratives.                                                            
  132.        errores section.                                                        
  133.            use after standard error procedure on  atr01 atr01j.
  134.        end declaratives.                                                        
  135.        programa section.                                                        
  136.        programa-prin.
  137.            initialize nombre-atr01 nombre-atr01j nombre-atr01jx                        
  138.            call 'c$narg' using narg                                            
  139.            end-call.      
  140.            if narg < 2 then go fin-p.
  141.            
  142.       d     accept narg update                                                      
  143.             call "c$carg" using es-tipo lk-par1 carg                            
  144.             end-call                                                            
  145.       d     accept longitudx update                                                                    
  146.             if longitudx > 80 move 80 to longitudx end-if
  147.             perform varying i from longitudx by -1 until i = 0                  
  148.                move lk-par1x(i) to nombre-atr01(i:1)                  
  149.             end-perform                                                        
  150.             call "c$carg" using es-tipo lk-par2 carg                            
  151.             end-call
  152.                                                                                
  153.             perform varying i from longitudx by -1 until i = 0                  
  154.                move lk-par2x(i) to nombre-atr01jx(i:1)                  
  155.             end-perform.                                                        
  156.        b.  
  157.             string nombre-atr01jx delimited by ' '
  158.                     'x' delimited by size into nombre-atr01j
  159.       d     display nombre-atr01 line 1.
  160.       d     display nombre-atr01j line 2
  161.       d     accept nombre-atr01jx line 3 update.
  162.            open input atr01
  163.            if not esta-atr01 then
  164.                    go fin-p
  165.            end-if.  
  166.            initialize i        
  167.            open output atr01j.
  168.        c.    
  169.            if not esta-atr01j then
  170.               display 'error ' line 1 position 1
  171.               accept fs-atr01j update
  172.               open output atr01j
  173.               close atr01j
  174.               open extend atr01j
  175.            end-if          
  176.            if not esta-atr01j then
  177.                    go fin-p
  178.            end-if.  
  179.  
  180.            initialize reg-atr01j reg-atr01j
  181.            read atr01 next record end-read
  182.            perform until fin-atr01
  183.                move all x"00" to b64-4octets
  184.                move reg-atr01 to  b64-3octets
  185.                call "C$LogicalShiftLeft"  using b64-4octets, 6
  186.                call "C$LogicalShiftRight" using b64-3octets, 2
  187.                call "C$LogicalShiftRight" using b64-2octets, 2
  188.                call "C$LogicalShiftRight" using b64-1octet,  2
  189.                perform varying j from 1 by 1
  190.                          until j > count of b64-octet
  191.                    add b64-octet (j), 1 giving k
  192.                    move Base64-Alphabet (k:1)
  193.                      to b64-octet (j) (1:1)    
  194.                end-perform
  195.                move b64-4octets to reg-atr01j
  196.                write reg-atr01j end-write
  197.                
  198.             initialize reg-atr01 reg-atr01j
  199.             read atr01 next record end-read
  200.            end-perform.
  201.  
  202.        fin-p.    
  203.            close atr01 atr01j.
  204.            initialize mensaje
  205.            string 'cmd /c type ' delimited by size
  206.                   nombre-atr01j delimited by ' '
  207.                   ' >> ' delimited by size
  208.                   nombre-atr01jx delimited by ' '
  209.                   into mensaje.
  210.            call 'ejecuta' using mensaje.
  211.            delete file atr01j.
  212.            
  213.            exit program.
  214.            
JCantero no ha iniciado sesión   Responder Con Cita
Han dicho Gracias: 2
Kuk (28 de diciembre de 2020), Lascu (29 de diciembre de 2020)
  #6
Antiguo 28 de diciembre de 2020, 20:07
IDENTIFICATION DIVISION
Josber
 Super Moderador
Activista del Foro: Activista del Foro - Razón: Por aportar manuales y enriquecer   Agradecimientos: Por muchos agradecimientos de parte de los Foreros - Razón: Por muchos agradecimientos 
ENVIRONMENT DIVISION
Avatar de Josber
DATA DIVISION
febrero 2015
Alicante
19.06.2021 18:30
PROCEDURE DIVISION
Posts: 581
Enviado: 267
Recibido: 286
Soluiones: 38
Reputación: 29
Josber is on a distinguished road Josber is on a distinguished road Josber is on a distinguished road Josber is on a distinguished road Josber is on a distinguished road Josber is on a distinguished road Josber is on a distinguished road Josber is on a distinguished road Josber is on a distinguished road Josber is on a distinguished road Josber is on a distinguished road
Predeterminado

@JCantero,

¿Qué hace la llamada a "C$LogicalShiftLeft"?

Cita del post de JCantero Ver Mensaje
call "C$LogicalShiftLeft" using....
Un salu2.-
Josber no ha iniciado sesión   Responder Con Cita
  #7
Antiguo 28 de diciembre de 2020, 22:01
IDENTIFICATION DIVISION
JCantero
 Novato Senior
ENVIRONMENT DIVISION
Avatar de JCantero
DATA DIVISION
junio 2016
Albacete
55 años
19.06.2021 20:23
PROCEDURE DIVISION
Posts: 181
Enviado: 53
Recibido: 120
Soluiones: 8
Reputación: 18
JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road JCantero is on a distinguished road
Predeterminado

Logica binaria para mover el byte a la derecha o izquierda.

Para enteder el algoritmo hay que entender el proceso de conversion a BASE64 Base64 - Wikipedia, la enciclopedia libre

Lo puedes ver en en manual de usuario apendice F (Digital Transformation and Enterprise Software Modernization | Micro Focus)

Copio algo de contenido.......

C$LogicalShiftLeft
C$LogicalShiftLeft is used to perform a logical shift left operation on a nonnumeric or
numeric operand.
Calling Sequence
Código COBOL:
  1. CALL "C$LogicalShiftLeft"
  2. [GIVING Result]
  3. USING Operand [ShiftCount]
Result, if specified, must be an identifier that references a numeric data item.
Operand may reference a nonnumeric or numeric data item.
ShiftCount, if specified, must be an identifier that references a numeric data item. If
ShiftCount is not specified, a shift count of 1 is assumed.
If Operand refers to a nonnumeric data item, the value of the data item is shifted left by the
number of bit positions specified by ShiftCount. Any bits shifted off the left end are lost and
zero-valued bits are shifted into the right end. The value of Result is set to a nonzero value if
any character of Operand is nonzero after the operation completes and zero otherwise.
If Operand refers to a numeric data item, the operand is converted, if necessary, to a 32-bit
binary integer. The 32-bit binary value is logically shifted left by the number of bit positions
specified by ShiftCount. If the GIVING phrase is specified, the result of this operation is
stored in Result and the value of Operand is not modified. If the GIVING phrase is not
specified, the result of this operation is stored in Operand.
JCantero no ha iniciado sesión   Responder Con Cita
Ha dicho Gracias : 1
Josber (30 de diciembre de 2020)
  #8
Antiguo 29 de diciembre de 2020, 21:28
IDENTIFICATION DIVISION
Lascu
 Novato Junior
ENVIRONMENT DIVISION
Avatar de Lascu
DATA DIVISION
noviembre 2015
Videla, Santa Fe
28.05.2021 01:27
PROCEDURE DIVISION
Posts: 31
Enviado: 49
Recibido: 16
Soluiones: 1
Reputación: 0
Lascu is on a distinguished road Lascu is on a distinguished road
Predeterminado

Amigos, gracias a todos por responder.
Lo más probable es que genere el dll con la solución ofrecida por @fastpho, @Kuk el enlace es verdaderamente sencillo pero no tengo idea de java y @JCantero muy bueno (cuando tenga más tiempo voy a tratar de ver si se puede implementar en PowerCobol).
@Gusaiello, fijate en este enlace https://www.afip.gob.ar/fe/qr/conceptos-generales.asp, el 01/03/21 es la primer fecha de implementación. A partir de allí no se usará mas el código de barras 2 de 5 en las facturas electrónicas, va a ser obligación el uso de QR.
También estoy probando FREE Base64, me pareció sencillo de implementar.

Saludos
Lascu no ha iniciado sesión   Responder Con Cita
Ha dicho Gracias : 1
fastpho (30 de diciembre de 2020)
  #9
Antiguo 30 de diciembre de 2020, 10:08
IDENTIFICATION DIVISION
Gusaiello
 Novato Senior
Concurso: Segundo puesto: Ganador/a del Segundo puesto en un concurso - Razón: Generador de código QR encriptado  Activista del Foro: Activista del Foro - Razón: Por aportar ejecrcicios para los novatos 
ENVIRONMENT DIVISION
Avatar de Gusaiello
DATA DIVISION
febrero 2015
Quilmes, Buenos Aires
66 años
19.06.2021 12:34
PROCEDURE DIVISION
Posts: 141
Enviado: 54
Recibido: 98
Soluiones: 7
Reputación: 16
Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road Gusaiello is on a distinguished road
Predeterminado

@Lascu, gracias por haberlo comentado aqui.
Luego de leer tu post entré a la página de Afip y vi la novedad.

Por suerte encontré una buena explicación en wikipedia sobre la codificación base64.
Es una mecánica bastante simple.

Ayer me puse a implementarlo y ya casi lo tengo resuelto para un string de longitud fija, ahora tengo que pulirlo un poco y adecuarlo para cadenas de longitud variable.
Gusaiello no ha iniciado sesión   Responder Con Cita
  #10
Antiguo 30 de diciembre de 2020, 11:29
IDENTIFICATION DIVISION
Kuk
 Administrador
ENVIRONMENT DIVISION
Avatar de Kuk
DATA DIVISION
diciembre 2014
Madrid
36 años
19.06.2021 11:02
PROCEDURE DIVISION
Posts: 1.755
Enviado: 552
Recibido: 722
Soluiones: 94
Reputación: 10
Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road Kuk is on a distinguished road
Predeterminado

@Gusaiello, pues lo mismo te sirve para el concurso: [Sugerencia] Fazer um concurso - COBOL Foro



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 no ha iniciado sesión   Responder Con Cita
Respuesta


Usuarios activos actualmente viendo este tema: 1 (0 miembros y 1 visitantes)
 
Herramientas

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



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