General information
Category:
Reports & Report designer
(snip)
PMFJI: Your program pretty much does what has been published by several others, including FPA. I took the NukeFRXPrintInfo program by Jim Haentzschel, and added some code to make it only drop the parts that should be removed. I also added some #define's to make it more version independent (ie: FP-2.x)...
At the risk of too long a response, the code is shown below:
*:*****************************************************************************
*:
*: Procedure file: D:\PRG_INS\FRX0PRTR.PRG
*:
*: System: NukeFRXPrintInfo (Frx0Prtr) - remove prt
*: Author: Jim Haentzschel & rbs
*: Copyright (c) 1999, FPA & CREATIVE RESOURCES
*: Last modified: 02/10/99 7:39
*:
*: Procs & Fncts: LISTREPORTS
*:
*: Calls: LISTREPORTS (procedure in FRX0PRTR.PRG)
*:
*: Documented 02/10/99 at 07:39 FoxDoc version 2.10f
*:*****************************************************************************
*******************************************************************************
* NukeFRXPrintInfo.Prg - from FPAdvisor Feb. 1999
* Author: Jim Haentzschel
*
* This program recursively goes down from the directory
* tree from wherever you start it and removes the TAG and TAG2
* printer information, if any is found.
*
* For VFP 3/5/6 due to use of 'local' keyword
*
* Parameters: tcAction
* tcRecur
*
* Actions taken: tcAction = (blank/null) ==> 'safe' mode - show the
* FRXs that have print info
* but don't change it...
* "CLEAN" ==> okay to replace TAG and TAG2 with
* Space(0)
* tcRecur = "R" ==> recurse directories
*
* Calling Samples: DO NukeFRXPrintInfo (ie: safe mode, no recurse)
* DO NukeFRXPrintInfo WITH "SAFE", "R"
* displays all FRXs with embedded print info
* from the starting directory down (recursively),
* but does not make any changes
* DO NukeFRXPrintInfo WITH "CLEAN", "R"
* displays *AND* replaces TAG and TAG2 fields
* (in first record of all FRXs) with Space(0),
* from the starting directory down (recursively),
*
* rev. 99-02-09 - rbs - PROC ListReports - Fld: EXPR may contain paper
* orientation, papersize, and other stuff that is
* NOT good to delete/erase - so beware...
* - #DEFINE/#IF/#ELSE/#ENDIF - for version handling...
*******************************************************************************
#IF [VISUAL] $ UPPER(VERSION())
LPARAMETERS tcAction, tcRecur
#ELSE
PARAMETERS tcAction, tcRecur
#ENDIF
* define a variable/constant to use in #if/#else/#endif later...
#DEFINE L_IS_VFP [VISUAL] $ UPPER(VERSION())
* set cpdialog off to keep codepage dialogs
* from interrupting the program...
#IF L_IS_VFP
LOCAL lcCpDialog, lcTalk
#ELSE
PRIVATE lcCpDialog, lcTalk
#ENDIF
IF SET("TALK") = "ON"
SET TALK OFF
lcTalk = "ON"
ELSE
lcTalk = "OFF"
ENDIF
lcCpDialog = SET("cpdialog")
IF lcCpDialog = "ON"
SET CPDIALOG OFF
ENDIF
IF PARAMETERS() = 0
* was this parameter not passed?
* take conservative approach - 'safe' mode
#IF L_IS_VFP
LOCAL tcAction, tcRecur
#ELSE
PRIVATE tcAction, tcRecur
#ENDIF
tcAction = "SAFE"
tcRecur = ""
ENDIF
IF TYPE("tcRecur") <> "C"
* ie: if no 2nd parameter - assume no recursion
tcRecur = ""
ENDIF
#IF L_IS_VFP
LOCAL lcExact
#ELSE
PRIVATE lcExact
#ENDIF
lcExact = SET("Exact")
SET EXACT ON
#IF L_IS_VFP
LOCAL ARRAY tArray[1000], FrxArray[1]
#ELSE
DIMENSION tArray[1000], FrxArray[1]
#ENDIF
#IF L_IS_VFP
LOCAL lnCount
#ELSE
PRIVATE lnCount
#ENDIF
* how many items in this directory?
lnCount = ADIR(tArray, "*.*", "D")
* loop through the array - this recursion does not work in fp26
#IF L_IS_VFP
LOCAL xx, nMaxArray
IF UPPER(tcRecur) = "R"
nMaxArray = ALEN(tArray, 1)
FOR xx = 1 TO nMaxArray
* skip the '.' and '..' directories
IF ( SUBSTR(tArray[xx,5], 5, 1) = "D" .AND. ;
.NOT. ("." $ tArray[xx,1]) )
*
? SYS(5) + CURDIR() + tArray[xx, 1]
CD (tArray[xx, 1])
*
* get an FRX listing for this directory
*
=ListReports(tcAction)
*
* recursive call to go down to the next lower level
DO ( PROGRAM(0) ) WITH tcAction, tcRecur
*
CD ..
ENDIF
ENDFOR
ELSE
* only one directory of interest
=ListReports(tcAction)
ENDIF
#ELSE
* only one directory of interest
WAIT WINDOW [Sorry! Cannot Recurse as written in this version of FoxPro]
=ListReports(tcAction)
#ENDIF
* restore environmental settings...
SET CPDIALOG &lcCpDialog.
SET EXACT &lcExact.
SET TALK &lcTalk.
RETURN
* - eof - PROCEDURE NukeFRXPrintInfo - main routine
*******************************************************************************
*!*****************************************************************************
*!
*! Procedure: LISTREPORTS
*!
*! Called by: FRX0PRTR.PRG
*!
*!*****************************************************************************
PROCEDURE ListReports
*
* Now find out how many FRXs (reports) have
* printer info stuffed into their TAG and TAG2 fiels.
* The problem here is that FoxPro stuffs printer-specific
* stuff into the FRX in Record-1 that will make a report
* not run correctly on a different type of printer
*
* rbs note: Fld: EXPR may contain paper orientation, papersize,
* and other stuff that is NOT good to delete/erase - so beware...
*******************************************************************************
PARAMETERS tcAction
#IF L_IS_VFP
LOCAL lnNumFound, yy, lcFrx2Chk
#ELSE
PRIVATE lnNumFound, yy, lcFrx2Chk
#ENDIF
#IF L_IS_VFP
LOCAL ARRAY FrxArray[1]
#ELSE
DIMENSION FrxArray[1]
#ENDIF
* first make sure there are some FRXs in this directory
lnNumFound = ADIR(FrxArray, "*.FRX")
IF (lnNumFound > 0)
FOR yy = 1 TO ALEN(FrxArray, 1)
*
* open each report as a table and see if TAG and TAG2
* fields are empty. If not, empty them...
*
lcFrx2Chk = FrxArray[yy, 1]
WAIT WINDOW "Now checking: " + lcFrx2Chk NOWAIT
USE (lcFrx2Chk) ALIAS Frx2Chk EXCLUSIVE
LOCATE && ie: Go Top
IF .NOT. EMPTY(Frx2Chk.EXPR)
? lcFrx2Chk + " " + CHR(13)
IF UPPER(tcAction) = "CLEAN"
? " ...Cleaning -->"
* rbs note: you may not want to just wipe this fld out...
*REPLACE Frx2Chk.EXPR WITH SPACE(0)
REPLACE Frx2Chk.EXPR WITH STRTRAN(Frx2Chk.EXPR, [DEVICE], [*DEVICE])
REPLACE Frx2Chk.EXPR WITH STRTRAN(Frx2Chk.EXPR, [DRIVER], [*DRIVER])
REPLACE Frx2Chk.EXPR WITH STRTRAN(Frx2Chk.EXPR, [OUTPUT], [*OUTPUT])
REPLACE Frx2Chk.EXPR WITH STRTRAN(Frx2Chk.EXPR, [DEFAULT], [*DEFAULT])
REPLACE Frx2Chk.EXPR WITH STRTRAN(Frx2Chk.EXPR, [PRINTQUALITY], [*PRINTQUALITY])
REPLACE Frx2Chk.EXPR WITH STRTRAN(Frx2Chk.EXPR, [YRESOLUTION], [*YRESOLUTION])
REPLACE Frx2Chk.EXPR WITH STRTRAN(Frx2Chk.EXPR, [TTOPTION], [*TTOPTION])
?? " Cleaned!"
ENDIF
ENDIF
*
IF .NOT. EMPTY(Frx2Chk.TAG)
? lcFrx2Chk + " " + CHR(13)
IF UPPER(tcAction) = "CLEAN"
? " ...Cleaning -->"
REPLACE Frx2Chk.TAG WITH SPACE(0)
?? " Cleaned!"
ENDIF
ENDIF
*
IF .NOT. EMPTY(Frx2Chk.Tag2)
? lcFrx2Chk + " " + CHR(13)
IF UPPER(tcAction) = "CLEAN"
? " ...Cleaning -->"
REPLACE Frx2Chk.Tag2 WITH SPACE(0)
?? " Cleaned!"
ENDIF
ENDIF
* now pack to be sure you don't get memofld bloat...
IF UPPER(tcAction) = "CLEAN"
PACK
ENDIF
* close the report (.frx)...
IF USED([Frx2Chk])
USE IN Frx2Chk
ENDIF
WAIT CLEAR
ENDFOR
ENDIF
RELEASE ARRAY FrxArray
RETURN
* - eof - PROCEDURE ListReports
*******************************************************************************
* - eof - NukeFRXPrintInfo.Prg
*******************************************************************************
*: EOF: FRX0PRTR.PRG
HTH
Rob
Previous
Next
Reply
View the map of this thread
View the map of this thread starting from this message only
View all messages of this thread
View all messages of this thread starting from this message only