Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Default Printer hardcoded in report
Message
From
09/07/1999 01:50:04
 
 
To
08/07/1999 21:40:25
General information
Forum:
Visual FoxPro
Category:
Reports & Report designer
Miscellaneous
Thread ID:
00239000
Message ID:
00239280
Views:
10
(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
Map
View

Click here to load this message in the networking platform