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 (https://www.cobolforo.es/showthread.php?t=657) ?

[Gusaiello]

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.php?524561-VB6-how-to-get-media-from-code-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"?

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 (https://es.wikipedia.org/wiki/Base64)

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

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 (https://www.cobolforo.es/showthread.php?t=1240)

[Gusaiello]

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

@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 ;)