String para Decimal

[Joseg]

Necessito de achar um valor único de uma string, para criar uma chave, já que chaves primarias ou alternadas tem um limite máximo de 255 bytes.

Calcular o valor ASCII do mesmo poderia ser uma possibilidade...

Esta função:

FUNCTION ORD (argument-1)


é uma possiblidade mas necessito de percorrer uma string grande, tipo:

01 wmyvar pic x(3000).

fica lento.
Conhecem alguma alternativa?

Gracias,

[Kuk]

fica lento.
¿Cómo lo haces? Prueba algo así:


01 wmyvar pic x(3000).
01 filler redefines wmyvar.
05 byte occurs 3000 pic 9(2) comp-5.

01 idx-1 pic 9(4) comp-5.
01 suma pic 9(9) comp-5.
procedure division.

move 1 to idx-1
move 0 to suma

perform until idx-1 > length of wmyvar
add byte(idx-1) to suma

add 1 to idx-1
end-perform



También mira esto a ver si dura menos, el cálculo será diferente pero puede servir igual creo:


01 wmyvar pic x(3000).
01 filler redefines wmyvar.
05 byte occurs 1500 pic 9(4) comp-5.

01 idx-1 pic 9(4) comp-5.
01 suma pic 9(9) comp-5.
procedure division.

move 1 to idx-1
move 0 to suma

perform until idx-1 > 1500
add byte(idx-1) to suma

add 1 to idx-1
end-perform




01 wmyvar pic x(3000).
01 filler redefines wmyvar.
05 byte occurs 750 pic 9(9) comp-5.

01 idx-1 pic 9(4) comp-5.
01 suma pic 9(18) comp-5.
procedure division.

move 1 to idx-1
move 0 to suma

perform until idx-1 > 750
add byte(idx-1) to suma

add 1 to idx-1
end-perform

[Joseg]

Ainda não tenho a solução para o problema.

Pretendia que a string:
"101.10.01"
fosse SEMPRE diferente de:
"101.10.10"

...e tenho casos em que o cálculo dá o mesmo valor.

Gracias por qualquer ajuda.


¿Cómo lo haces? Prueba algo así:


01 wmyvar pic x(3000).
01 filler redefines wmyvar.
05 byte occurs 3000 pic 9(2) comp-5.

01 idx-1 pic 9(4) comp-5.
01 suma pic 9(9) comp-5.
procedure division.

move 1 to idx-1
move 0 to suma

perform until idx-1 > length of wmyvar
add byte(idx-1) to suma

add 1 to idx-1
end-perform



También mira esto a ver si dura menos, el cálculo será diferente pero puede servir igual creo:


01 wmyvar pic x(3000).
01 filler redefines wmyvar.
05 byte occurs 1500 pic 9(4) comp-5.

01 idx-1 pic 9(4) comp-5.
01 suma pic 9(9) comp-5.
procedure division.

move 1 to idx-1
move 0 to suma

perform until idx-1 > 1500
add byte(idx-1) to suma

add 1 to idx-1
end-perform




01 wmyvar pic x(3000).
01 filler redefines wmyvar.
05 byte occurs 750 pic 9(9) comp-5.

01 idx-1 pic 9(4) comp-5.
01 suma pic 9(18) comp-5.
procedure division.

move 1 to idx-1
move 0 to suma

perform until idx-1 > 750
add byte(idx-1) to suma

add 1 to idx-1
end-perform

[Kuk]

@Joseg, prueba con la última versión, la de byte occurs 750 pic 9(9) comp-5. porque ahí toma 4 bytes con lo cual también tiene en cuenta el orden.

A mi me funciona, mira el ejemplo que has dado da diferente resultado con el método que digo:

PIC X(12) VALUE "101.10.01" --> 00000000002122285203
PIC X(12) VALUE "101.10.10" --> 00000000002139062418

[Joseg]

@Joseg, prueba con la última versión, la de byte occurs 750 pic 9(9) comp-5. porque ahí toma 4 bytes con lo cual también tiene en cuenta el orden.

A mi me funciona, mira el ejemplo que has dado da diferente resultado con el método que digo:

PIC X(12) VALUE "101.10.01" --> 00000000002122285203
PIC X(12) VALUE "101.10.10" --> 00000000002139062418


Com um exemplo fica mais fácil testar !

[Joseg]

Com um exemplo fica mais fácil testar !

A ordem como os códigos (121-05-10;...) são colocados na string , pode ser um diferenciador.

[Kuk]

@Joseg,

MainForm -> EDIT PROCEDURE DIVISION -> NEW, renombra en PRC-CALC

Edita y pega esto:


ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 idx-1 pic 9(4) comp-5.
01 wsomamodelos pic 9(18) comp-5.

