IDENTIFICATION DIVISION.
PROGRAM-ID. ADO.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
REPOSITORY.
CLASS COM AS "*COM"
CLASS EXCEP AS "*COM-EXCEPTION"
CLASS ARRAY AS "*COM-ARRAY".
DATA DIVISION.
WORKING-STORAGE SECTION.
*01 WK-OPTION PIC S9(9) COMP-5 VALUE POW-ADODB-ADCMDTEXT.
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. *> 3 server
02 W-INDEX PIC 99.
02 WAFTERRECORDS PIC S9(9) COMP-5 VALUE 3.
02 ADO-CONNECT-STRING pic x(260) value low-values.
* 02 ADO-CONNECT-STRING pic x(60) value "DSN=prueba".
02 ADO-SQL-STRING pic x(500).
01 WK-0 PIC S9(9) COMP-5 VALUE 0.
01 WK-1 PIC S9(9) COMP-5 VALUE 1.
01 IS-EOF PIC S9(4) COMP-5.
01 inValue pic x(200) .
01 fieldType pic xxxx.
01 mystring pic x(30).
01 wapellido pic x(30).
01 NAME-FIELD PIC X(500) VALUE "CustomerName".
01 wmsg pic x(1000).
01 wfecha1 pic x(10) value '2018-06-07'.
01 wfecha2 pic x(10) value '07-06-2018'.
01 wfecha3 pic x(08) value '07062018'.
01 wfecha4 pic x(8) value '20180607'.
01 wfecha5 pic 9999/99/99 value "2018/01/02".
01 xx-fecha.
02 xx-fecha-aa pic 9999 VALUE 2018.
02 xx-fecha-g1 pic x value "-".
02 xx-fecha-mm pic 99 VALUE 6.
02 xx-fecha-g2 pic x value "-".
02 xx-fecha-dd pic 99 VALUE 4.
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(9),99. *> comp-5.
01 wresfec pic 9(8).
01 utnbase-params GLOBAL EXTERNAL.
02 utnbase-comm pic 9.
*> 1 = lee el cupon
*> 2 = Actualiza cupon
02 utnbase-error pic 9.
01 MYDATA PIC 9(9) COMP-5.
*LINKAGE SECTION.
*
*01 utnbase-params.
* 02 utnbase-comm pic 9.
* *> 1 = lee el cupon
* *> 2 = Actualiza cupon
* 02 utnbase-error pic 9.
*
PROCEDURE DIVISION. *> using utnbase-params.
comienzo.
* move fecha-amd to wresfec.
* STRING 'Provider=PCSoft.HFSQL;Initial Catalog=C:\TESTES_OLEDB_HF;
* 'Password="";Extended Properties="Language=ISO-8859-1";' DELIMITED BY SIZE
* LOW-VALUES DELIMITED BY SIZE
* INTO ADO-CONNECT-STRING
*> 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" USING ADO-CONNECT-STRING returning RETURN-ERROR.
*> define el string sql y lo ejecuta
evaluate utnbase-comm
when 1
when 2
string "SELECT * FROM CUSTOMER;" 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
move "alterado" to mystring
evaluate utnbase-comm
when 1
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF
perform with test before until IS-EOF not = 0
invoke OBJ-FIELD(4) "GET-VALUE" returning mystring *>
invoke OBJ-FIELD(17) "GET-VALUE" returning mystring *>
invoke OBJ-FIELD(18) "GET-VALUE" returning mystring *>
invoke OBJ-FIELD(19) "GET-VALUE" returning mystring *> COLUNA QUE QUER ALTERAR COM FECHAS
move zeros to utnbase-error
invoke OBJ-RECORDSET "MoveNext"
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF
end-perform
when 2
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF
perform with test before until IS-EOF not = 0
move 1234,43 to wimporte
invoke OBJ-FIELD(1) "SET-VALUE" using wimporte
invoke OBJ-FIELD(4) "SET-VALUE" using mystring
invoke OBJ-FIELD(19) "GET-TYPE" returning mystring *> adDBDate 133 Indicates a date value (yyyymmdd) (DBTYPE_DBDATE).
invoke OBJ-FIELD(19) "SET-VALUE" using wfecha2 *> FECHA A ATUALIZAR
invoke OBJ-RECORDSET "UPDATEBATCH" USING WAFTERRECORDS
invoke OBJ-RECORDSET "GET-SOURCE" returning wmsg
invoke OBJ-RECORDSET "GET-STATE" returning wmsg
invoke OBJ-RECORDSET "GET-STATUS" returning wmsg
invoke OBJ-RECORDSET "MoveNext"
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF
end-perform
end-evaluate
end-if.
invoke OBJ-RECORDSET "Close".
invoke OBJ-CONNECTION "Close".
sale.
exit program.
END PROGRAM ADO.
Otros temas que te pueden interesar
6 de junio de 2018, 19:55
Likes
