COBOL Foro

COBOL Foro (https://www.cobolforo.es/index.php)
-   PowerCOBOL (ActiveX, v4 - v11) (https://www.cobolforo.es/forumdisplay.php?f=9)
-   -   [Componente] OCX que codifique/decodifique en base64 (https://www.cobolforo.es/showthread.php?t=1248)

Lascu 27 de diciembre de 2020 19:58

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

Kuk 27 de diciembre de 2020 23:21

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

Gusaiello 28 de diciembre de 2020 13:58

Cita:

Cita del post de Lascu (Mensaje 6358)
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.

fastpho 28 de diciembre de 2020 14:59

@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

JCantero 28 de diciembre de 2020 19:15

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.            

Josber 28 de diciembre de 2020 20:07

@JCantero,

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

Cita:

Cita del post de JCantero (Mensaje 6365)
call "C$LogicalShiftLeft" using....

Un salu2.-

JCantero 28 de diciembre de 2020 22:01

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.......

Cita:

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.

Lascu 29 de diciembre de 2020 21:28

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

Gusaiello 30 de diciembre de 2020 10:08

@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.

Kuk 30 de diciembre de 2020 11:29

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

Gusaiello 30 de diciembre de 2020 17:43

@Kuk, te parece?, es algo muy básico, pero lo voy a intentar.

Ahora entonces que ya lo tengo resuelto para una cadena de long. variable, le puedo agregar que dicha cadena se pueda ingresar por teclado, como para hacerlo interactivo y que se pueda generar un código QR codificado en base64 y mostrar el resultado en la pantalla.

Kuk 30 de diciembre de 2020 21:44

@Gusaiello, todo dependerá de cuántos participantes habrá, cuántas y qué cosas se harán etc. Así que, no sé, no pierdes nada intentándolo ;)


La franja horaria es GMT +1. Ahora son las 03:31.

Powered by: vBulletin, Versión 3.8.7
Derechos de Autor ©2000 - 2021, Jelsoft Enterprises Ltd.