LINKAGE SECTION.
01 LNK-DATOS.
05 LNK-INPUT PIC X(3000).
05 filler redefines LNK-INPUT.
10 byte occurs 750 pic 9(8) comp-5.
05 LNK-OUTPUT PIC 9(18).

PROCEDURE DIVISION USING LNK-DATOS.

move 1 to idx-1
move function current-date(5:12) to LNK-OUTPUT

perform until idx-1 > 750
add byte(idx-1) to wsomamodelos

add 1 to idx-1
end-perform

add wsomamodelos to LNK-OUTPUT

display LNK-OUTPUT


Código del botón Nº1:

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 LNK-DATOS.
05 LNK-INPUT PIC X(3000).
05 LNK-OUTPUT PIC 9(18).

PROCEDURE DIVISION.

MOVE "Text" OF CmText1 TO LNK-INPUT

perform 5 times *> PARA TEST RAPIDO
CALL "PRC-CALC" USING LNK-DATOS
end-perform

MOVE LNK-OUTPUT TO "Text" OF CmText3


Código del botón Nº2:

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.

01 LNK-DATOS.
05 LNK-INPUT PIC X(3000).
05 LNK-OUTPUT PIC 9(18).

PROCEDURE DIVISION.

MOVE "Text" OF CmText2 TO LNK-INPUT

CALL "PRC-CALC" USING LNK-DATOS

MOVE LNK-OUTPUT TO "Text" OF CmText4

[Joseg]

@Joseg,

MainForm -> EDIT PROCEDURE DIVISION -> NEW, renombra en PRC-CALC

Edita y pega esto:


ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 idx-1 pic 9(4) comp-5.
01 wsomamodelos pic 9(18) comp-5.

LINKAGE SECTION.
01 LNK-DATOS.
05 LNK-INPUT PIC X(3000).
05 filler redefines LNK-INPUT.
10 byte occurs 750 pic 9(8) comp-5.
05 LNK-OUTPUT PIC 9(18).

PROCEDURE DIVISION USING LNK-DATOS.

move 1 to idx-1
move function current-date(5:12) to LNK-OUTPUT

perform until idx-1 > 750
add byte(idx-1) to wsomamodelos

add 1 to idx-1
end-perform

add wsomamodelos to LNK-OUTPUT

display LNK-OUTPUT


Código del botón Nº1:

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 LNK-DATOS.
05 LNK-INPUT PIC X(3000).
05 LNK-OUTPUT PIC 9(18).

PROCEDURE DIVISION.

MOVE "Text" OF CmText1 TO LNK-INPUT

perform 5 times *> PARA TEST RAPIDO
CALL "PRC-CALC" USING LNK-DATOS
end-perform

MOVE LNK-OUTPUT TO "Text" OF CmText3


Código del botón Nº2:

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.

01 LNK-DATOS.
05 LNK-INPUT PIC X(3000).
05 LNK-OUTPUT PIC 9(18).

PROCEDURE DIVISION.

MOVE "Text" OF CmText2 TO LNK-INPUT

CALL "PRC-CALC" USING LNK-DATOS

MOVE LNK-OUTPUT TO "Text" OF CmText4


Gracias pela ajuda !!!

Entendo a ideia. Mas não posso usar.
Eu quero mais tarde validar o registo voltando a calcular o valor original tendo por base esta string "121-03-10;121-17-00;121-03-10;121-17-00;121-05-01;", para ver se o registo já existe.

Se a "primary key" não tivesse o limite de apenas 255 bytes (ficheiros ISAM), não tinha este problema. Simplesmente definia como chave única:

01 wmodelosori PIC X(3000).

e tinha o problema resolvido.
Mas como a String pode conter até 3000 bytes tenho que procurar outra solução.

[Kuk]

@Joseg, creo que lo he arreglado:


ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 idx-1 pic 9(4) comp-5.
01 wsomamodelos pic 9(18) comp-5.

LINKAGE SECTION.
01 LNK-DATOS.
05 LNK-INPUT PIC X(3000).
05 filler redefines LNK-INPUT.
10 byte occurs 750 pic 9(8) comp-5.
05 LNK-OUTPUT PIC 9(18).

PROCEDURE DIVISION USING LNK-DATOS.

move 1 to idx-1
move 0 to LNK-OUTPUT, wsomamodelos


perform until idx-1 > 750
COMPUTE wsomamodelos = wsomamodelos + byte(idx-1) * idx-1

add 1 to idx-1
end-perform

MOVE wsomamodelos to LNK-OUTPUT

display LNK-OUTPUT


Es que estábamos tontos macho, con la SUMA no vale, y lo sabemos desde el cole :D


Propiedad conmutativa de la suma: cambiar el orden de los sumandos no altera la suma

[Joseg]

