[Sintaxis] PowerCOBOL Microsoft ADO

[diegodm]

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. Alguém tem algum exemplo de como fazer isso?
Obrigado.

[Fito]

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.

 IDENTIFICATION DIVISION.
 PROGRAM-ID.  UTNBASE.
 ENVIRONMENT DIVISION.
 CONFIGURATION SECTION.
 REPOSITORY.
     CLASS COM AS "*COM".
 DATA DIVISION.
 WORKING-STORAGE SECTION.
 
 01  VARIABLES.
     02 ADO-CONNECTION-TYPE        PIC X(256) VALUE "ADODB.Connection".  
     02 ADO-RECORDSET-TYPE         PIC X(256) VALUE "ADODB.Recordset".  
     02 OBJ-CONNECTION             OBJECT REFERENCE COM.
     02 OBJ-RECORDSET              OBJECT REFERENCE COM.
 
     02 OBJ-NAME                   OBJECT REFERENCE COM OCCURS 100.
     02 OBJ-FIELD                  OBJECT REFERENCE COM OCCURS 100.
     02 OBJ-FIELDS                 OBJECT REFERENCE COM.
     02 OBJ-FIELDS-COUNT           PIC S9(9) COMP-5 VALUE 0.
     02 RECORDCOUNT                PIC S9(9) COMP-5 VALUE 0.
     02 RETURN-ERROR               PIC 9(9) COMP-5.
     02 WLOCK                      PIC S9(9) COMP-5 VALUE 3.
     02 WCURSOR                    PIC S9(9) COMP-5 VALUE 3.
     02 W-INDEX                    PIC 99.
 
     02 ADO-CONNECT-STRING         pic x(60) value "DSN=PostgreSQL30".
