Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Memory leak?
Message
De
16/11/2004 15:42:14
 
 
À
16/11/2004 15:10:29
Information générale
Forum:
Visual FoxPro
Catégorie:
Client/serveur
Titre:
Versions des environnements
Visual FoxPro:
VFP 8 SP1
OS:
Windows 2000 SP3
Network:
Windows 2003 Server
Database:
MS SQL Server
Divers
Thread ID:
00961575
Message ID:
00961914
Vues:
7
Hi Aleksey

This is the code that execute from one of my applications screens:


-------------------------------------------------
When I need inserted , updated or delete one or several records from one or several cursoradapters, I called the method table_update , if the transaction is ok, the application execute the refrescar procedure, if something is wrong the application execute the Execption_error procedure and table_revert method. The problem is that the form suffer a continuos degradation of memory if a execute several times the refrescar procedure.
I even use the sys(1104) when I finish a transaction....

Do you have any ideas about how to improve this problem?.

Thank you for your help.

Carlos Miranda
MVP Visual Fox Pro

-------------------------------------------------------------
This is an example of the code called from one of my forms.
--------------------------------------------------------------
LPARAMETERS lcType
LOCAL m.llRetorno AS Logical
m.llRetorno = .F.
TRY
	IF THISFORM.invoice_details_transaction_conditions() =.T.
		THISFORM.lcbox_uq=ALLTRIM(vr_whouse_box_stock.unico)
		refrescar('vr_box')
		IF lcType = 'P'
			IF RECCOUNT('vr_box') > 0
				DO FORM &gcFormasFlores\ventas_invoice_boxes.scx WITH "Agregar" TO m.llRetorno
			ELSE
				MESSAGEBOX('You must to select a box from inventory. / Usted debe seleccionar una caja del inventario.',0+16,THISFORM.CAPTION)
			ENDIF
		ENDIF
		IF lcType = 'C'
			DO FORM &gcFormasFlores\ventas_invoice_charges.scx WITH "Agregar" TO m.llRetorno
		ENDIF
		THISFORM.SHOW()
		THISFORM.REFRESH()

		IF m.llRetorno= .T.
 			THISFORM.grabar()
			IF NOT THISFORM.table_update()
				THISFORM.Table_revert()
			ELSE
				THISFORM.Table_revert()
				THISFORM.refresh_invoice()
				THISFORM.refresh_customer()
				THIS.DETALLE1.AFTERROWCOLCHANGE()
			ENDIF
		ELSE
			THISFORM.Table_revert()
		ENDIF

	ENDIF

	THISFORM.REFRESH()

CATCH TO loException
	MESSAGEBOX(Exception_Error(loException),0+16,THISFORM.CAPTION)
FINALLY

ENDTRY
=============================================================
I have several methods in my form class the most important are table_update, table_revert, and the error function and refrescar funtion.


----------------------------refrescar-----------------------
Execute a controled requery of the form cursoradpaters
-========================================================
PROCEDURE Refrescar
PARAMETERS lcCursor AS CHARACTER
TRY
	IF REQUERY(lcCursor)=0
		= AERROR(aErrorArray)
		lcMsg=''
		FOR ln = 1 TO ALEN(aErrorArray,2)
			lcMsg = lcMsg + IIF(TRANSFORM(aErrorArray(1,ln))='.NULL.','',TRANSFORM(aErrorArray(1,ln))+ CHR(13))
		ENDFOR

		IF aErrorArray[1]=1545
			= TABLEREVERT(.T.,lcCursor)
			REQUERY(lcCursor)
		ENDIF
		
		THROW ALLTRIM(lcMsg )
	ENDIF
CATCH TO loException
	IF loException.ErrorNo=13
		MESSAGEBOX('Cursor '+ALLTRIM(lcCursor)+ ' doesn´t exist. / Cursor '+ALLTRIM(lcCursor)+' no existe.',0+16,gcTituloMensaje)
	ELSE
		MESSAGEBOX(Exception_Error(loException),0+16,gcTituloMensaje)
	ENDIF
FINALLY

ENDTRY
ENDPROC
<PRE>


--------------------------Exeception Error -----------------------------<PRE>
PROCEDURE Exception_Error
PARAMETERS loException AS EXCEPTION

IF loException.ErrorNo=5 OR loException.ErrorNo=52
	loException.Details=ALIAS(SELECT())
ENDIF

IF loException.ErrorNo=2071
	lcMessage='User Error :'+' '+loException.UserValue
