Cobol Foro

Cobol Foro (https://www.cobolforo.es/index.php)
-   PowerCOBOL (ActiveX, v4 - v11) (https://www.cobolforo.es/forumdisplay.php?f=9)
-   -   [Compilador] String para Decimal (https://www.cobolforo.es/showthread.php?t=1486)

Joseg 5 de mayo de 2022 12:05

String para Decimal
 
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:
Código COBOL:
  1.      FUNCTION ORD (argument-1)

é uma possiblidade mas necessito de percorrer uma string grande, tipo:
Código COBOL:
  1.      01 wmyvar pic x(3000).
fica lento.
Conhecem alguma alternativa?

Gracias,

Kuk 5 de mayo de 2022 15:42

Cita:

Citación del post de Joseg (Mensaje 7770)
fica lento.

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

Código COBOL:
  1.      01 wmyvar pic x(3000).
  2.      01 filler redefines wmyvar.
  3.         05  byte occurs 3000  pic 9(2) comp-5.
  4.      
  5.      01 idx-1      pic 9(4) comp-5.
  6.      01 suma       pic 9(9) comp-5.
  7.      procedure division.
  8.        
  9.         move 1 to idx-1
  10.         move 0 to suma
  11.        
  12.         perform until idx-1 > length of wmyvar
  13.             add byte(idx-1) to suma
  14.  
  15.             add 1 to idx-1
  16.         end-perform
  17.        

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

Código COBOL:
  1.      01 wmyvar pic x(3000).
  2.      01 filler redefines wmyvar.
  3.         05  byte occurs 1500  pic 9(4) comp-5.
  4.      
  5.      01 idx-1      pic 9(4) comp-5.
  6.      01 suma       pic 9(9) comp-5.
  7.      procedure division.
  8.        
  9.         move 1 to idx-1
  10.         move 0 to suma
  11.        
  12.         perform until idx-1 > 1500
  13.             add byte(idx-1) to suma
  14.  
  15.             add 1 to idx-1
  16.         end-perform
  17.        

Código COBOL:
  1.      01 wmyvar pic x(3000).
  2.      01 filler redefines wmyvar.
  3.         05  byte occurs 750  pic 9(9) comp-5.
  4.      
  5.      01 idx-1      pic 9(4) comp-5.
  6.      01 suma       pic 9(18) comp-5.
  7.      procedure division.
  8.        
  9.         move 1 to idx-1
  10.         move 0 to suma
  11.        
  12.         perform until idx-1 > 750
  13.             add byte(idx-1) to suma
  14.  
  15.             add 1 to idx-1
  16.         end-perform
  17.        

Joseg 10 de mayo de 2022 13:50

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.


Cita:

Citación del post de Kuk (Mensaje 7771)
¿Cómo lo haces? Prueba algo así:

Código COBOL:
  1.      01 wmyvar pic x(3000).
  2.      01 filler redefines wmyvar.
  3.         05  byte occurs 3000  pic 9(2) comp-5.
  4.      
  5.      01 idx-1      pic 9(4) comp-5.
  6.      01 suma       pic 9(9) comp-5.
  7.      procedure division.
  8.        
  9.         move 1 to idx-1
  10.         move 0 to suma
  11.        
  12.         perform until idx-1 > length of wmyvar
  13.             add byte(idx-1) to suma
  14.  
  15.             add 1 to idx-1
  16.         end-perform
  17.        

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

Código COBOL:
  1.      01 wmyvar pic x(3000).
  2.      01 filler redefines wmyvar.
  3.         05  byte occurs 1500  pic 9(4) comp-5.
  4.      
  5.      01 idx-1      pic 9(4) comp-5.
  6.      01 suma       pic 9(9) comp-5.
  7.      procedure division.
  8.        
  9.         move 1 to idx-1
  10.         move 0 to suma
  11.        
  12.         perform until idx-1 > 1500
  13.             add byte(idx-1) to suma
  14.  
  15.             add 1 to idx-1
  16.         end-perform
  17.        

Código COBOL:
  1.      01 wmyvar pic x(3000).
  2.      01 filler redefines wmyvar.
  3.         05  byte occurs 750  pic 9(9) comp-5.
  4.      
  5.      01 idx-1      pic 9(4) comp-5.
  6.      01 suma       pic 9(18) comp-5.
  7.      procedure division.
  8.        
  9.         move 1 to idx-1
  10.         move 0 to suma
  11.        
  12.         perform until idx-1 > 750
  13.             add byte(idx-1) to suma
  14.  
  15.             add 1 to idx-1
  16.         end-perform
  17.        


Kuk 10 de mayo de 2022 15:36

@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:
Código:

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


Joseg 10 de mayo de 2022 16:34

1 Archivos Adjunto(s)
Cita:

Citación del post de Kuk (Mensaje 7796)
@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:
Có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 10 de mayo de 2022 16:51

Cita:

Citación del post de Joseg (Mensaje 7801)
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 10 de mayo de 2022 17:44

@Joseg,

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

Edita y pega esto:

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01 idx-1        pic 9(4) comp-5.
  5.  01 wsomamodelos pic 9(18) comp-5.
  6.  
  7.  LINKAGE SECTION.
  8.  01  LNK-DATOS.
  9.      05  LNK-INPUT    PIC X(3000).
  10.      05  filler redefines LNK-INPUT.
  11.          10  byte occurs 750 pic 9(8) comp-5.
  12.      05  LNK-OUTPUT   PIC 9(18).
  13.      
  14.  PROCEDURE       DIVISION USING LNK-DATOS.
  15.      
  16.      move 1 to idx-1
  17.      move function current-date(5:12) to LNK-OUTPUT
  18.      
  19.      perform until idx-1 > 750
  20.          add byte(idx-1) to wsomamodelos
  21.  
  22.          add 1 to idx-1
  23.      end-perform
  24.      
  25.      add wsomamodelos to LNK-OUTPUT
  26.      
  27.      display LNK-OUTPUT

Código del botón Nº1:
Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01  LNK-DATOS.
  5.      05  LNK-INPUT    PIC X(3000).    
  6.      05  LNK-OUTPUT   PIC 9(18).
  7.  
  8.  PROCEDURE       DIVISION.
  9.  
  10.       MOVE "Text" OF CmText1 TO LNK-INPUT
  11.  
  12.       perform 5 times *> PARA TEST RAPIDO
  13.           CALL "PRC-CALC" USING LNK-DATOS
  14.       end-perform
  15.      
  16.       MOVE LNK-OUTPUT TO "Text" OF CmText3  

Código del botón Nº2:
Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  
  5.  01  LNK-DATOS.
  6.      05  LNK-INPUT    PIC X(3000).    
  7.      05  LNK-OUTPUT   PIC 9(18).
  8.  
  9.  PROCEDURE       DIVISION.
  10.  
  11.       MOVE "Text" OF CmText2 TO LNK-INPUT
  12.  
  13.       CALL "PRC-CALC" USING LNK-DATOS
  14.      
  15.       MOVE LNK-OUTPUT TO "Text" OF CmText4  

Joseg 10 de mayo de 2022 17:58

Cita:

Citación del post de Kuk (Mensaje 7805)
@Joseg,

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

Edita y pega esto:

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01 idx-1        pic 9(4) comp-5.
  5.  01 wsomamodelos pic 9(18) comp-5.
  6.  
  7.  LINKAGE SECTION.
  8.  01  LNK-DATOS.
  9.      05  LNK-INPUT    PIC X(3000).
  10.      05  filler redefines LNK-INPUT.
  11.          10  byte occurs 750 pic 9(8) comp-5.
  12.      05  LNK-OUTPUT   PIC 9(18).
  13.      
  14.  PROCEDURE       DIVISION USING LNK-DATOS.
  15.      
  16.      move 1 to idx-1
  17.      move function current-date(5:12) to LNK-OUTPUT
  18.      
  19.      perform until idx-1 > 750
  20.          add byte(idx-1) to wsomamodelos
  21.  
  22.          add 1 to idx-1
  23.      end-perform
  24.      
  25.      add wsomamodelos to LNK-OUTPUT
  26.      
  27.      display LNK-OUTPUT

Código del botón Nº1:
Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01  LNK-DATOS.
  5.      05  LNK-INPUT    PIC X(3000).    
  6.      05  LNK-OUTPUT   PIC 9(18).
  7.  
  8.  PROCEDURE       DIVISION.
  9.  
  10.       MOVE "Text" OF CmText1 TO LNK-INPUT
  11.  
  12.       perform 5 times *> PARA TEST RAPIDO
  13.           CALL "PRC-CALC" USING LNK-DATOS
  14.       end-perform
  15.      
  16.       MOVE LNK-OUTPUT TO "Text" OF CmText3  

Código del botón Nº2:
Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  
  5.  01  LNK-DATOS.
  6.      05  LNK-INPUT    PIC X(3000).    
  7.      05  LNK-OUTPUT   PIC 9(18).
  8.  
  9.  PROCEDURE       DIVISION.
  10.  
  11.       MOVE "Text" OF CmText2 TO LNK-INPUT
  12.  
  13.       CALL "PRC-CALC" USING LNK-DATOS
  14.      
  15.       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:
Código COBOL:
  1. 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 10 de mayo de 2022 20:46

@Joseg, creo que lo he arreglado:

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01 idx-1        pic 9(4) comp-5.
  5.  01 wsomamodelos pic 9(18) comp-5.
  6.  
  7.  LINKAGE SECTION.
  8.  01  LNK-DATOS.
  9.      05  LNK-INPUT    PIC X(3000).
  10.      05  filler redefines LNK-INPUT.
  11.          10  byte occurs 750 pic 9(8) comp-5.
  12.      05  LNK-OUTPUT   PIC 9(18).
  13.      
  14.  PROCEDURE       DIVISION USING LNK-DATOS.
  15.      
  16.      move 1 to idx-1
  17.      move 0 to LNK-OUTPUT, wsomamodelos
  18.      
  19.      
  20.      perform until idx-1 > 750
  21.          COMPUTE wsomamodelos = wsomamodelos + byte(idx-1) * idx-1
  22.  
  23.          add 1 to idx-1
  24.      end-perform
  25.      
  26.      MOVE wsomamodelos to LNK-OUTPUT
  27.      
  28.      display LNK-OUTPUT

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

Cita:

Citación del post de Mates Básicas
Propiedad conmutativa de la suma: cambiar el orden de los sumandos no altera la suma


Joseg 11 de mayo de 2022 11:21

Cita:

Citación del post de Kuk (Mensaje 7810)
@Joseg, creo que lo he arreglado:

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01 idx-1        pic 9(4) comp-5.
  5.  01 wsomamodelos pic 9(18) comp-5.
  6.  
  7.  LINKAGE SECTION.
  8.  01  LNK-DATOS.
  9.      05  LNK-INPUT    PIC X(3000).
  10.      05  filler redefines LNK-INPUT.
  11.          10  byte occurs 750 pic 9(8) comp-5.
  12.      05  LNK-OUTPUT   PIC 9(18).
  13.      
  14.  PROCEDURE       DIVISION USING LNK-DATOS.
  15.      
  16.      move 1 to idx-1
  17.      move 0 to LNK-OUTPUT, wsomamodelos
  18.      
  19.      
  20.      perform until idx-1 > 750
  21.          COMPUTE wsomamodelos = wsomamodelos + byte(idx-1) * idx-1
  22.  
  23.          add 1 to idx-1
  24.      end-perform
  25.      
  26.      MOVE wsomamodelos to LNK-OUTPUT
  27.      
  28.      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


La franja horaria es GMT +2. Ahora son las 16:39.

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