Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Out of memory
Message
 
 
À
Tous
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Titre:
Out of memory
Versions des environnements
Visual FoxPro:
VFP 9
OS:
Windows XP SP2
Database:
Visual FoxPro
Divers
Thread ID:
01081364
Message ID:
01081364
Vues:
55
Hi everybody,

I'm trying to create PDF for 82K records. Bellow is a program. After running it for ~ 1h. it gets out of memory. Do you know, what could be wrong here? Thanks a lot in advance.
************************************************************
*  FUNCTION ConvertOldMemoToPDF()
************************************************************
*  Author............: Jzanus Dev Team   / Nadya Nosonovsky
*  Project...........: Visual Collections
*  Created...........: 04/27/2005  11:27:04
*  Copyright.........: (c) Jzanus LTD, 2005
*) Description.......:
*  Calling Samples...:
*  Parameter List....:
*  Major change list.:
function ConvertOldMemoToPDF()
local ltStart, ltEnd
ltStart = datetime()
set memowidth to 800
set talk off
set safety off

#define cClientDataDir "\\jzanusNT\VCS\Client_Tape_Data\"

#define cTextToPDFExe  cClientDataDir + "TxtToPDF.exe"
#define cTempDir "c:\Hospitals\"
#define cTempFile cTempDir + "TempFile.txt"

#define cnINFINITE 		0xFFFFFFFF
#define cnHalfASecond	500	&& milliseconds
#define cnTimedOut		0x0102
*	We need some API calls, declare here

*	GetCurrentProcess() returns the pseudohandle of the current process
declare integer GetCurrentProcess in WIN32API as GetCurrProc

*	WaitForIdleInput() waits until the target process is idle for input
declare integer WaitForInputIdle in WIN32API as WaitInpIdle ;
	integer nProcessHandle, ;
	integer nWaitForDuration

*	WaitForSingleObject() waits until the handle in parm 1 is signalled
*	or the timeout period expires
declare integer WaitForSingleObject in WIN32API as WaitOnAppExit ;
	integer hProcessHandle, ;
	integer dwTimeOut

*	This API call does the work.  The parameters are as follows:
*		lpszModuleName - ptr-> file name of module to execute.  Since we aren't launching .CPLs, do not use
*		lpszCommandLine - ptr-> command to execute, as passed to us
*		lpSecurityAttributesProcess - ptr-> SECURITY_ATTRIBUTES structure for Process.  Pass a null pointer
*		lpSecurityAttributesThread - ptr-> SECURITY_ATTRIBUTES structure for first thread.  Pass a null pointer
*		bInheritHandles - whether or not chlid inherits parent handles.  Since no SECURITY_ATTRIBUTES passed, default to FALSE
*		dwCreateFlags - Process Creation Mode flag set.  We use the default mode at normal priority, ie 0
*		lpvEnvironment	- ptr-> a set of environment strings as if a MULTI_SZ.  We don't set, so pass a null pointer
*		lpszStartupDir - ptr-> the starting directory.  If none provided to us, pass a null pointer
*		lpStartInfo - ptr-> a STARTUPINFO structure.  We use one structure member at times.
*		lpProcessInfo - ptr-> a PROCESS_INFORMATION structure, used to return PID/PHANDLE detail.
*						We use one member on return
declare SHORT CreateProcess in WIN32API as CrPr ;
	string lpszModuleName, ;
	string @lpszCommandLine, ;
	string lpSecurityAttributesProcess, ;
	string lpSecurityAttributesThread, ;
	SHORT bInheritHandles, ;
	integer dwCreateFlags, ;
	string lpvEnvironment, ;
	string lpszStartupDir, ;
	string @lpStartInfo, ;
	string @lpProcessInfo

set talk off

local laFile[1], lcFile, lnRecNo, lcStr, lnPos, lnLen, lcConv, oError, llOpen, llDeleteTag
if not directory(cTempDir)
	md (cTempDir)
endif

