************************************************************ * 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