*     02 ADO-CONNECT-STRING         pic x(60) value "DSN=prueba".
     02 ADO-SQL-STRING             pic x(500).
 
 01  wnombre             pic x(30).
 01  wapellido           pic x(30).
 
 01  xx-fecha.
     02 xx-fecha-aa      pic 9999.
     02 xx-fecha-g1      pic x value "-".
     02 xx-fecha-mm      pic 99.
     02 xx-fecha-g2      pic x value "-".
     02 xx-fecha-dd      pic 99.
 01  redefines xx-fecha.
     02 ww-fecha         pic x(10).
 
 01  qq-fecha.
     02 qq-fecha-dd      pic 99.
     02 qq-fecha-g1      pic x value "-".
     02 qq-fecha-mm      pic 99.
     02 qq-fecha-g2      pic x value "-".
     02 qq-fecha-aa      pic 9999.
 01  redefines qq-fecha.
     02 yy-fecha         pic x(10).
 
 01  w--barras           pic x(12).
 
 01  wvto                pic 9(8).
 01  redefines wvto.
     03 wvto-aa          pic 9999.
     03 wvto-mm          pic 99.
     03 wvto-dd          pic 99.
 
 01  wimporte            pic 9(4) comp-5.
 01  wresfec             pic 9(8).
 
 copy "Copys\comunwrk.cpy".
      
 LINKAGE SECTION.
 
 01  utnbase-params.
     02 utnbase-barras   pic x(13).
     02 utnbase-num      pic 9(10).
     02 utnbase-nom      pic x(50).
     02 utnbase-imp      pic 9(8).
     02 utnbase-fecha         pic 9(8).
     02 redefines utnbase-fecha.
        03 utnbase-fecha-aa   pic 9999.
        03 utnbase-fecha-mm   pic 99.
        03 utnbase-fecha-dd   pic 99.
     02 utnbase-recibo        pic x(12).
     02 redefines utnbase-recibo.
        03 utnbase-ressuc    pic 9999.
        03 utnbase-resfor    pic 9(8).
     02 utnbase-comm     pic 9.
     *> 1 = lee el cupon
     *> 2 = Actualiza cupon
     02 utnbase-error    pic 9.
 
 PROCEDURE DIVISION using utnbase-params.
 
 comienzo.
     perform fecha-sistema.
     move fecha-amd         to wresfec.
     
     *> crea los objetos principales 
     invoke COM "CREATE-OBJECT" using ADO-CONNECTION-TYPE returning OBJ-CONNECTION.
     invoke COM "CREATE-OBJECT" using ADO-RECORDSET-TYPE  returning OBJ-RECORDSET.
 
     *> define y abre la conexión
     invoke OBJ-CONNECTION "SET-CONNECTIONSTRING" using ADO-CONNECT-STRING returning RETURN-ERROR.
     invoke OBJ-CONNECTION "OPEN" returning RETURN-ERROR.
 
     move utnbase-barras     to w--barras.
     
     *> define el string sql y lo ejecuta
     evaluate utnbase-comm
        when 1 
        when 2 
           string "SELECT * FROM PAGOSENCOOP WHERE CODIGO_BARRAS='" delimited by size
                  w--barras                           delimited by size
                  "';"                                delimited by size
                  low-value                           delimited by size
              into ADO-SQL-STRING
           end-string   
     end-evaluate.
     invoke OBJ-RECORDSET "OPEN" using ADO-SQL-STRING OBJ-CONNECTION WLOCK WCURSOR returning RETURN-ERROR.
     invoke OBJ-RECORDSET "GET-RECORDCOUNT" returning RECORDCOUNT.
 
     move 1                 to utnbase-error.
     
     if recordcount not = zeros
        invoke OBJ-RECORDSET "GET-FIELDS" returning OBJ-FIELDS    *> cargo el objeto fields
        invoke OBJ-FIELDS "GET-COUNT" returning OBJ-FIELDS-COUNT  *> cantidad de fields que tiene la tabla
        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
           invoke OBJ-FIELDS "GET-ITEM" using W-INDEX returning OBJ-FIELD(W-INDEX + 1) 
        end-perform
 
        evaluate utnbase-comm
           when 1 
              move spaces             to utnbase-nom
              invoke OBJ-FIELD(6) "GET-VALUE" returning utnbase-recibo
              invoke OBJ-FIELD(7) "GET-VALUE" returning utnbase-nom
              invoke OBJ-FIELD(3) "GET-VALUE" returning yy-fecha
              move qq-fecha-aa        to utnbase-fecha-aa
              move qq-fecha-mm        to utnbase-fecha-mm
              move qq-fecha-dd        to utnbase-fecha-dd
              invoke OBJ-FIELD(9) "GET-VALUE" returning yy-fecha
              move qq-fecha-aa        to wvto-aa
              move qq-fecha-mm        to wvto-mm
              move qq-fecha-dd        to wvto-dd
              if wresfec > wvto
                 invoke OBJ-FIELD(5) "GET-VALUE" returning wimporte
              else   
                 invoke OBJ-FIELD(10) "GET-VALUE" returning wimporte
              end-if   
              move wimporte           to utnbase-imp              
              move zeros              to utnbase-error
           when 2
              move utnbase-fecha-aa   to xx-fecha-aa
              move utnbase-fecha-mm   to xx-fecha-mm
              move utnbase-fecha-dd   to xx-fecha-dd
              move "-"                to xx-fecha-g1 xx-fecha-g2
              move utnbase-imp        to wimporte
              invoke OBJ-FIELD(3)  "SET-VALUE" using ww-fecha
              invoke OBJ-FIELD(6)  "SET-VALUE" using utnbase-recibo
              invoke OBJ-FIELD(11) "SET-VALUE" using wimporte
              invoke OBJ-RECORDSET "UPDATE"
        end-evaluate      
     end-if.
     
     invoke OBJ-RECORDSET "Close".
     invoke OBJ-CONNECTION "Close".
 
 
 sale.
     exit program.
 
 copy "Copys\fitopro.cpy".
 
 END PROGRAM UTNBASE.

Saludos.

Fito...