[Componente] OCX que codifique/decodifique en base64

[Lascu]

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]

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

[Gusaiello]

Cita del post de Lascu

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]

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

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

       identification division.
       program-id.  sibase64.
      *
      * CALL "sibase64" USING fichero fichero-dest
      *   
      * llamado desde windows por sivisors, en linux existe comando
      *         ( jcantero )
       environment division.                                                    
       configuration section.                                                   
       source-computer.  rmcobol-85.                                            
       object-computer.  rmcobol-85.                                            
       special-names.                                                           
           decimal-point is comma.                                              
      *                                                                         
       input-output section.                                                    
       file-control.                                                            
      *                                                                         
           select atr01 assign to random, nombre-atr01                          
                  organization sequential                                  
                  access mode is sequential                                     
                  file status is fs-atr01.                                      
           
           select atr01j assign to random, nombre-atr01j                          
                  organization sequential                                  
                  access mode is sequential                                     
                  file status is fs-atr01j.                                      
           
           
                                                                                
       
       data division.
       file section.                                                            
      *                                                                         
       fd  atr01.
       01  reg-atr01.
           02 atr-cabecera pic x(3).
           
       fd  atr01j.
       01  reg-atr01j.
           02 atr-cabeceraj pic x(4).
       working-storage section.
       01 nombre-atr01    pic x(80).                                            
       01 nombre-atr01j    pic x(80).                                            
       01 nombre-atr01jx    pic x(80).                                            
       01 mensaje pic x(200).
       
       01 fs-atr01         pic xx.                                              
              88 esta-atr01         value '00' '02'.                            
              88 n-esta-atr01       value '23'.                                 
              88 fin-atr01          value '46'  '10'.                           
              88 bloqueado-atr01    value '99'.                                 
              88 f-bloqueado-atr01  value '38' '93'.                            
              88 f-noexiste-atr01   value '35'.                                 
       
       01 fs-atr01j         pic xx.                                              
              88 esta-atr01j         value '00' '02'.                            
              88 n-esta-atr01j       value '23'.                                 
              88 fin-atr01j          value '46'  '10'.                           
              88 bloqueado-atr01j    value '99'.                                 
              88 f-bloqueado-atr01j  value '38' '93'.                            
              88 f-noexiste-atr01j   value '35'.                                 
       
 
       01  binary(2).
           02  i                       pic 9(4).
           02  j                       pic 9(4).
           02  k                       pic 9(4).
 
       01  message-length              pic 9(6) binary.
       01  base64-message-length       pic 9(6) binary.
       01  triplet-count               pic 9(6) binary.
       01  trailing-count              pic 9(6) binary.
 
 
 
       01  Base64-Alphabet             pic x(64) value
                   "ABCDEFGHIJKLMNOPQRSTUVWXYZ" &
                   "abcdefghijklmnopqrstuvwxyz" &
                   "0123456789" &
                   "+/".
 
       01  b64-triplet.
           05  b64-4octets.
               07                      pic x.
               07  b64-3octets.
                   09                  pic x.
                   09  b64-2octets.
                       11              pic x.
                       11  b64-1octet  pic x.
       01  redefines b64-triplet.
           05  b64-octet           pic 999 binary(1) occurs 4.
 
       01  ARGUMENT-DESCRIPTION        BINARY(2).
           02  ARGUMENT-TYPE           PIC 9(2).
           02  ARGUMENT-LENGTH         PIC 9(8) BINARY(4).
           02  ARGUMENT-DIGIT-COUNT    PIC 9(2).
           02  ARGUMENT-SCALE          PIC S9(2).
 
       01  C-CARG-SUCCESS              PIC X.
           88  IS-C-CARG-SUCCESS       VALUE "Y".
       
       01 carg usage binary.                                                    
                 04 tipo pic 9(2).                                              
                 04 longitudx pic 9(8) .                                         
                 04 digitos pic 9(2).                                           
                 04 escala pic s9(2).                                           
       01 narg pic 9(3) binary.                                                 
       01 es-tipo pic x VALUE 'N'.                                              
          88 es-tipo-ascii value 'y' 'Y'.                                       
          88 es-tipo-num value 'n' 'N'.                                         
       
       linkage section.   
       01 lk-par1 pic x.                                                        
       01 lk-par1xx redefines lk-par1.                                          
           03 lk-par1x pic x occurs 100.                                        
       01 lk-par2 pic x.                                                        
       01 lk-par2xx redefines lk-par2.                                          
           03 lk-par2x pic x occurs 100.                                        
       01 lk-par3 pic x.                                                        
       01 lk-par3xx redefines lk-par3.                                          
           03 lk-par3x pic x occurs 100.                                        
       01 lk-par4 pic x.                                                        
       01 lk-par4xx redefines lk-par4.                                          
           03 lk-par4x pic x occurs 100.                                        
                                                                                
------*                                                                         
       PROCEDURE DIVISION using                                                 
              lk-par1 lk-par2 lk-par3 lk-par4.                                  
                                                                                
------*                                                                         
       declaratives.                                                            
       errores section.                                                         
           use after standard error procedure on  atr01 atr01j.
       end declaratives.                                                        
       programa section.                                                        
       programa-prin.
           initialize nombre-atr01 nombre-atr01j nombre-atr01jx                        
           call 'c$narg' using narg                                             
           end-call.      
           if narg < 2 then go fin-p.
           
      d     accept narg update                                                      
            call "c$carg" using es-tipo lk-par1 carg                             
            end-call                                                            
      d     accept longitudx update                                                                     
            if longitudx > 80 move 80 to longitudx end-if
            perform varying i from longitudx by -1 until i = 0                   
               move lk-par1x(i) to nombre-atr01(i:1)                   
            end-perform                                                         
            call "c$carg" using es-tipo lk-par2 carg                             
            end-call
                                                                                
            perform varying i from longitudx by -1 until i = 0                   
               move lk-par2x(i) to nombre-atr01jx(i:1)                   
            end-perform.                                                         
       b.  
            string nombre-atr01jx delimited by ' '
                    'x' delimited by size into nombre-atr01j
      d     display nombre-atr01 line 1.
      d     display nombre-atr01j line 2
      d     accept nombre-atr01jx line 3 update.
           open input atr01
           if not esta-atr01 then
                   go fin-p
           end-if.  
           initialize i         
           open output atr01j.
       c.    
           if not esta-atr01j then
              display 'error ' line 1 position 1
              accept fs-atr01j update
              open output atr01j
              close atr01j
              open extend atr01j
           end-if           
           if not esta-atr01j then
                   go fin-p
           end-if.  
 
           initialize reg-atr01j reg-atr01j
           read atr01 next record end-read
           perform until fin-atr01
               move all x"00" to b64-4octets
               move reg-atr01 to  b64-3octets
               call "C$LogicalShiftLeft"  using b64-4octets, 6
               call "C$LogicalShiftRight" using b64-3octets, 2
               call "C$LogicalShiftRight" using b64-2octets, 2
               call "C$LogicalShiftRight" using b64-1octet,  2
               perform varying j from 1 by 1
                         until j > count of b64-octet
                   add b64-octet (j), 1 giving k
                   move Base64-Alphabet (k:1) 
                     to b64-octet (j) (1:1)     
               end-perform
               move b64-4octets to reg-atr01j
               write reg-atr01j end-write
               
            initialize reg-atr01 reg-atr01j
            read atr01 next record end-read
           end-perform.
 
       fin-p.    
           close atr01 atr01j.
           initialize mensaje
           string 'cmd /c type ' delimited by size
                  nombre-atr01j delimited by ' '
                  ' >> ' delimited by size
                  nombre-atr01jx delimited by ' '
                  into mensaje.
           call 'ejecuta' using mensaje.
           delete file atr01j.
           
           exit program.
            

[Josber]

@JCantero,

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

Cita del post de JCantero

call "C$LogicalShiftLeft" using....

Un salu2.-

[JCantero]

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 CALL "C$LogicalShiftLeft" [GIVING Result] 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]

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]

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

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