Estimado Antonio:
Muchas gracias por responder.
Antes de analizar el resto del código de VB, por favor analicemos estas líneas en donde se ejecuta la consulta tanto en FW como VB6; y es aquí en donde hago la medición de tiempos:
Con Fw:
Code: Select all | Expand
Llama la función que ejecuta la Consulta y genera el Recordset: oRsAprvt:='' oRsAprvt:=fCreaRecSet(oCnxSrv, cCmdSql, adUseClient, adLockOptimistic, adOpenStatic)Esta es la función que ejecuta la consulta y crea el Recordset:FUNCTION fCreaRecSet(xoCnxSrv, xcCmdSql, xnCursor, xnLockType, xnCurType) LOCAL oRsLocal, oError TRY oRsLocal := TOleAuto():New( "ADODB.RecordSet" ) CATCH oError MsgStop('No se puede establecer conexion con Recordset ...!') ShowErrorCnx( oError ) RETURN NIL END xnCursor :=IF(xnCursor=NIL,adUseServer,xnCursor) // adUseClient xnLockType:=IF(xnLockType=NIL,adLockOptimistic,xnLockType) xnCurType :=IF(xnCurType=NIL,adOpenKeyset,xnCurType) oRsLocal:CursorLocation:=xnCursor oRsLocal:LockType :=xnLockType oRsLocal:CursorType :=xnCurType oRsLocal:Source :=xcCmdSql oRsLocal:ActiveConnection:=xoCnxSrv TRY oRsLocal:Open() =====> Aquí es donde se ejecuta la consulta .... tiempo: 03:00 Minutos. CATCH oError MsgStop('No se puede establecer conexion con Recordset ...!') ShowErrorCnx( oError ) RETURN NIL END IF !oRsLocal:EOF() oRsLocal:MoveFirst() ENDIF RETURN oRsLocal
Este el código VB que ejecuta la Consulta y crea el Recordset:
Code: Select all | Expand
Dim rs As New ADODB.Recordset rs.CursorLocation = adUseClient rs.Open SQL, cCnx, adOpenStatic ====> Aquí es donde se Ejecuta la Consulta ... tiempo: 00:10 sgdos. Set rs.ActiveConnection = Nothing
Este es el código de VB que hace lo mismo con FW. Ambos hacen exactamente la misma consulta y la muestran en una grilla.
Code: Select all | Expand
Option Explicit'Database fields names from SQL queryConst DB_CSUP = "c_super"Const DB_CVEN = "c_perso"Const DB_TVEN = "d_perso"Const DB_CRUT = "ruta"Const DB_TDESRUT = "d_ruta"Const DB_CCLI = "idcliente"Const DB_TNOMREP = "nomcli"' DB_FECENTRE := "fecentre"Const DB_CTIP = "iddocument"Const DB_NFAC = "nroped"Const DB_CARTAG = "c_artag"Const DB_DARTAG = "d_artag"Const DB_CSUBAG1 = "c_subag1"Const DB_DSUBAG1 = "d_subag1"Const DB_CCODART = "codart"Const DB_TDESART = "descrip"Const DB_QCANPED = "nqbultos"Const DB_QUMVTA = "umedstd"Const DB_QIMPORTE = "qimporte"'Cube fields names, arbitrary'Definir Descripcion Campos de la Tabla Contenedora del Cubo. Const CUBEFLD_CSUP = "Cod Supervisor"Const CUBEFLD_CVEN = "Cod Prevendedor"Const CUBEFLD_TVEN = "Nombre Prevendedor"Const CUBEFLD_CRUT = "Cod Ruta"Const CUBEFLD_TDESRUT = "Descripcion Ruta"Const CUBEFLD_CCLI = "Cod Cliente"Const CUBEFLD_TNOMREP = "Nombre del Cliente"' CUBEFLD_FECENTRE := "Fecha Entrega"Const CUBEFLD_CTIP = "Tipo Documento"Const CUBEFLD_NFAC = "Numero Pedido"Const CUBEFLD_CARTAG = "Agrup Articulo"Const CUBEFLD_DARTAG = "Descripcion Agrupa Articulo"Const CUBEFLD_CSUBAG1 = "Sub Agrup Articulo"Const CUBEFLD_DSUBAG1 = "Descripcion Sub Agrup Articulo"Const CUBEFLD_CCODART = "Cod Articulo"Const CUBEFLD_TDESART = "Descripcion Articulo"Const CUBEFLD_QCANPED = "Cantidad Bultos"Const CUBEFLD_QUMVTA = "Cantida Umed"Const CUBEFLD_QIMPORTE = "Importe Soles"'Const CUBEFLD_C_SUPER = "Supervisor"'Const CUBEFLD_C_PERSO = "Cod Vend"'Const CUBEFLD_D_PERSO = "Nombre Vendedor"'Const CUBEFLD_FECENTRE = "Fecha Entrega"'Const CUBEFLD_CODART = "Cod Articulo"'Const CUBEFLD_DESCRIP = "Nombre Articulo"'Const CUBEFLD_QCANPED = DB_QCANPED'Const CUBEFLD_CANT = DB_CANT'Const CUBEFLD_CATEGORY = DB_CATEGORY'Const CUBEFLD_PRODUCT = DB_PRODUCT'Const CUBEFLD_DATE = "Date"'Const CUBEFLD_YEAR = "Year"'Const CUBEFLD_QUARTER = "Quarter"'Const CUBEFLD_MONTH = "Month"'Const CUBEFLD_QUANTITY = DB_QUANTITY'Const CUBEFLD_AMOUNT = DB_AMOUNTConst xCmdSql1 = "SELECT PUB.perscom.c_super AS c_super, PUB.carga.c_perso AS c_perso, PUB.perscom.d_perso AS d_perso, " & vbCrLf & _ "PUB.carga.ruta AS ruta, PUB.rutasv.d_ruta AS d_ruta, PUB.carga.idcliente AS idcliente, " & vbCrLf & _ "PUB.clientes.nomcli AS nomcli, "Const xCmdSql2 = "PUB.carga.iddocumento AS iddocument, PUB.carga.fecentre AS fecentre, PUB.carga.nroped AS nroped, " & vbCrLf & _ "PUB.artagru.c_artag AS c_artag, PUB.foragru.d_artag AS d_artag, PUB.artagru.c_subag1 AS c_subag1, " & vbCrLf & _ "PUB.subagru1.d_subag1 AS d_subag1, PUB.lincarga.codart AS codart, PUB.articulos.descrip AS descrip, " & vbCrLf & _ "(PUB.lincarga.cant * PUB.articulos.resto + PUB.lincarga.resto) / PUB.articulos.resto AS nqbultos, "Const xCmdSql3 = "(PUB.lincarga.cant * PUB.articulos.resto + PUB.lincarga.resto) / PUB.articulos.resto * PUB.articulos.valor AS umedstd, " & vbCrLf & _ "PUB.lincarga.cant * PUB.lincarga.precio + PUB.lincarga.resto * (PUB.lincarga.precio / PUB.articulos.resto) + PUB.lincarga.iva1 + PUB.lincarga.per212 AS qimporte "Const xCmdSql4 = "FROM PUB.artagru, PUB.foragru, PUB.subagru1, PUB.lincarga, PUB.carga, PUB.articulos, PUB.perscom, PUB.rutasv, PUB.clientes " & vbCrLf & _ "WHERE PUB.artagru.c_artag = PUB.foragru.c_artag AND PUB.artagru.c_artag = PUB.subagru1.c_artag AND PUB.artagru.c_subag1 = PUB.subagru1.c_subag1 AND " & vbCrLf & _ "PUB.artagru.codart = PUB.articulos.codart AND PUB.lincarga.nroped = PUB.carga.nroped AND PUB.lincarga.codart = PUB.articulos.codart AND "Const xCmdSql5 = "PUB.carga.idSucur = PUB.perscom.idSucur AND PUB.carga.c_perso = PUB.perscom.c_perso AND PUB.carga.idSucur = PUB.rutasv.idSucur AND " & vbCrLf & _ "PUB.carga.ruta = PUB.rutasv.ruta AND PUB.carga.idSucur = PUB.clientes.idSucur AND PUB.carga.idcliente = PUB.clientes.idcliente AND " & vbCrLf & _ "(PUB.artagru.c_artag = 21) AND (PUB.carga.idSucur = 1)"Const SQL = xCmdSql1 + xCmdSql2 + xCmdSql3 + xCmdSql4 + xCmdSql5Dim cCnx As ADODB.ConnectionPrivate CONS As StringPrivate Sub ContourCubeX1_BeforeMoveDimension(ByVal ViewDim As CCubeX4.IViewDim, ByVal NewAxis As CCubeX4.TxDimAxis, ByVal NewPos As Long, ByVal Cancel As CCubeX4.IBoolean) Select Case ViewDim.Name Case CUBEFLD_CCODART If NewAxis <> xda_outside Then If NewAxis <> ContourCubeX1.Cube.Dims(CUBEFLD_CCODART).Axis Then Cancel.Value = True Else If NewPos <= ContourCubeX1.Cube.Dims(CUBEFLD_TDESART).Pos Then Cancel.Value = True End If End If Case CUBEFLD_CVEN If NewAxis <> xda_outside Then If NewAxis <> ContourCubeX1.Cube.Dims(CUBEFLD_CVEN).Axis Then Cancel.Value = True Else If NewPos >= ContourCubeX1.Cube.Dims(CUBEFLD_TVEN).Pos Then Cancel.Value = True End If End If End SelectEnd SubPrivate Sub Form_Load() On Error GoTo handler ' Instancio la conexión y me conecto con la base de datos ' ---------------------------------------------------------- Set cCnx = New ADODB.Connection cCnx = "DSN=Chessgps;HOST=chess;PORT=2500;DB=distrib;UID=SYSPROGRESS;PWD=ch1573" With cCnx ' Cursor en Cliente para poder usar un DataGrid .CursorLocation = adUseClient ' Abro la conexión con la base de datos usando un DSN .Open cCnx End With ContourCubeX1.BorderStyle = xcbsSingle ContourCubeX1.NULLValueString = "" ContourCubeX1.InactiveDimAreaBkColor = 2 With ContourCubeX1.Cube 'Create Dimensions and Facts in cube ' Dimensions initially appeared on verical axis .Dims.Add CUBEFLD_CSUP, DB_CSUP, 5, 2 .Dims.Add CUBEFLD_CVEN, DB_CVEN, 5, 2 .Dims.Add CUBEFLD_TVEN, DB_TVEN, 1, 2 .Dims.Add CUBEFLD_CRUT, DB_CRUT, 5, 2 .Dims.Add CUBEFLD_TDESRUT, DB_TDESRUT, 1, 2 .Dims.Add CUBEFLD_CCLI, DB_CCLI, 5, 2 .Dims.Add CUBEFLD_TNOMREP, DB_TNOMREP, 1, 2 ':Dims:Add(CUBEFLD_FECENTRE, DB_FECENTRE, 9, 2) .Dims.Add CUBEFLD_CTIP, DB_CTIP, 1, 2 .Dims.Add CUBEFLD_NFAC, DB_NFAC, 5, 2 ' Mostrar Fijos Verticales al presentar el Cubo. .Dims.Add CUBEFLD_CARTAG, DB_CARTAG, 5, 0 .Dims.Add CUBEFLD_DARTAG, DB_DARTAG, 1, 0 .Dims.Add CUBEFLD_CSUBAG1, DB_CSUBAG1, 5, 0 .Dims.Add CUBEFLD_DSUBAG1, DB_DSUBAG1, 1, 0 .Dims.Add CUBEFLD_CCODART, DB_CCODART, 5, 0 .Dims.Add CUBEFLD_TDESART, DB_TDESART, 1, 0 'Cube facts .BaseFacts.Add DB_QCANPED, DB_QCANPED .BaseFacts.Add DB_QUMVTA, DB_QUMVTA .BaseFacts.Add DB_QIMPORTE, DB_QIMPORTE 'Add cube facts to the grid .Facts.Add(CUBEFLD_QCANPED, DB_QCANPED, 1).Caption = "Bultos" .Facts.Add(CUBEFLD_QUMVTA, DB_QUMVTA, 1).Caption = " Cantidad Venta UM " .Facts.Add(CUBEFLD_QIMPORTE, DB_QIMPORTE, 1).Caption = "Importe Bruto" 'Populate recordset Dim rs As New ADODB.Recordset rs.CursorLocation = adUseClient rs.Open SQL, cCnx, adOpenStatic Set rs.ActiveConnection = Nothing 'Activate grid '.Open rs End With ContourCubeX1.Facts(CUBEFLD_QCANPED).Visible = True ContourCubeX1.Facts(CUBEFLD_QCANPED).Appearance.Format = "###,###,##0.00" ContourCubeX1.Facts(CUBEFLD_QUMVTA).Visible = True ContourCubeX1.Facts(CUBEFLD_QUMVTA).Appearance.Format = "###,###,##0.0000" ContourCubeX1.Facts(CUBEFLD_QIMPORTE).Visible = True ContourCubeX1.Facts(CUBEFLD_QIMPORTE).Appearance.Format = "###,###,##0.00" 'ContourCubeX1.FlatStyle = xfs_Flat ContourCubeX1.Cube.Open rs infoBox.Text = info Exit Sub handler: MsgBox ("Error: " & Err.Description) EndEnd SubPrivate Sub Form_Resize() ContourCubeX1.Move 0, Image1.Height, Me.ScaleWidth, Me.ScaleHeight - Image1.Height - infoBox.Height With Image2 .Left = Image1.Width .Width = IIf((Me.Width - Image1.Width) > 0, Me.Width - Image1.Width, 0) End With With infoBox .Top = Image1.Height + ContourCubeX1.Height .Width = ContourCubeX1.Width .Left = 0 End WithEnd Sub
Saludos.
Atte.
Lucho Montero.
Lima - Perú.
------------------------------------------------------------------------
FW 12.04 + xHarbour 1.2.3 + Borland 5.8.2