ELSE
	lcMessage='System Error No: ('+ALLTRIM(STR(loException.ErrorNo))+')'
	lcMessage=lcMessage+CHR(10)+'Mensaje: '+loException.MESSAGE
	lcMessage=lcMessage+CHR(10)+'Detalles: '+loException.Details
	lcMessage=lcMessage+CHR(10)+'Contenido: '+loException.LineContents
	lcMessage=lcMessage+CHR(10)+'Procedimiento: '+loException.PROCEDURE
	lcMessage=lcMessage+CHR(10)+'Stack Level: '+STR(loException.StackLevel)
ENDIF
RETURN lcMessage
ENDPROC
------------------- table_update -------------------------
Execute a table updated of the all cursoradapter open in dataenvironment.
Each cursor has a odbc handle share connection. The connection of all my cursoradapter were adquired in the ambientedatos method

==================================================================
TRY
	m.llRetorno=.F.
	m.llReprocess = .F.
************/cursor que almacena todos los cursores del dataenvironment /******************
************/cursor to store all cursors in dataenvironment /******************

	CREATE CURSOR c_cursores (c_Alias c(100), BUFFER N(1),handle N(4),ODBCH N(10))
	CREATE CURSOR c_conecciones (c_Alias c(100), BUFFER N(1),handle N(4),ODBCH N(10))
************/arreglo que busca todo los objetos del dataenvironmet/******************
************/array to look for all objets in dataenvironmet/******************

	=AMEMBERS(aCursor,THISFORM.DATAENVIRONMENT,1)
	=ASORT(aCursor,1)
	nPosInic=ASUBSCRIPT(aCursor,ASCAN(aCursor,"Object"),1)

************/recorro el arreglo y guardo los cursores en el cursor c_cursores /******************
************/scan the array  and store the cursor objects in c_cursores /******************

	FOR nCount = nPosInic TO ALEN(aCursor,1)
**************/ verifica si es objeto/***********
**************/ check if it´s an object /***********
		IF aCursor(nCount,2)="Object"
			cObj="Thisform.DataEnvironment."+aCursor(nCount,1)
			loCursor=EVALUATE(cObj)
			cObjClass = loCursor.CLASS
			cObjAlias = loCursor.ALIAS
			IF loCursor.CLASS="Cursor" OR loCursor.CLASS="Cursoradapter" OR loCursor.CLASS="Ca_cursor"
				m.lnBuffer=CURSORGETPROP("Buffering",cObjAlias )
				m.lnHandle=CURSORGETPROP('ConnectHandle',cObjAlias )
				m.lnODBCH=SQLGETPROP(m.lnHandle,"ODBChdbc")
				SELECT c_cursores
				APPEND BLANK
				REPLACE c_cursores.c_Alias WITH  ALLTRIM(cObjAlias )
				REPLACE c_cursores.BUFFER WITH m.lnBuffer
				REPLACE c_cursores.handle WITH m.lnHandle
				REPLACE c_cursores.ODBCH WITH m.lnODBCH
			ENDIF
		ENDIF
	ENDFOR
*!*		m.lcDocXML=m.direccion_temporal+"\ca_cursores.xml"
*!*		CURSORTOXML('c_cursores',lcDocXML,1,512,0,"1")
****************/ Genero un cursor solo de las conecciones ODBCH abiertas /*************
****************/ create a cursor only with ODBCH opened connections /*************

	SELECT * FROM c_cursores GROUP BY c_cursores.ODBCH INTO CURSOR c_conecciones
	SELECT c_conecciones
****************/ Cambio el manejo de transacciones de las conecciones a manual /******************
****************/ Chagne the transactions conecctions handle to manual /******************
	SCAN
		SQLSETPROP(c_conecciones.handle, 'Transactions', 2)

**************/ Begin transactions es implìcito, pero si tengo SQL Server /**********
*****************/yo quisera hacer esto de manera explicita  *********

**************/ Begin transactions is implicit, but if I have SQL Server /**********
*****************/I would like to do in a explicit way  *********

		IF THISFORM.Tipo_vista='SQL'
*!*				SQLExec(c_conecciones.handle, 'SET TRANSACTION ISOLATION LEVEL READ UNCOMMITTED' )
			SQLExec(c_conecciones.handle, 'SET LOCK_TIMEOUT 500' )
			SQLExec(c_conecciones.handle, 'BEGIN TRANSACTION' )

		ENDIF
	ENDSCAN

	SELECT c_cursores