@Joseg, creo que lo he arreglado:


ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 idx-1 pic 9(4) comp-5.
01 wsomamodelos pic 9(18) comp-5.

LINKAGE SECTION.
01 LNK-DATOS.
05 LNK-INPUT PIC X(3000).
05 filler redefines LNK-INPUT.
10 byte occurs 750 pic 9(8) comp-5.
05 LNK-OUTPUT PIC 9(18).

PROCEDURE DIVISION USING LNK-DATOS.

move 1 to idx-1
move 0 to LNK-OUTPUT, wsomamodelos


perform until idx-1 > 750
COMPUTE wsomamodelos = wsomamodelos + byte(idx-1) * idx-1

add 1 to idx-1
end-perform

MOVE wsomamodelos to LNK-OUTPUT

display LNK-OUTPUT


Es que estábamos tontos macho, con la SUMA no vale, y lo sabemos desde el cole :D


"Es que estábamos tontos macho, con la SUMA no vale, y lo sabemos desde el cole" :bat: :bat:

Agora si !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!

Muitas muitas gracias Kuk

[Joseg]

"Es que estábamos tontos macho, con la SUMA no vale, y lo sabemos desde el cole" :bat: :bat:

Agora si !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!

Muitas muitas gracias Kuk

Tengo un problema con este cálculo, y ahora es grave, porque ya hay muchos registros creados.

La suma de la cadena "207.99.99;" es igual a "247.97.99;".

Mi resultado: "000151790274229935".

Mi objetivo es que sea diferente. ¿Hay alguna alternativa?

Gracias,
José

[Kuk]

@Joseg, nunca he sido un crack de las formulas y algoritmos la verdad, pero me acabo de dar cuenta de otra cosa que sabemos desde el cole y se nos ha escapado...

El cálculo lo hacemos así:


COMPUTE wsomamodelos = wsomamodelos + byte(idx-1) * idx-1


De esta manera, primero se hace la multiplicación.

Si lo hacemos así, con paréntesis, para que primero se haga la suma:

COMPUTE wsomamodelos = (wsomamodelos + byte(idx-1)) * idx-1


Entonces a mi me da 2 valores diferentes:

207.99.99; --> 759816616914665856
247.97.99; --> 257135248213769984

[Joseg]

@Joseg, nunca he sido un crack de las formulas y algoritmos la verdad, pero me acabo de dar cuenta de otra cosa que sabemos desde el cole y se nos ha escapado...

El cálculo lo hacemos así:


COMPUTE wsomamodelos = wsomamodelos + byte(idx-1) * idx-1


De esta manera, primero se hace la multiplicación.

Si lo hacemos así, con paréntesis, para que primero se haga la suma:

COMPUTE wsomamodelos = (wsomamodelos + byte(idx-1)) * idx-1


Entonces a mi me da 2 valores diferentes:

207.99.99; --> 759816616914665856
247.97.99; --> 257135248213769984


Ahhhhhhh, ok, ok,

Muchas gracias, Kuk. Cambiaré la fórmula. Sin embargo, chatGTP sugirió este ejemplo, lo que garantiza que siempre funciona, independientemente del orden de los dígitos/caracteres.


DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-TEXTO PIC X(50)
VALUE "207.99.99;247.97.99;".
01 WS-CODE PIC 9(9) VALUE 0.
01 WS-ASCII PIC 9(3).
01 I PIC 9(3).

PROCEDURE DIVISION.
MOVE 0 TO WS-CODE

PERFORM VARYING I FROM 1 BY 1
UNTIL I > FUNCTION LENGTH(WS-TEXTO)
COMPUTE WS-ASCII = FUNCTION ORD(WS-TEXTO(I:1))
COMPUTE WS-CODE = (WS-CODE * 31) + WS-ASCII
COMPUTE WS-CODE = FUNCTION MOD(WS-CODE, 999999999)
END-PERFORM

DISPLAY "CODIGO = " WS-CODE

[Kuk]

chatGTP sugirió
Yo no me fiaría en este tipo de cosas ;)

[Joseg]

Yo no me fiaría en este tipo de cosas ;)

Hola Kuk, esto no es fácil.

El cliente detectó otro error. Los códigos:
105.02.11 y 115.01.11
dan el mismo valor: 298955437302929664.
Creo que hay que tener en cuenta la posición en la que se introducen los dígitos. ¿Puedes ayudarme?

Gracias
Jose

[Kuk]

@Joseg, para no reinventar la rueda, vamos a optar por soluciones estándar, como es el caso de OpenSSL: https://es.dll-files.com/libcrypto.dll.html

Con esta solución generamos un HASH, en el caso concreto, el SHA256:

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 strInput PIC X(3000).

01 LK-HASH-RAW PIC X(32).

