Ver Mensaje Individual
  #5
Antiguo 7 de febrero de 2019, 15:36
Lascu
Forero Junior
Última Actividad 30.06.2026 22:24
Posts Posts: 33
Likes enviados Enviados: 49
Likes recibidos Recibidos: 18

Hola Fito, me sumo a la respuesta de Josber. Es más sencillo de usar y mantener sql embebido que ADO, en mi opinión.
Te adjunto una rutina que uso para leer un registro de usuario.

Código COBOL:
  1. ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  
  5.      EXEC SQL BEGIN DECLARE SECTION END-EXEC.
  6.    
  7.  #INCLUDE "FD\BD-TABLAS.CPY".
  8.  
  9.  01 BDUSUARIOS.
  10.     02 BDIDUSR    PIC S9(06).
  11.     02 BDLOGIN    PIC X(20).
  12.     02 BDNOMBRE   PIC X(60).
  13.     02 BDTIPOUSR  PIC X(04).
  14.     02 BDCLAVE    PIC X(20).
  15.     02 BDCAMBIO   PIC X(08).
  16.     02 BDHOST     PIC X(80).
  17.     02 BDFOTOUSR  PIC X(80).
  18.     02 BDACCESO   PIC X(14).
  19.    
  20.  01 SQLFECHA            PIC X(08) GLOBAL.
  21.  01 SQLSTATE            PIC X(5) global.
  22.  01 SQLCODE             PIC S9(09) COMP-5 GLOBAL.
  23.  01 SQLMSG              PIC X(128) GLOBAL.
  24.  
  25.      EXEC SQL END DECLARE SECTION END-EXEC.
  26.  
  27.  01 DATOS-IMAGEN.
  28.     02 FILLER   PIC X(06) VALUE "FOTOS".
  29.     02 NOM-FOTO PIC X(15).
  30.  01 WK-COMBO.
  31.     02 WK-VALOR PIC X(04).
  32.     02 FILLER   PIC X(03) VALUE " - ".
  33.     02 WK-DESCR PIC X(40).
  34.    
  35.  LINKAGE SECTION.
  36.  01 LK-ID     PIC 9(04).
  37.  01 LK-NOMBRE PIC X(20).
  38.  PROCEDURE DIVISION USING LK-ID, LK-NOMBRE.
  39.      INITIALIZE BDUSUARIOS.
  40.      EXEC SQL CONNECT TO DEFAULT END-EXEC.    
  41.      EVALUATE TRUE
  42.         WHEN REG-EXISTE
  43.            MOVE LK-ID TO BDIDUSR
  44.            EXEC SQL SELECT * FROM usuarios WHERE iduser = :BDIDUSR
  45.                     INTO :BDIDUSR, :BDLOGIN, :BDNOMBRE, :BDTIPOUSR, :BDCLAVE, :BDCAMBIO, :BDACCESO
  46.            END-EXEC
  47.         WHEN REG-CAMBIO
  48.            MOVE LK-NOMBRE TO BDLOGIN
  49.            EXEC SQL SELECT * FROM usuarios WHERE iduser = :BDLOGIN
  50.                     INTO :BDIDUSR, :BDLOGIN, :BDNOMBRE, :BDTIPOUSR, :BDCLAVE, :BDCAMBIO, :BDACCESO
  51.            END-EXEC
  52.      END-EVALUATE.
  53.      IF SQLSTATE = "00000" THEN
  54.                               PERFORM DATOS-A-PANTALLA
  55.        ELSE
  56.           MOVE SQLSTATE TO WX-SQLSTATE-ERROR
  57.           MOVE SQLMSG   TO WX-SQLMSG-ERROR
  58.           INVOKE POW-SELF "CallForm" USING "INICIOERROR" "ERRORBD.DLL"
  59.      END-IF.
  60.      EXEC SQL DISCONNECT DEFAULT END-EXEC.
  61.      EXIT PROGRAM.
  62.      
  63.      
  64.  DATOS-A-PANTALLA.
  65.      MOVE BDIDUSR      TO "Caption" OF LBL-CODIGO.
  66.      MOVE BDLOGIN      TO "Text"    OF PIC-LOGIN.
  67.      MOVE BDNOMBRE     TO "Text"    OF PIC-NOMBRE.
  68.      MOVE BDCLAVE      TO "Text"    OF PIC-CLAVE.
  69. *     MOVE BDFECHA      TO "Caption" OF LBL-FECHA-ACCESO.
  70.      MOVE BDHOST       TO "Caption" OF LBL-ORDENADOR.
  71.      IF BDFOTOUSR NOT = SPACES THEN
  72.                                   MOVE BDFOTOUSR TO NOM-FOTO
  73.                                   MOVE DATOS-IMAGEN TO "ImageName" OF IMAGEN
  74.      END-IF.
  75.      IF BDTIPOUSR > SPACES THEN
  76.                               MOVE "TUSU"    TO BDTIPO
  77.                               MOVE BDTIPOUSR TO BDVALOR
  78.                               EXEC SQL
  79.                                  SELECT tipotbl, valortbl, descritbl FROM tablas
  80.                                  WHERE tipotbl = :BDTIPO AND valortbl = :BDVALOR INTO :BDTIPO, :BDVALOR, :BDDESCR
  81.                               END-EXEC
  82.                               MOVE BDVALOR TO WK-VALOR
  83.                               MOVE BDDESCR TO WK-DESCR
  84.                               MOVE WK-COMBO TO "Text" OF CBO-TIPO
  85.      END-IF.
  86.      IF REG-CAMBIO THEN
  87.                        MOVE POW-FALSE TO "Enabled" OF PIC-LOGIN
  88.                        MOVE POW-FALSE TO "Enabled" OF CBO-TIPO
  89.                        INVOKE PIC-NOMBRE "SetFocus"
  90.         ELSE
  91.            INVOKE PIC-LOGIN "SetFocus"
  92.       END-IF.

Saludos
Lascu is offline   Responder Con Cita