**************/ Busco los  cursores con  buffer = 5 /*************
**************/ I look up the cursors with buffer = 5 /*************

	SCAN FOR c_cursores.BUFFER=5
		m.lcCursor=ALLTRIM(c_cursores.c_Alias)
		SELECT &lcCursor
****************/ Actualizo los cursores /*************
****************/ Updated cursors /*************

		IF NOT TABLEUPDATE(1,.T.)
			= AERROR(aErrorArray)
***************/ si tengo un error/*************
****************/ If I have an error /*************

			IF aErrorArray[1]=1526
				IF aErrorArray[5]= 50000
					THROW "System Error: "+aErrorArray[3]
				ELSE
					IF aErrorArray[5] = 1222 OR aErrorArray[5] = 1205
						THROW "1222-1205"
					ELSE
						THROW aErrorArray[3]+" Error # : "+ALLTRIM(STR(aErrorArray[5]))+"(1) El error se originó actualizando: "+m.lcCursor
					ENDIF
				ENDIF
			ELSE
				THROW aErrorArray[2]+"(1) El error se originó actualizando: "+m.lcCursor
			ENDIF
		ENDIF
	ENDSCAN

****************/ Hago commit de todas las transacciones abiertas /*************
****************/ Commit all open transations /*************

	SELECT c_conecciones
	SCAN
		IF THISFORM.Tipo_vista='SQL'
			m.lnCommit=SQLExec( c_conecciones.handle, 'IF @@TRANCOUNT > 0 COMMIT' )
		ELSE
			m.lnCommit=SQLCOMMIT(c_conecciones.handle)
		ENDIF
		IF m.lnCommit=-1
			THROW "Transacción no se pudo actualizar"
		ENDIF
	ENDSCAN

	m.llRetorno = .T.


CATCH TO loException
****************/ Si ocurre un error hago  rollback a todas las  transcciones /*************
****************/ If an error happend rollback all transctions /*************

	SELECT c_conecciones
	SCAN
		IF THISFORM.Tipo_vista='SQL'
			=SQLExec( c_conecciones.handle, 'IF @@TRANCOUNT > 0 ROLLBACK' )
		ELSE
			=SQLROLLBACK(c_conecciones.handle)
		ENDIF
	ENDSCAN

	IF loException.UserValue='1222-1205'
		m.llReprocess = .T.
	ELSE
		MESSAGEBOX(Exception_Error(loException),0+16,THISFORM.CAPTION)
	ENDIF
	m.llRetorno = .F.

FINALLY
****************/ Regreso las  transcciones a manejo automatico   /*************
****************/ Return all transctions to automatic handle  /*************

	SELECT c_conecciones
	SCAN
		=SQLSETPROP(c_conecciones.handle, 'Transactions', 1)
	ENDSCAN
ENDTRY

IF m.llReprocess = .T.
	THIS.table_update()
ELSE
	RETURN m.llRetorno
ENDIF
---------------------Table_revert -------------------------
Execute a table revert of the all cursoradapter open in dataenvironment when the table_update method return .F.
==================================================================
TRY

	CREATE CURSOR c_cursores (c_Alias c(100), BUFFER N(1),handle N(4),ODBCH N(10))

************/arreglo que busca todo los objetos del dataenvironmet/******************
************/array to look for all objets in dataenvironmet/******************

	=AMEMBERS(aCursor,THISFORM.DATAENVIRONMENT,1)
	=ASORT(aCursor,1)
	nPosInic=ASUBSCRIPT(aCursor,ASCAN(aCursor,"Object"),1)

************/recorro el arreglo y guardo los cursores en el cursor c_cursores /******************
************/scan the array  and store the cursor objects in c_cursores /******************

	FOR nCount = nPosInic TO ALEN(aCursor,1)
**************/ verifica si es objeto/***********
**************/ check if it´s an object /***********

		IF aCursor(nCount,2)="Object"
			cObj="Thisform.DataEnvironment."+aCursor(nCount,1)
			loCursor=EVALUATE(cObj)
			cObjClass = loCursor.CLASS
			cObjAlias = loCursor.ALIAS
			IF loCursor.CLASS="Cursor" OR loCursor.CLASS="Cursoradapter" OR loCursor.CLASS="Ca_cursor"
				m.lnBuffer=CURSORGETPROP("Buffering",cObjAlias )
				m.lnHandle=CURSORGETPROP('ConnectHandle',cObjAlias )
				m.lnODBCH=SQLGETPROP(m.lnHandle,"ODBChdbc")
				SELECT c_cursores
				APPEND BLANK
				REPLACE c_cursores.c_Alias WITH  ALLTRIM(cObjAlias )
				REPLACE c_cursores.BUFFER WITH m.lnBuffer
				REPLACE c_cursores.handle WITH m.lnHandle
				REPLACE c_cursores.ODBCH WITH m.lnODBCH
			ENDIF
		ENDIF
	ENDFOR

	SELECT c_cursores

**************/ Busco los  cursores con  buffer = 5 /*************
**************/ I look up the cursors with buffer = 5 /*************

	SCAN FOR (c_cursores.BUFFER=5 OR c_cursores.BUFFER=3)
		m.lcCursor=ALLTRIM(c_cursores.c_Alias)
		SELECT &lcCursor
****************/ Revierto todos los cursores /*************
****************/ Revert the  cursors /*************
		= TABLEREVERT(.T.)
	ENDSCAN

	THISFORM.REFRESH
CATCH TO loException
	MESSAGEBOX(Exception_Error(loException),0+16,THISFORM.CAPTION)
FINALLY

ENDTRY
------------------ambientedatos method -------------------------
This method is called from the load event.
==========================================================
TRY
	m.lnseconds = 0
	m.lntotseconds = 0
*********************/ Funcion dataenvironment /**************

***************/Obtener la nueva coneccion de trabajo/*******************


	IF THISFORM.coneccion_handle > 0
		=AMEMBERS(aCursor,THISFORM.DATAENVIRONMENT,1)
		=ASORT(aCursor,1)
		nPosInic=ASUBSCRIPT(aCursor,ASCAN(aCursor,"Object"),1)

		FOR nCount = nPosInic TO ALEN(aCursor,1)
**************/ verifica si es objeto/***********
			IF aCursor(nCount,2)="Object"
				cObj="Thisform.DataEnvironment."+aCursor(nCount,1)
				loCursor=EVALUATE(cObj)
				cObjClass = loCursor.CLASS
				cObjAlias = loCursor.ALIAS
				IF loCursor.CLASS="Cursoradapter" OR loCursor.CLASS="Ca_cursor"
					m.lnNewHandle=SQLCONNECT(THISFORM.coneccion_handle)
					loCursor.PREPARED=.T.
					loCursor.DATASOURCETYPE="ODBC"
					loCursor.DATASOURCE = m.lnNewHandle

					m.lnseconds = SECONDS()

					IF loCursor.CURSORFILL()
						lcAlias=ALLTRIM(loCursor.ALIAS)
						i= AFIELDS(A_CAMPOS,lcAlias)
						lcTables=loCursor.TABLES
						m.lcUList=''
						m.lcNList=''
						m.lcSqhema=''
						FOR N=1 TO i
							m.lcUList=A_CAMPOS(N,1)+','+m.lcUList
							m.lcNList=A_CAMPOS(N,1)+' '+lcTables+'.'+A_CAMPOS(N,1)+','+m.lcNList
							m.lcSqhema=A_CAMPOS(N,1)+' '+A_CAMPOS(N,2)+'('+ALLTRIM(STR(A_CAMPOS(N,3)))+','+ALLTRIM(STR(A_CAMPOS(N,4)))+'),'+m.lcSqhema
						ENDFOR
						loCursor.CURSORSCHEMA=LEFT(lcSqhema,LEN(lcSqhema)-1)
						IF loCursor.SENDUPDATES=.T.
							loCursor.UPDATABLEFIELDLIST=LEFT(lcUList,LEN(lcUList)-1)
							loCursor.UPDATENAMELIST=LEFT(lcNList,LEN(lcNList)-1)
						ENDIF
						m.lnseconds = SECONDS()-m.lnseconds
						m.lntotseconds = m.lntotseconds + m.lnseconds
						IF THISFORM.lltest = .T.
							MESSAGEBOX(loCursor.ALIAS + ' - '+ALLTRIM(STR(lnseconds,6,4)))
						ENDIF
					ELSE
						MESSAGEBOX(loCursor.ALIAS+" Hasn't been loaded",0+64,'Dataenvironment '+THISFORM.CAPTION)
					ENDIF
				ENDIF
			ELSE
				EXIT
			ENDIF
		ENDFOR
	ELSE
		THROW = 'No connection with database / No hay conección a la base de datos'
	ENDIF
	IF THISFORM.lltest = .T.
		MESSAGEBOX('TOTAL : '+ALLTRIM(STR(m.lntotseconds,6,4)))
	ENDIF
CATCH TO loException
	MESSAGEBOX(Exception_Error(loException),0+16,'Dataenvironment '+THISFORM.CAPTION)
FINALLY

ENDTRY
Carlos A. Miranda
E.I.S.lnc
President
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform