fastpho
27 de abril de 2022, 18:47
Dos ejemplos de cómo usar Microsoft ADO con PowerCobol
@Breew
Ejemplo 1:
Utiliza el objeto de conexión ADO para establecer una conexion con la BD y utiliza el objeto Recordset para leer los registros de la a BD (.DBF) FoxPro
WORKING-STORAGE SECTION.
01 BD-VARIABLES.
05 OBJ-CONNECTION OBJECT REFERENCE OLE.
05 OBJ-RECORDSET OBJECT REFERENCE OLE.
05 OBJ-FIELDS OBJECT REFERENCE OLE.
05 OBJ-FIELD OBJECT REFERENCE OLE.
01 PROGID-CONNECTION PIC X(8192) VALUE "ADODB.Connection".
01 PROGID-RECORDSET PIC X(8192) VALUE "ADODB.Recordset".
01 NAME-PROVIDER PIC X(8192) VALUE "Microsoft.Jet.OLEDB.4.0;Extended Properties=dBASE IV".
01 DIRECTORIO-DB PIC X(8192) VALUE "c:\downosva\fujitsu\bd". *> Directorio donde estan las BD .DBF
01 Connection-TABLE PIC X(8192) VALUE "Select * from Factura1". *> SET-CONNECTION STRING
01 Cantidad-RECORDCOUNT PIC S9(9) COMP-5.
* Modos de Apertura de las BD
01 WLOCK PIC S9(9) COMP-5 VALUE 1. *> adOpenKeyset
01 WCURSOR PIC S9(9) COMP-5 VALUE 1. *> adLockReadOnly
01 WOPTION PIC S9(9) COMP-5 VALUE -1. *> default option
*--------------------------------------
* Nombre de los Campos de la Tabla
01 NAME-FIELD-CLICODIGO PIC X(8192) VALUE "Clicodigo".
01 NAME-FIELD-NRFACTURA PIC X(8192) VALUE "N_Factura".
*--------------------------------------
* Variables de Retorno de los campos de la tabla.
01 WK-VAL1 PIC X(8192).
01 WK-VAL2 PIC X(8192).
*----------------------------------------
01 IS-EOF PIC S9(4) COMP-5.
01 Version-Ole PIC X(30).
01 IDX1 PIC S9(9).
01 Version-ConnectionString pic x(400).
PROCEDURE DIVISION.
* Create ADO Connection object and Connect to DB
invoke OLE "CREATE-OBJECT" using PROGID-CONNECTION returning OBJ-CONNECTION.
invoke OBJ-CONNECTION "SET-Provider" using NAME-PROVIDER.
invoke OBJ-CONNECTION "GET-Version" returning Version-Ole .
* display "version " , Version-Ole.
invoke OBJ-CONNECTION "Open" using DIRECTORIO-DB.
* Create ADO Recordset object , String Connection
invoke OLE "CREATE-OBJECT" using PROGID-RECORDSET returning OBJ-RECORDSET.
invoke OBJ-RECORDSET "Open" using Connection-TABLE OBJ-CONNECTION WLOCK WCURSOR WOPTION.
* * Leo la Cantidad de registros Dependiendo los valores de la apertura del RecordSet
invoke OBJ-RECORDSET "GET-RecordCount" RETURNING Cantidad-RECORDCOUNT.
* display "Cantidad de Registros " , Cantidad-RECORDCOUNT.
MOVE Cantidad-RECORDCOUNT TO "CAPTION" OF CMSTATIC3.
INVOKE POW-SELF "Refresh".
*leo Connection String
* invoke OBJ-CONNECTION "GET-ConnectionString" returning Version-ConnectionString.
* display "ConnectionString " , Version-ConnectionString.
*
MOVE 0 TO IDX1.
MOVE 11 to "MousePointer" OF POW-SELF.
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF.
*Bucle de lectura de los registros
*Muestra los registros en ListView solamente 2 campos
perform with test before until IS-EOF not = 0
invoke OBJ-RECORDSET "GET-Fields" returning OBJ-FIELDS
invoke OBJ-FIELDS "GET-Item" using NAME-FIELD-CLICODIGO returning OBJ-FIELD
invoke OBJ-FIELD "GET-VALUE" returning WK-VAL1
invoke OBJ-FIELDS "GET-Item" using NAME-FIELD-NRFACTURA returning OBJ-FIELD
invoke OBJ-FIELD "GET-VALUE" returning WK-VAL2
ADD 1 TO IDX1
invoke cmlistview3 "Add" USING 1 1
MOVE WK-VAL1 TO "Text"(1) OF "ListItems"(idx1) OF cmlistview3
MOVE WK-VAL2 TO "Text"(2) OF "ListItems"(idx1) OF cmlistview3
INVOKE cmlistview3 "Refresh"
set OBJ-FIELD to Null
set OBJ-FIELDS to Null
invoke OBJ-RECORDSET "MoveNext"
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF
end-perform.
* * cierro conexion
invoke OBJ-RECORDSET "Close".
set OBJ-RECORDSET to Null.
invoke OBJ-CONNECTION "Close".
set OBJ-CONNECTION to Null.
MOVE 0 to "MousePointer" OF POW-SELF.
Ejemplo 2:
Utiliza el objeto de conexión ADO para establecer una conexion con la BD y utiliza el objeto Recordset para leer los registros de la a BD (.MDB) Access
WORKING-STORAGE SECTION.
01 BD-VARIABLES.
05 OBJ-CONNECTION OBJECT REFERENCE OLE.
05 OBJ-RECORDSET OBJECT REFERENCE OLE.
05 OBJ-FIELDS OBJECT REFERENCE OLE.
05 OBJ-FIELD OBJECT REFERENCE OLE.
01 PROGID-CONNECTION PIC X(8192) VALUE "ADODB.Connection".
01 PROGID-RECORDSET PIC X(8192) VALUE "ADODB.Recordset".
01 NAME-PROVIDER PIC X(8192) VALUE "Microsoft.Jet.OLEDB.4.0".
01 NAME-DB PIC X(8192) VALUE "c:\downosva\fujitsu\bd\Test.mdb". *> Directorio y nombre de la BD
01 Connection-TABLE PIC X(8192) VALUE "Select * from Customers". *> SET-CONNECTION STRING
01 Cantidad-RECORDCOUNT PIC S9(9) COMP-5.
* Modos de Apertura de las BD
01 WLOCK PIC S9(9) COMP-5 VALUE 1. *> adOpenKeyset
01 WCURSOR PIC S9(9) COMP-5 VALUE 1. *> adLockReadOnly
01 WOPTION PIC S9(9) COMP-5 VALUE -1. *> default option
*--------------------------------------
* Nombre de los Campos de la Tabla
01 NAME-FIELD-ID PIC X(8192) VALUE "ID".
01 NAME-FIELD-Company PIC X(8192) VALUE "Company".
*--------------------------------------
* Variables de Retorno de los campos de la tabla.
01 WK-VAL1 PIC X(8192).
01 WK-VAL2 PIC X(8192).
*----------------------------------------
01 IS-EOF PIC S9(4) COMP-5.
01 Version-Ole PIC X(30).
01 IDX1 PIC S9(9).
01 Version-ConnectionString pic x(400).
PROCEDURE DIVISION.
* Create ADO Connection object and Connect to DB
invoke OLE "CREATE-OBJECT" using PROGID-CONNECTION returning OBJ-CONNECTION.
invoke OBJ-CONNECTION "SET-Provider" using NAME-PROVIDER.
invoke OBJ-CONNECTION "GET-Version" returning Version-Ole .
* display "version " , Version-Ole.
invoke OBJ-CONNECTION "Open" using NAME-DB.
* Create ADO Recordset object , String Connection
invoke OLE "CREATE-OBJECT" using PROGID-RECORDSET returning OBJ-RECORDSET.
invoke OBJ-RECORDSET "Open" using Connection-TABLE OBJ-CONNECTION WLOCK WCURSOR WOPTION.
* Leo la Cantidad de registros Dependiendo los valores de la apertura del RecordSet
invoke OBJ-RECORDSET "GET-RecordCount" RETURNING Cantidad-RECORDCOUNT.
* display "Cantidad de Registros " , Cantidad-RECORDCOUNT.
MOVE Cantidad-RECORDCOUNT TO "CAPTION" OF CMSTATIC3.
invoke POW-SELF "Refresh".
*leo Connection String
* invoke OBJ-CONNECTION "GET-ConnectionString" returning Version-ConnectionString.
* display "ConnectionString " , Version-ConnectionString.
*
MOVE 0 TO IDX1.
MOVE 11 to "MousePointer" OF POW-SELF.
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF.
*Bucle de lectura de los registros
*Muestra los registros en ListView solamente 2 campos
perform with test before until IS-EOF not = 0
invoke OBJ-RECORDSET "GET-Fields" returning OBJ-FIELDS
invoke OBJ-FIELDS "GET-Item" using NAME-FIELD-ID returning OBJ-FIELD
invoke OBJ-FIELD "GET-VALUE" returning WK-VAL1
invoke OBJ-FIELDS "GET-Item" using NAME-FIELD-Company returning OBJ-FIELD
invoke OBJ-FIELD "GET-VALUE" returning WK-VAL2
ADD 1 TO IDX1
invoke cmlistview3 "Add" USING 1 1
MOVE WK-VAL1 TO "Text"(1) OF "ListItems"(idx1) OF cmlistview3
MOVE WK-VAL2 TO "Text"(2) OF "ListItems"(idx1) OF cmlistview3
INVOKE cmlistview3 "Refresh"
set OBJ-FIELD to Null
set OBJ-FIELDS to Null
invoke OBJ-RECORDSET "MoveNext"
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF
end-perform.
* cierro conexion
invoke OBJ-RECORDSET "Close".
set OBJ-RECORDSET to Null.
invoke OBJ-CONNECTION "Close".
set OBJ-CONNECTION to Null.
MOVE 0 to "MousePointer" OF POW-SELF.
*
Dejo el link con la explicacion de ActiveX Data Objects
ActiveX Data Objects - Wikipedia, la enciclopedia libre (https://es.wikipedia.org/wiki/ActiveX_Data_Objects)
Saludos ...
@Breew
Ejemplo 1:
Utiliza el objeto de conexión ADO para establecer una conexion con la BD y utiliza el objeto Recordset para leer los registros de la a BD (.DBF) FoxPro
WORKING-STORAGE SECTION.
01 BD-VARIABLES.
05 OBJ-CONNECTION OBJECT REFERENCE OLE.
05 OBJ-RECORDSET OBJECT REFERENCE OLE.
05 OBJ-FIELDS OBJECT REFERENCE OLE.
05 OBJ-FIELD OBJECT REFERENCE OLE.
01 PROGID-CONNECTION PIC X(8192) VALUE "ADODB.Connection".
01 PROGID-RECORDSET PIC X(8192) VALUE "ADODB.Recordset".
01 NAME-PROVIDER PIC X(8192) VALUE "Microsoft.Jet.OLEDB.4.0;Extended Properties=dBASE IV".
01 DIRECTORIO-DB PIC X(8192) VALUE "c:\downosva\fujitsu\bd". *> Directorio donde estan las BD .DBF
01 Connection-TABLE PIC X(8192) VALUE "Select * from Factura1". *> SET-CONNECTION STRING
01 Cantidad-RECORDCOUNT PIC S9(9) COMP-5.
* Modos de Apertura de las BD
01 WLOCK PIC S9(9) COMP-5 VALUE 1. *> adOpenKeyset
01 WCURSOR PIC S9(9) COMP-5 VALUE 1. *> adLockReadOnly
01 WOPTION PIC S9(9) COMP-5 VALUE -1. *> default option
*--------------------------------------
* Nombre de los Campos de la Tabla
01 NAME-FIELD-CLICODIGO PIC X(8192) VALUE "Clicodigo".
01 NAME-FIELD-NRFACTURA PIC X(8192) VALUE "N_Factura".
*--------------------------------------
* Variables de Retorno de los campos de la tabla.
01 WK-VAL1 PIC X(8192).
01 WK-VAL2 PIC X(8192).
*----------------------------------------
01 IS-EOF PIC S9(4) COMP-5.
01 Version-Ole PIC X(30).
01 IDX1 PIC S9(9).
01 Version-ConnectionString pic x(400).
PROCEDURE DIVISION.
* Create ADO Connection object and Connect to DB
invoke OLE "CREATE-OBJECT" using PROGID-CONNECTION returning OBJ-CONNECTION.
invoke OBJ-CONNECTION "SET-Provider" using NAME-PROVIDER.
invoke OBJ-CONNECTION "GET-Version" returning Version-Ole .
* display "version " , Version-Ole.
invoke OBJ-CONNECTION "Open" using DIRECTORIO-DB.
* Create ADO Recordset object , String Connection
invoke OLE "CREATE-OBJECT" using PROGID-RECORDSET returning OBJ-RECORDSET.
invoke OBJ-RECORDSET "Open" using Connection-TABLE OBJ-CONNECTION WLOCK WCURSOR WOPTION.
* * Leo la Cantidad de registros Dependiendo los valores de la apertura del RecordSet
invoke OBJ-RECORDSET "GET-RecordCount" RETURNING Cantidad-RECORDCOUNT.
* display "Cantidad de Registros " , Cantidad-RECORDCOUNT.
MOVE Cantidad-RECORDCOUNT TO "CAPTION" OF CMSTATIC3.
INVOKE POW-SELF "Refresh".
*leo Connection String
* invoke OBJ-CONNECTION "GET-ConnectionString" returning Version-ConnectionString.
* display "ConnectionString " , Version-ConnectionString.
*
MOVE 0 TO IDX1.
MOVE 11 to "MousePointer" OF POW-SELF.
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF.
*Bucle de lectura de los registros
*Muestra los registros en ListView solamente 2 campos
perform with test before until IS-EOF not = 0
invoke OBJ-RECORDSET "GET-Fields" returning OBJ-FIELDS
invoke OBJ-FIELDS "GET-Item" using NAME-FIELD-CLICODIGO returning OBJ-FIELD
invoke OBJ-FIELD "GET-VALUE" returning WK-VAL1
invoke OBJ-FIELDS "GET-Item" using NAME-FIELD-NRFACTURA returning OBJ-FIELD
invoke OBJ-FIELD "GET-VALUE" returning WK-VAL2
ADD 1 TO IDX1
invoke cmlistview3 "Add" USING 1 1
MOVE WK-VAL1 TO "Text"(1) OF "ListItems"(idx1) OF cmlistview3
MOVE WK-VAL2 TO "Text"(2) OF "ListItems"(idx1) OF cmlistview3
INVOKE cmlistview3 "Refresh"
set OBJ-FIELD to Null
set OBJ-FIELDS to Null
invoke OBJ-RECORDSET "MoveNext"
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF
end-perform.
* * cierro conexion
invoke OBJ-RECORDSET "Close".
set OBJ-RECORDSET to Null.
invoke OBJ-CONNECTION "Close".
set OBJ-CONNECTION to Null.
MOVE 0 to "MousePointer" OF POW-SELF.
Ejemplo 2:
Utiliza el objeto de conexión ADO para establecer una conexion con la BD y utiliza el objeto Recordset para leer los registros de la a BD (.MDB) Access
WORKING-STORAGE SECTION.
01 BD-VARIABLES.
05 OBJ-CONNECTION OBJECT REFERENCE OLE.
05 OBJ-RECORDSET OBJECT REFERENCE OLE.
05 OBJ-FIELDS OBJECT REFERENCE OLE.
05 OBJ-FIELD OBJECT REFERENCE OLE.
01 PROGID-CONNECTION PIC X(8192) VALUE "ADODB.Connection".
01 PROGID-RECORDSET PIC X(8192) VALUE "ADODB.Recordset".
01 NAME-PROVIDER PIC X(8192) VALUE "Microsoft.Jet.OLEDB.4.0".
01 NAME-DB PIC X(8192) VALUE "c:\downosva\fujitsu\bd\Test.mdb". *> Directorio y nombre de la BD
01 Connection-TABLE PIC X(8192) VALUE "Select * from Customers". *> SET-CONNECTION STRING
01 Cantidad-RECORDCOUNT PIC S9(9) COMP-5.
* Modos de Apertura de las BD
01 WLOCK PIC S9(9) COMP-5 VALUE 1. *> adOpenKeyset
01 WCURSOR PIC S9(9) COMP-5 VALUE 1. *> adLockReadOnly
01 WOPTION PIC S9(9) COMP-5 VALUE -1. *> default option
*--------------------------------------
* Nombre de los Campos de la Tabla
01 NAME-FIELD-ID PIC X(8192) VALUE "ID".
01 NAME-FIELD-Company PIC X(8192) VALUE "Company".
*--------------------------------------
* Variables de Retorno de los campos de la tabla.
01 WK-VAL1 PIC X(8192).
01 WK-VAL2 PIC X(8192).
*----------------------------------------
01 IS-EOF PIC S9(4) COMP-5.
01 Version-Ole PIC X(30).
01 IDX1 PIC S9(9).
01 Version-ConnectionString pic x(400).
PROCEDURE DIVISION.
* Create ADO Connection object and Connect to DB
invoke OLE "CREATE-OBJECT" using PROGID-CONNECTION returning OBJ-CONNECTION.
invoke OBJ-CONNECTION "SET-Provider" using NAME-PROVIDER.
invoke OBJ-CONNECTION "GET-Version" returning Version-Ole .
* display "version " , Version-Ole.
invoke OBJ-CONNECTION "Open" using NAME-DB.
* Create ADO Recordset object , String Connection
invoke OLE "CREATE-OBJECT" using PROGID-RECORDSET returning OBJ-RECORDSET.
invoke OBJ-RECORDSET "Open" using Connection-TABLE OBJ-CONNECTION WLOCK WCURSOR WOPTION.
* Leo la Cantidad de registros Dependiendo los valores de la apertura del RecordSet
invoke OBJ-RECORDSET "GET-RecordCount" RETURNING Cantidad-RECORDCOUNT.
* display "Cantidad de Registros " , Cantidad-RECORDCOUNT.
MOVE Cantidad-RECORDCOUNT TO "CAPTION" OF CMSTATIC3.
invoke POW-SELF "Refresh".
*leo Connection String
* invoke OBJ-CONNECTION "GET-ConnectionString" returning Version-ConnectionString.
* display "ConnectionString " , Version-ConnectionString.
*
MOVE 0 TO IDX1.
MOVE 11 to "MousePointer" OF POW-SELF.
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF.
*Bucle de lectura de los registros
*Muestra los registros en ListView solamente 2 campos
perform with test before until IS-EOF not = 0
invoke OBJ-RECORDSET "GET-Fields" returning OBJ-FIELDS
invoke OBJ-FIELDS "GET-Item" using NAME-FIELD-ID returning OBJ-FIELD
invoke OBJ-FIELD "GET-VALUE" returning WK-VAL1
invoke OBJ-FIELDS "GET-Item" using NAME-FIELD-Company returning OBJ-FIELD
invoke OBJ-FIELD "GET-VALUE" returning WK-VAL2
ADD 1 TO IDX1
invoke cmlistview3 "Add" USING 1 1
MOVE WK-VAL1 TO "Text"(1) OF "ListItems"(idx1) OF cmlistview3
MOVE WK-VAL2 TO "Text"(2) OF "ListItems"(idx1) OF cmlistview3
INVOKE cmlistview3 "Refresh"
set OBJ-FIELD to Null
set OBJ-FIELDS to Null
invoke OBJ-RECORDSET "MoveNext"
invoke OBJ-RECORDSET "GET-EOF" returning IS-EOF
end-perform.
* cierro conexion
invoke OBJ-RECORDSET "Close".
set OBJ-RECORDSET to Null.
invoke OBJ-CONNECTION "Close".
set OBJ-CONNECTION to Null.
MOVE 0 to "MousePointer" OF POW-SELF.
*
Dejo el link con la explicacion de ActiveX Data Objects
ActiveX Data Objects - Wikipedia, la enciclopedia libre (https://es.wikipedia.org/wiki/ActiveX_Data_Objects)
Saludos ...