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
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
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
Option Explicit
'Database fields names from SQL query
Const 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_AMOUNT
Const 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 + xCmdSql5
Dim cCnx As ADODB.Connection
Private CONS As String
Private 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 Select
End Sub
Private 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)
End
End Sub
Private 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 With
End Sub
Saludos.
Atte.
Lucho Montero.
Lima - Perú.
------------------------------------------------------------------------
FW 12.04 + xHarbour 1.2.3 + Borland 5.8.2
Ji,ji,ji... buena la cosa... "all you need is code"