01 hLib PIC S9(9) COMP-5.
01 ptrSHA256 PROCEDURE-POINTER.
01 ptrINPUT POINTER.
01 nPtrINPUT REDEFINES ptrINPUT PIC S9(9) COMP-5.

01 strLen PIC S9(9) COMP-5.


*-----------------------------------
01 LNK-LEN PIC 9(4) COMP.
01 LNK-INPUT.
05 FILLER PIC X OCCURS 1 TO 1000 DEPENDING ON LNK-LEN.

01 LNK-OUTPUT.
05 LNK-HEX1.
10 LNK-H1 PIC X OCCURS 1 TO 1000 DEPENDING ON LNK-LEN.
05 LNK-HEX2.
10 LNK-H2 PIC X OCCURS 1 TO 1000 DEPENDING ON LNK-LEN.

PROCEDURE DIVISION.

MOVE POW-TEXT OF CmText1 TO strInput

CALL "LoadLibraryA" WITH STDCALL USING BY CONTENT "libcrypto.dll" RETURNING hLib

CALL "GetProcAddress" WITH STDCALL USING BY VALUE hLib, BY CONTENT "SHA256" & X"00" RETURNING ptrSHA256

MOVE FUNCTION ADDR(strInput) TO ptrINPUT

COMPUTE strLen = FUNCTION STORED-CHAR-LENGTH(strInput)

CALL ptrSHA256 WITH STDCALL USING
BY VALUE nPtrINPUT
BY VALUE strLen
BY REFERENCE LK-HASH-RAW

COMPUTE LNK-LEN = FUNCTION STORED-CHAR-LENGTH(LK-HASH-RAW)
MOVE LK-HASH-RAW TO LNK-INPUT

CALL "HEX" USING LNK-LEN, LNK-INPUT, LNK-OUTPUT

MOVE LNK-OUTPUT TO POW-TEXT OF CmText3


Tienes que crear una nueva PROCEDURE y llamarla HEX, su contenido es el siguiente:

ENVIRONMENT DIVISION.
DATA DIVISION.

WORKING-STORAGE SECTION.
01 IDX-1 PIC S9(4) COMP-5.
01 IDX-S PIC S9(4) COMP-5.

01 TBL-HEX PIC X(16) VALUE "0123456789ABCDEF".

01 WS-HEX-1 PIC S9(4) COMP-5.
01 WS-HEX-2 PIC S9(4) COMP-5.

01 WS-BIN PIC X.
01 WS-BIN-2 REDEFINES WS-BIN PIC 9(2) COMP-5.

************************************************** ****************
* LINKAGE SECTION *
************************************************** ****************
LINKAGE SECTION.
01 LNK-LEN PIC 9(4) COMP.
01 LNK-INPUT.
05 FILLER PIC X OCCURS 1 TO 1000 DEPENDING ON LNK-LEN.

01 LNK-OUTPUT PIC X(2000).

************************************************** ****************
* PROCEDURE DIVISION
************************************************** ****************
PROCEDURE DIVISION USING LNK-LEN, LNK-INPUT, LNK-OUTPUT.

MOVE 1 TO IDX-1, IDX-S

PERFORM UNTIL IDX-1 > LNK-LEN
MOVE LNK-INPUT(IDX-1:1) TO WS-BIN

DIVIDE WS-BIN-2 BY 16
GIVING WS-HEX-1 REMAINDER WS-HEX-2

ADD 1 TO WS-HEX-1, WS-HEX-2

MOVE TBL-HEX(WS-HEX-1:1) TO LNK-OUTPUT(IDX-S:1)
ADD 1 TO IDX-S
MOVE TBL-HEX(WS-HEX-2:1) TO LNK-OUTPUT(IDX-S:1)

ADD 1 TO IDX-1, IDX-S
END-PERFORM

GOBACK
.


No olvides lo de ALPHAL(WORD) e incluir la KERNEL32.LIB.

Resultados:
Valor|sha256
105.02.11|45A5AC763720497A3054E1A5C1C24DB458CE0C30 79F9AD2AB9496EAF9EAC087B
115.01.11|2B83108827E847A74B0886AB2E532E3F79988131 A61546499C3B08F32E4DB9F5
207.99.99|8189CCD84246547FD968902606574828E03D332D 2A9D65D9FCA11868303CA8B9
247.97.99|D9DCC2614B2499CCEEF96484C65855258D7CD2AF 8DEA2E5079C7F13860D9C323


¡¡¡Esto ya NO PUEDE fallar!!! :D

[Joseg]

Kuk,
Muchas gracias por tu trabajo. Creo que esta es una solución más sólida que podría interesar al resto de la comunidad.

Ya la he probado y parece funcionar bien.


@Joseg, para no reinventar la rueda, vamos a optar por soluciones estándar, como es el caso de OpenSSL: https://es.dll-files.com/libcrypto.dll.html