if adir(laFile, cTextToPDFExe) = 0 && Program is not found
	=ErrorMsg ("TextToPDF program is not found! " + chr(13) + "Please, download it from " + ;
		[http://www.adultpdf.com/products/txttopdf/help/index.html])
	return
endif
lcFile = "LastUsed.txt"
lcConv = 'Last Notes converted: '
if adir(laFile, m.lcFile) > 0
	lcStr = filetostr(m.lcFile)
	lnLen = len(m.lcConv)
	lnPos = at(m.lcConv, m.lcStr) + m.lnLen
	lnRecNo = val(substr(m.lcStr, m.lnPos))
else
	lnRecNo = 1
endif

close databases all
llOpen = .t.
try
	use  \\JZANUSNT\DATA1\FOX\OUTPAT\tData.dbf alias tData in 0 && regular
	use  \\JZANUSNT\DATA1\FOX\OUTPAT\atData.dbf alias atData in 0 && archived

	open database \\jzanus8\D$\\New_Data_Load\MMVisCollect
	use MMVisCollect!Client_Hospitals in 0 alias ClientsHosp order cCLIENTID
	use MMVisCollect!trans alias NewTrans in 0 && exclusive
	select NewTrans
	if tagno('cHospAcctD') > 0 && Tag already exists
		llDeleteTag = .f.
	else
		use in NewTrans
		use MMVisCollect!trans alias NewTrans in 0 exclusive
		select NewTrans
		wait window nowait "Wait while indexing Trans file"
		index on cHospAcctD tag cHospAcctD && Temp index
		wait clear
		llDeleteTag = .t.
	endif

	set order to cHospAcctD

catch to oError when .t.

	=messagebox("Error in opening tables!" + chr(13) + ;
		oError.message + chr(13) + ;
		"Error #:" + transform(oError.errorno) + chr(13) + ;
		"Line #:" + transform(oError.lineno) + chr(13) + ;
		"Error #:" + transform(oError.linecontents),48,"Error")
	llOpen = .f.
endtry

if m.llOpen

	set relation to NewTrans.cClient_Code into ClientsHosp additive

	local lcDir, lcOptions, lcParams, lcCommand
	lcOptions = [-pfs10 -plm10 -prm10 -ptm25 -pbm25 -pot -pps4]

	local lcSearch
	local lnReccount, lnRecNo, PrevOnEsc, PrevEscape, ;
		msgTail, lnCount, ProgBar, llExit, lnK, lcAlias
	private plHalt
* support user Escapes for interrupting the main loop
	PrevOnEsc = on('escape')				&& save previous Escape handler
	PrevEscape = set('escape')				&& previous Escape enablement state
	set escape on							&& enable escape handling
	plHalt = .f.							&& allow loop to run until this flag is toggled
	on escape plHalt = ;
		messagebox('Do you want to stop converting Client Notes to PDF process?',36,'Stop Program')=6	&& force immediate termination if user escapes

	oProgBar = newobject('ProgBar','progbar.vcx')
	oProgBar.SetTitle('Creating PDFs from Client Notes...')

	for  lnK = 1 to 2
		IF m.plHalt
			EXIT
		endif	
		lcAlias = iif(m.lnK = 1, 'tData', 'AtData')
		select(m.lcAlias)
		store 0 to lnCount
		lnReccount = max(reccount(), 0)
		do case
		case m.lnReccount<100 && Very rare case
			lnUpdateNumber=1
		case between(m.lnReccount,100,100000)
			lnUpdateNumber=100
		case m.lnReccount>100000
			lnUpdateNumber=val('1'+replicate('0',len(transform(m.lnReccount))-3))
		endcase

* assemble fixed portion of status bar message outside of loop, for speed
		msgTail = "/" + transform(m.lnReccount) + ".  Wait or press Esc to cancel ..."

		with m.oProgBar
			.SetMessage('File '+ dbf(m.lcAlias))
			.SetRange(0, m.lnReccount)
			.show()
		endwith

		scan for not lPDF
			if m.plHalt
				exit
			endif
			lnCount=m.lnCount+1
** Update status message
			if mod(m.lnCount,100) = 0
				set message to 'Record # '+ transform(m.lnCount) + m.msgTail
			endif
** Update thermometer
			if mod(m.lnCount,m.lnUpdateNumber) = 0
				oProgBar.SetPos(m.lnCount)
			endif

			lcSearch = cHospNum + cAcctNum + dtos(dDOS)

			if seek(m.lcSearch, 'NewTrans')	&& and found('ClientsHosp')
				if empty(ClientsHosp.cHospital_folder)
					loop
				else
					lcDir = cClientDataDir + alltrim(ClientsHosp.cHospital_folder)

					if not directory(m.lcDir)
						md (m.lcDir)
					endif

					lcPDF = addbs(m.lcDir) + alltrim(NewTrans.cClient_account_number)+ '.pdf'
					strtofile(mTapeData, cTempFile)

					lcParms = ' "' + cTempFile + '" "' + m.lcPDF + '" ' + m.lcOptions
					lcCommand = cTextToPDFExe + m.lcParms

					if LaunchAppAndWait(m.lcCommand,,"HIDE") <> 1
						plHalt = .t. && Problem
					else
						replace lPDF with .t. in (m.lcAlias)
					endif
				endif
			endif
		endscan
		=strtofile(m.lcConv + transform(recno()) + chr(13) + CHR(10),m.lcFile, 1) && Save last record converted
	next
	oProgBar.release()
	oProgBar = .null.
	release oProgBar
	on escape &PrevOnEsc
	if m.PrevEscape='OFF'
		set escape off
	endif
	set message to iif(m.plHalt,"Process interrupted...","Process completed...")
	ltEnd = datetime()
	=strtofile("The process of creating Client Notes started at " + ttoc(m.ltStart) + " and " + ;
		iif(m.plHalt, "was stopped at ", "ended at ") + ;
		ttoc(m.ltEnd) + chr(13) + chr(10) + ;
		"The elapsed time in seconds is " + transform(m.ltEnd-m.ltStart)+ " sec.",m.lcFile,1)
	=messagebox("The elapsed time in seconds is " + transform(m.ltEnd-m.ltStart)+ " sec.")
	select NewTrans
	if m.llDeleteTag
		delete tag cHospAcctD
	endif
endif
close databases all
endfunc

********************************************************************
*  Description.......: LaunchAppAndWait
*  Calling Samples...:
*				  lcDir=justpath(oJC.OutTable)
*				   if file('C:\MAILERS\MP4W32.exe')
*					   pStatus=LaunchAppAndWait('C:\MAILERS\MP4W32.exe',lcDir)
*				   else
*				      =messagebox('Can not find Mailers program!',48,'Error')
*				      pStatus=0
*				   endif
*  Parameter List....: tcCommandLine, tuFromDir, tcWindowMode
*  Created by........: Ed Rauh
*  Modified by.......:
********************************************************************
function LaunchAppAndWait
lparameters tcCommandLine, tuFromDir, tcWindowMode

*	tcCommandLine			(R) - command line to launch
*	tuFromDir				(O) - Run from directory (default - CWD)
*	tcWindowMode			(O)	- Start Application Window mode, one of (HIDE, MIN, MAX, NOR)
*								  (default - default setting of application)

*	Returns:
*	0 = CreateProcess didn't start what was asked
*	1 = Process ran to completion
*	-1= Process started but user aborted wait.  Danger - app is still running AFAIK

if type('m.tcCommandLine') # 'C'
*	Command line must be a character string
	return 0
endif

*DeclareDLLs() && Declare neccessary DLLs

if type('m.tuFromDir') # 'C'

*	If not a character string, pass a null pointer, defaulting to Current Working Dir
	tuFromDir = 0

else

*	Otherwise, null pad the string
	tuFromDir = tuFromDir + chr(0)

endif
if type('tcWindowMode') # 'C'

*	If not passed, set to null string
	tcWindowMode = ''

else

*	Translate the passed window mode to uppercase
	tcWindowMode = upper(tcWindowMode)

endif

local nStartedProcessHandle, uResult, cProcessInfo, cStartUpInfo

*	Make default Structures for the CreateProcess call
*
*	ProcessInfo - 4 bytes, a Process handle, a Thread Handle, a (DWORD) ProcessId and a (DWORD) ThreadID
*					we save the Process handle and return it to caller in tnReturnProcessHandle

cProcessInfo = replicate(chr(0),16)

*	StartUpInfo is a 68 byte long complex structure;  we either have 68 bytes with a cb member (byte 1) 68
*	or with cb of 68, dwFlag low order byte (byte 45) of 1, and low order byte wShowWindow (byte 49) set to
*	the SW_ value appropriate for the Window Mode desired.

do case
case tcWindowMode = 'HIDE'

*	Hide - use STARTF_USESHOWFLAG and value of 0
	cStartUpInfo = chr(68) + ;
		replicate(chr(0),43) + ;
		chr(1) + ;
		replicate(chr(0),23)

case tcWindowMode = 'NOR'

*	Normal - use STARTF_USESHOWFLAG and value of 1
	cStartUpInfo = chr(68) + ;
		replicate(chr(0),43) + ;
		chr(1) + ;
		replicate(chr(0),3) + ;
		chr(1) + ;
		replicate(chr(0),19)

case tcWindowMode = 'MIN'

*	Minimize - use STARTF_USESHOWFLAG and value of 2
	cStartUpInfo = chr(68) + ;
		replicate(chr(0),43) + ;
		chr(1) +  ;
		replicate(chr(0),3) + ;
		chr(2) + ;
		replicate(chr(0),19)

case tcWindowMode = 'MAX'

*	Maximize - use STARTF_USESHOWFLAG and value of 3
	cStartUpInfo = chr(68) + ;
		replicate(chr(0),43) + ;
		chr(1) +  ;
		replicate(chr(0),3) + ;
		chr(3) + ;
		replicate(chr(0),19)

*	Other options exist - see WINBASE.H for values

otherwise

*	Use default of application
	cStartUpInfo = chr(68) + replicate(chr(0),67)

endcase

*	Do it now!
uResult = CrPr(	0, ;
	tcCommandLine, ;
	0, 0, 0, 0, 0, ;
	tuFromDir, ;
	@cStartUpInfo, ;
	@cProcessInfo)

if uResult = 1

*	CreateProcess() started our app, but we have to wait until it finishes loading

*	Strip the process handle from the PROCESS_INFORMATION structure

	nStartedProcessHandle = (((asc(subst(cProcessInfo,4,1))*256) + ;
		asc(subst(cProcessInfo,3,1)))*256 + ;
		asc(subst(cProcessInfo,2,1)))*256 + ;
		asc(left(cProcessInfo,1))

*	It's been launched;  wait until we're idling along

	=WaitInpIdle(GetCurrProc(),cnINFINITE)

*	As long as the other process exists, wait for it

	do while WaitOnAppExit(nStartedProcessHandle, cnHalfASecond) = cnTimedOut

*	Give us an out in case the other app hangs - lets the user quit via
		if inkey() = 27
*	Still running but we aren't waiting - return a -1 as a warning
			uResult = -1
			exit
		endif

	enddo

else

*	Return 0 to indicate failure
	uResult = 0

endif
return uResult
If it's not broken, fix it until it is.


My Blog
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform