Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
VFP and Crystal and ODBC equals bad combination?
Message
General information
Forum:
Visual FoxPro
Category:
Third party products
Miscellaneous
Thread ID:
00619319
Message ID:
00619908
Views:
46
This message has been marked as a message which has helped to the initial question of the thread.
Hi steve,
I use this code to pass the views contained ins my dbc and to
pass them by connection ODBC to hook carryforward. This is very fast!
VFP and crystal report 8 work together without employing native
tables fox2.

*----------------------------------------------------------------------------------------------------------
*-- CLASSE DE BASE DES IMPRESSIONS SOUS CRYSTAL REPORT 8.
*-- (c) MILCENT B. 2001 Support@Amline.Be 04/379.29.38 EXT.10
*-- Support@Amline.be
DEFINE CLASS CrystalReportEnvironment AS cContainer
PROTECTED cLocation ,;
cReportName,;
lcConStrOdbc

lcConStrOdbc = ""
ctitle = ""
*-- endroit des tables dbf
cLocation = SYS(5) + CURDIR() + "ReportsCrystal\"
cReportName = ""
nDataSessionId = 0
oRpt = .NULL.


DisplayBackgroundEdge = .T.
*-- Gets or sets whether the border of the viewer object is displayed. Read/Write
DisplayGroupTree = .T.
*-- Gets or sets the visibility of the group tree. Read/Write
DisplayTabs = .T.
*-- Gets or sets whether the viewer has tabs for navigation between views. Read/Write
DisplayToolbar = .T.
*-- Gets or sets the visibility of the toolbar. Read/Write
EnableAnimationCtrl = .F.
*-- Gets or sets whether or not the animation control is visible. Read/Write
EnableCloseButton = .F.
*-- Gets or sets the visibility of the close button. Read/Write
EnableDrillDown = .T.
*-- Gets or sets whether drill down is allowed. Read/Write
EnableExportButton = .F.
*-- Gets or sets the visibility of the Export toolbar button. Read/Write
EnableGroupTree = .T.
*-- Gets or sets whether or not the group tree is available. Read/Write
EnableHelpButton = .F.
*-- Gets or sets whether or not the group tree is available. Read/Write
EnableNavigationControls= .T.
*-- Gets or sets whether or not the help button appears on the toolbar. Read/Write
EnablePopupMenu = .T.
*-- Gets or sets whether the popup menu is available. Design-time only. Read/Write
EnablePrintButton= .T.
*-- Gets or sets the visibility of the Print button. Read/Write
EnableProgressControl= .T.
*-- Gets or sets the visibility of the progress control. Read/Write
EnableRefreshButton = .F.
*-- Gets or sets the visibility of the Refresh button. Read/Write
EnableSearchControl = .T.
*-- Gets or sets the visibility of the search control. Read/Write
EnableSearchExpertButton= .T.
*-- Gets or sets the status of the Search Expert toolbar button. Read/Write
EnableSelectExpertButton= .T.
*-- Gets or sets the status of the Select Expert toolbar button. Read/Write
EnableStopButton= .T.
*-- Gets or sets whether the viewer displays the stop button. Read/Write
EnableToolbar= .T.
*-- Gets or sets the visibility of the toolbar. Read/Write
EnableZoomControl= .T.
*-- Gets or sets the visibility of the zoom control. Read/Write

*-------------------------
FUNCTION INIT( ndatasession )

LOCAL lnCursor,;
oSubReport,;
rptObject,;
Sect,;
dbtable,;
loCon,;
lcConStr,;
cvAlias,;
VP_ToSearchIn,;
oRecordset,;
lcSQL,;
oCursor


loCon = NEWOBJECT("ADODB.Connection")

*-- VFP 6 !!!!!
IF EMPTY( THIS.lcConStrOdbc )
*-- Connection modifiée 11/08/2001
lcConStr = "DRIVER=Microsoft Visual FoxPro Driver;DSN=Amline 2.0;UID=;" + ;
"SourceDB=" + goapp.cdefaultdirectory + ;
"AMLINE.DBC;SourceType=DBC;Exclusive=Non;BackgroundFetch=Oui;Collate=Machine;Null=Oui;Deleted=Oui;"
ELSE
lcConStr = THIS.lcConStrOdbc
ENDIF
* 01/11/2001 Deleted=Oui car on avait les records marqués pour effacement !

loCon.OPEN( lcConStr )
VP_ToSearchIn = "goapp.VP_ToSearchIn"

IF VARTYPE( THIS.acursors[ 1 ] ) == "C"
FOR lnCursor = 1 TO ALEN( THIS.acursors , 1 )
THIS.ADDOBJECT("o" + THIS.acursors[ lnCursor ], THIS.acursors[ lnCursor ] )

oCursor = EVAL( "this.o" + THIS.acursors[ lnCursor ] )
*-----------------------------------------------------------------
*-- Il y a peut être des vues ou des tables que l'on ne veut pas
*-- importer ds crystalreport.
IF VART( oCursor ) == "O" AND oCursor.l_cr_Put_In_Ado_cursor = .T.
*--------------------------------------------------------------
*-- Le codebook enlève le 'L' de la vue pr les vues locales.
*-- La connection va ouvrir la vue contenue ds le dbc qui garde son 'L'

cvAlias = IIF( SUBS( UPPER( THIS.acursors[ lnCursor ] ) , 1 , 2 ) = "V_" , 'L' , '' ) + ;
oCursor.ccursorsource
oRecordset =.NULL.
oRecordset = CREATEOBJECT( "adodb.recordset" )

WITH oRecordset
.Activeconnection = loCon
*-- 19/08/2001 La propriété Source est une chaine de caractère ne pouvant
*-- Pas dépasser une longueur limite
.SOURCE = "SELECT * FROM " + cvAlias +;
IIF( !EMPTY( oCursor.cFiltre ) , " Where " + oCursor.cFiltre , "" )

.CursorType = adOpenStatic && 3
.LockType = adLockReadOnly && 1
.CursorLocation = adUseClient && 3
.OPEN()

oCursor.oRecordset = oRecordset
*-----------------------------------------------------------
*-- Si le recordset n'est pas instantié on imprime pas !
IF VART( oRecordset ) <> "O"
*--------------------------------------------------------
=ERRORMsg("Connection aux données impossible !")
RETURN .F.
ELSE
*--------------------------------------------------------
*-- Le PREMIER curseur doit toujours contenir des fiches.
IF lnCursor = 1
*THIS.AfficheContenu( oRecordset )
IF .recordcount < 1
=ERRORMsg("Pas de fiche à imprimer !")
RETURN .F.
ENDIF
ENDIF
ENDIF
ENDWITH
ENDIF
ENDFOR
ENDIF

IF VART( ndatasession ) == "N" AND ndatasession > 0
THIS.nDataSessionId = ndatasession
ENDIF


THIS.crystal( THIS.cReportName )
*-- 27/12/2001 Bug ! dans la version multi société
*-- la connection n'était pas fermée et on gardait la Iere Connection.


*---------------------------------------------- 18/09/01
* il est impératif de laisser ce code car un bug
* important existait.
* la connexion n'était pas fermée et le nombre de records
* fluctuait suivant le premier rapport.
FOR lnCursor = 1 TO ALEN( THIS.acursors , 1)
oCursor = EVAL( "this.o" + THIS.acursors[ lnCursor ] )
IF VART( oCursor.oRecordset.Activeconnection ) == "O"
oCursor.oRecordset.Activeconnection = .NULL.
ENDIF
oCursor.oRecordset = .NULL.

THIS.acursors[ lnCursor ] = .NULL.
ENDFOR

oRecordset = .NULL.
loCon = .NULL.
THIS.oRpt = .NULL.
CLOSE DATA ALL && 18/09/2001
THIS.RELEASE()
ENDFUNC

*-- 02/05/2001-----------------------------------------------------------------------
PROTECTED FUNCTION BeforeRequery()
ENDFUNC

*------------------------------------------------------------------------------------
*--- ENVIRONMENT ADO DE CRYSTAL
PROTECTED FUNCTION REQUERY()

LOCAL lnCursor,;
oSubReport,;
rptObject,;
Sect,;
dbtable,;
lcConStr,;
cvAlias,;
oRecordset,;
oCursor


THIS.BeforeRequery()

FOR lnCursor = 1 TO ALEN( THIS.acursors , 1)
oCursor = EVAL( "this.o" + THIS.acursors[ lnCursor ] )
*-----------------------------------------------------------------
*-- Il y a peut être des vues ou des tables que l'on ne veut pas
*-- importer ds crystalreport.
IF VART( oCursor ) == "O" AND oCursor.l_cr_Put_In_Ado_cursor = .T.
*---------------------------------------------------------------

*-- Si c'est pour un rapport( à l'inverse d'un subrapport ).
oRecordset = oCursor.oRecordset
IF EMPTY( oCursor.cCrystalSubReportName )
*------------------------------------------------------------
*---- ATTENTION
THIS.oRpt.DATABASE.setDataSource( oRecordset , 3 , lnCursor )

ELSE && *-- Si c'est pour un subreport...
*-- Passons toutes les sections
FOR EACH Sect IN THIS.oRpt.sections
*-- Passons tous les objets.( crSubreportObject , crCrossObjects etc...
FOR EACH rptObject IN Sect.ReportObjects
*----------------------------------------------------------------------
*-- Si c'est un sous rapport.
IF rptObject.kind = 5 && crSubreportObject crSubReportObject ...
*-- ouvrir le sous rapport comme un rapport.
oSubReport = rptObject.OpenSubreport()
*-- Passons toutes les tables ou curseur.
FOR EACH dbtable IN oSubReport.DATABASE.TABLES
*-- Il faut que la table ait le même nom que oCursor.cCrystalSubReportName.
*-- autrement dit il faut bien synchroniser les propriéts.
*WAIT WIND dbtable.NAME
IF UPPER( ALLTR( dbtable.NAME )) = ;
UPPER( ALLTR( oCursor.cCrystalSubReportName ))
*WAIT WIND
dbtable.setDataSource( oRecordset , 3 )
ENDIF
NEXT
ENDIF
NEXT
NEXT
ENDIF
ENDIF
ENDFOR

*-- ATTENTION
THIS.oRpt.readRecords
THIS.afterRequery()
dbtable = .NULL.
orecorset = .NULL.
Sect = .NULL.
rptObject = .NULL.
oSubReport = .NULL.
ENDFUNC

*------------------------
PROTECTED FUNCTION crystal( cNomReport )
*-- Inspiré de FOXTALK qui emploit des tables indépendantes.
*-- remis en cause pour :
*-- Perte des noms longs.
*-- Perte de performance.
*-- Crystal "explose" ds des rapports hyper complexes
*-- qui utilise bcq de ressources.

* cNomReport = Fully pathed Crystal report to run
* V_TABLE = Fully pathed Fox 2X table to use
* V_OUTFILE = Fully pathed Output file name
* V_OUTTYPE = Output type (0 is preview)

LOCAL crApp ,;
crReport,;
lnCursor,;
oCursor

*---------------------------------------------------------------------
IF FILE( cNomReport )
*---------------------------------------------------------------------
*-- Attention avant .....17/01/02.
crApp = CREATEOBJECT( "Crystalruntime.Application.8" )
*-- Ceci ds la gestion des erreurs !!!!!!!!

IF VART( crApp ) <> "O"
=ERRORMsg(" Crystal Report ( crApp ) est mal installé !" + CR +;
"Contacter le support technique...." )
RETURN .F.
ENDIF

STORE crApp.openReport( cNomReport ) TO crReport , THIS.oRpt

IF VART( crReport ) <> "O"
=ERRORMsg(" Impossible d'ouvrir le rapport " + cNomReport + "!" + CR +;
"Contacter le support technique...." )
RETURN .F.
ENDIF



IF THIS.REQUERY() = .F.
crApp = .NULL.
crReport = .NULL.
RETURN .F.
ENDIF

* THIS.oRpt.MorePrintEngineErrorMessages = .F.
*THIS.oRpt.EnableParameterPrompting = .F.


*-- DiscardSavedData indicates whether or not the data that
*-- is saved with a report should be discarded.
THIS.oRpt.DiscardSavedData()


*-- C'est ici qu'on modifie les sélection champs calculé.
THIS.BeforePrint()

*-- titre du rapport
IF !EMPTY( THIS.ctitle )
THIS.oRpt.ReportTitle = THIS.ctitle
ENDIF

*-- 02/11/2001 La fenêtre N' est PLUS modale.
=DOFORM( "CrystalVieewerForm" , THIS )
crApp = .NULL.
crReport = .NULL.
THIS.oRpt = .NULL.

ELSE
=MESSAGEBOX("Le rapport " + cNomReport + " est inexistant !",48,"Amline -CrystFox")
ENDIF
ENDFUNC

*----------------------------------------------------------------------------
PROTECTED FUNCTION afterRequery()
ENDFUNC
*----------------------------------------------------------------------------

PROTECTED FUNCTION BeforePrint()
ENDFUNC


*-- Remplit ds crystal le mois de début et de fin .
PROTECTED FUNCTION Date_Debut_Fin ( nMoisDebut , nAnDebut , nMoisFin , nAnFin )
LOCAL crxformulafields,;
crxformulafield

crxformulafields = THIS.oRpt.formulafields

FOR EACH crxformulafield IN crxformulafields
DO CASE
*-- GENIAL , On passe une date !
CASE crxformulafield.NAME = "{@ddebut}"
crxformulafield.TEXT = "CDATE(" + ALLTR( STR( nAnDebut )) + ',' + ;
ALLTR(STR( nMoisDebut )) + ",1)"

CASE crxformulafield.NAME = "{@dfin}"
crxformulafield.TEXT = "CDATE(" + ALLTR( STR( nAnFin )) + ',' + ;
ALLTR(STR( nMoisFin )) + ",1)"

ENDCASE
NEXT
ENDFUN
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform