Cobol Foro

Cobol Foro (https://www.cobolforo.es/index.php)
-   NetCOBOL (https://www.cobolforo.es/forumdisplay.php?f=2)
-   -   [Sintaxis] PowerCOBOL Microsoft ADO (https://www.cobolforo.es/showthread.php?t=706)

diegodm 17 de agosto de 2017 22:40

PowerCOBOL Microsoft ADO
 
Seguindo o exemplo disponível em http://software.fujitsu.com/jp/manua...-09-07-04.html consegui realizar a leitura de um arquivo .mdb do Microsoft Acess. Mas não consegui ALTERAR e INSERIR novos registros. :shok: Alguém tem algum exemplo de como fazer isso?
Obrigado.

Fito 17 de agosto de 2017 23:52

Hola Amigo:

Esto lo hice hace muchísimo, está funcionando para Postgres, fijate si te sirve algo.
Te digo que lo hice a los "ponchazos" porque nunca trabajé con BBDD. Fue un pedido especial que me hicieron para enviar datos de mi sistema administrativo a una base de datos de una universidad.

Código COBOL:
  1.  IDENTIFICATION DIVISION.
  2.  PROGRAM-ID.  UTNBASE.
  3.  ENVIRONMENT DIVISION.
  4.  CONFIGURATION SECTION.
  5.  REPOSITORY.
  6.      CLASS COM AS "*COM".
  7.  DATA DIVISION.
  8.  WORKING-STORAGE SECTION.
  9.  
  10.  01  VARIABLES.
  11.      02 ADO-CONNECTION-TYPE        PIC X(256) VALUE "ADODB.Connection".  
  12.      02 ADO-RECORDSET-TYPE         PIC X(256) VALUE "ADODB.Recordset".  
  13.      02 OBJ-CONNECTION             OBJECT REFERENCE COM.
  14.      02 OBJ-RECORDSET              OBJECT REFERENCE COM.
  15.  
  16.      02 OBJ-NAME                   OBJECT REFERENCE COM OCCURS 100.
  17.      02 OBJ-FIELD                  OBJECT REFERENCE COM OCCURS 100.
  18.      02 OBJ-FIELDS                 OBJECT REFERENCE COM.
  19.      02 OBJ-FIELDS-COUNT           PIC S9(9) COMP-5 VALUE 0.
  20.      02 RECORDCOUNT                PIC S9(9) COMP-5 VALUE 0.
  21.      02 RETURN-ERROR               PIC 9(9) COMP-5.
  22.      02 WLOCK                      PIC S9(9) COMP-5 VALUE 3.
  23.      02 WCURSOR                    PIC S9(9) COMP-5 VALUE 3.
  24.      02 W-INDEX                    PIC 99.
  25.  
  26.      02 ADO-CONNECT-STRING         pic x(60) value "DSN=PostgreSQL30".
  27. *     02 ADO-CONNECT-STRING         pic x(60) value "DSN=prueba".
  28.      02 ADO-SQL-STRING             pic x(500).
  29.  
  30.  01  wnombre             pic x(30).
  31.  01  wapellido           pic x(30).
  32.  
  33.  01  xx-fecha.
  34.      02 xx-fecha-aa      pic 9999.
  35.      02 xx-fecha-g1      pic x value "-".
  36.      02 xx-fecha-mm      pic 99.
  37.      02 xx-fecha-g2      pic x value "-".
  38.      02 xx-fecha-dd      pic 99.
  39.  01  redefines xx-fecha.
  40.      02 ww-fecha         pic x(10).
  41.  
  42.  01  qq-fecha.
  43.      02 qq-fecha-dd      pic 99.
  44.      02 qq-fecha-g1      pic x value "-".
  45.      02 qq-fecha-mm      pic 99.
  46.      02 qq-fecha-g2      pic x value "-".
  47.      02 qq-fecha-aa      pic 9999.
  48.  01  redefines qq-fecha.
  49.      02 yy-fecha         pic x(10).
  50.  
  51.  01  w--barras           pic x(12).
  52.  
  53.  01  wvto                pic 9(8).
  54.  01  redefines wvto.
  55.      03 wvto-aa          pic 9999.
  56.      03 wvto-mm          pic 99.
  57.      03 wvto-dd          pic 99.
  58.  
  59.  01  wimporte            pic 9(4) comp-5.
  60.  01  wresfec             pic 9(8).
  61.  
  62.  copy "Copys\comunwrk.cpy".
  63.      
  64.  LINKAGE SECTION.
  65.  
  66.  01  utnbase-params.
  67.      02 utnbase-barras   pic x(13).
  68.      02 utnbase-num      pic 9(10).
  69.      02 utnbase-nom      pic x(50).
  70.      02 utnbase-imp      pic 9(8).
  71.      02 utnbase-fecha         pic 9(8).
  72.      02 redefines utnbase-fecha.
  73.         03 utnbase-fecha-aa   pic 9999.
  74.         03 utnbase-fecha-mm   pic 99.
  75.         03 utnbase-fecha-dd   pic 99.
  76.      02 utnbase-recibo        pic x(12).
  77.      02 redefines utnbase-recibo.
  78.         03 utnbase-ressuc    pic 9999.
  79.         03 utnbase-resfor    pic 9(8).
  80.      02 utnbase-comm     pic 9.
  81.     *> 1 = lee el cupon
  82.     *> 2 = Actualiza cupon
  83.      02 utnbase-error    pic 9.
  84.  
  85.  PROCEDURE DIVISION using utnbase-params.
  86.  
  87.  comienzo.
  88.      perform fecha-sistema.
  89.      move fecha-amd         to wresfec.
  90.    
  91.      *> crea los objetos principales
  92.      invoke COM "CREATE-OBJECT" using ADO-CONNECTION-TYPE returning OBJ-CONNECTION.
  93.      invoke COM "CREATE-OBJECT" using ADO-RECORDSET-TYPE  returning OBJ-RECORDSET.
  94.  
  95.      *> define y abre la conexión
  96.      invoke OBJ-CONNECTION "SET-CONNECTIONSTRING" using ADO-CONNECT-STRING returning RETURN-ERROR.
  97.      invoke OBJ-CONNECTION "OPEN" returning RETURN-ERROR.
  98.  
  99.      move utnbase-barras     to w--barras.
  100.    
  101.      *> define el string sql y lo ejecuta
  102.      evaluate utnbase-comm
  103.         when 1
  104.         when 2
  105.            string "SELECT * FROM PAGOSENCOOP WHERE CODIGO_BARRAS='" delimited by size
  106.                   w--barras                           delimited by size
  107.                   "';"                                delimited by size
  108.                   low-value                           delimited by size
  109.               into ADO-SQL-STRING
  110.            end-string  
  111.      end-evaluate.
  112.      invoke OBJ-RECORDSET "OPEN" using ADO-SQL-STRING OBJ-CONNECTION WLOCK WCURSOR returning RETURN-ERROR.
  113.      invoke OBJ-RECORDSET "GET-RECORDCOUNT" returning RECORDCOUNT.
  114.  
  115.      move 1                 to utnbase-error.
  116.      
  117.      if recordcount not = zeros
  118.         invoke OBJ-RECORDSET "GET-FIELDS" returning OBJ-FIELDS    *> cargo el objeto fields
  119.         invoke OBJ-FIELDS "GET-COUNT" returning OBJ-FIELDS-COUNT  *> cantidad de fields que tiene la tabla
  120.         perform varying W-INDEX from 0 by 1 until W-INDEX > (OBJ-FIELDS-COUNT - 1) *> cargo el los objetos field con cada campo de la tabla
  121.            invoke OBJ-FIELDS "GET-ITEM" using W-INDEX returning OBJ-FIELD(W-INDEX + 1)
  122.         end-perform
  123.  
  124.         evaluate utnbase-comm
  125.            when 1
  126.               move spaces             to utnbase-nom
  127.               invoke OBJ-FIELD(6) "GET-VALUE" returning utnbase-recibo
  128.               invoke OBJ-FIELD(7) "GET-VALUE" returning utnbase-nom
  129.               invoke OBJ-FIELD(3) "GET-VALUE" returning yy-fecha
  130.               move qq-fecha-aa        to utnbase-fecha-aa
  131.               move qq-fecha-mm        to utnbase-fecha-mm
  132.               move qq-fecha-dd        to utnbase-fecha-dd
  133.               invoke OBJ-FIELD(9) "GET-VALUE" returning yy-fecha
  134.               move qq-fecha-aa        to wvto-aa
  135.               move qq-fecha-mm        to wvto-mm
  136.               move qq-fecha-dd        to wvto-dd
  137.               if wresfec > wvto
  138.                  invoke OBJ-FIELD(5) "GET-VALUE" returning wimporte
  139.               else  
  140.                  invoke OBJ-FIELD(10) "GET-VALUE" returning wimporte
  141.               end-if  
  142.               move wimporte           to utnbase-imp              
  143.               move zeros              to utnbase-error
  144.            when 2
  145.               move utnbase-fecha-aa   to xx-fecha-aa
  146.               move utnbase-fecha-mm   to xx-fecha-mm
  147.               move utnbase-fecha-dd   to xx-fecha-dd
  148.               move "-"                to xx-fecha-g1 xx-fecha-g2
  149.               move utnbase-imp        to wimporte
  150.               invoke OBJ-FIELD(3)  "SET-VALUE" using ww-fecha
  151.               invoke OBJ-FIELD(6)  "SET-VALUE" using utnbase-recibo
  152.               invoke OBJ-FIELD(11) "SET-VALUE" using wimporte
  153.               invoke OBJ-RECORDSET "UPDATE"
  154.         end-evaluate      
  155.      end-if.
  156.      
  157.      invoke OBJ-RECORDSET "Close".
  158.      invoke OBJ-CONNECTION "Close".
  159.  
  160.  
  161.  sale.
  162.      exit program.
  163.  
  164.  copy "Copys\fitopro.cpy".
  165.  
  166.  END PROGRAM UTNBASE.

Saludos.

Fito...


La franja horaria es GMT +2. Ahora son las 13:58.

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