home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
xbase
/
library
/
fox
/
db2doc
/
db2doc.prg
Wrap
Text File
|
1991-08-28
|
37KB
|
920 lines
* ╓───────────────────────────────────────────────────────────────────────╖
* ║ DB2DOC.PRG - Automatic DBF file documentation for FoxBASE+ and FoxPro ║
* ║ Version 2.1 8/28/1991 ║
* ╙───────────────────────────────────────────────────────────────────────╜
* ╓─────────────────────────────────╖
* ║ SOFTWARE LICENSE AGREEMENT ║
* ╙─────────────────────────────────╜
* DB2DOC is not public domain or free software. If you
* continue using DB2DOC after a 30 day trial period, you
* must register for a license to use DB2DOC.
* To register, send $10 (Ten dollars U.S.) directly to the
* author: (90 day unconditional money back guarantee)
* Carlos Berguido Inquiries:
* 1722 Capella Court Voice phone 707 / 762-9067
* Petaluma, CA 94954 Compuserve 72411,1071
* Please include your name, address, and DB2DOC version
* number. You will receive the latest version of DB2DOC
* INCLUDING ALL SOURCE CODE on a 5¼ inch diskette.
* DB2DOC.PRG is a "shareware program" and is provided at no charge
* to the user for evaluation. Feel free to share it with your
* friends, but please do not give it away altered or as part of
* another system. The essence of "user-supported" software is to
* provide personal computer users with quality software without
* high prices, and yet to provide incentive for programmers to
* continue to develop new products.
* If you find this program useful and find that you are using
* DB2DOC and continue to use DB2DOC after a 30 day trial period,
* you must make a registration payment of $10.00 to Carlos
* Berguido. The $10.00 registration fee will license one copy for
* use on any one computer at any one time.
* You must treat this software just like a book. For example, this
* software may be used by any number of people and may be freely
* moved from one computer location to another. However, two or
* more computers must not be running DB2DOC at the same time with
* only a single registration, just as one copy of a book cannot be
* read by two different persons at the same time.
* Commercial users of DB2DOC must register and pay for their copies
* of DB2DOC within 30 days of first use or their license is
* withdrawn. Site-License arrangements may be made by contacting
* Carlos Berguido.
* Anyone distributing DB2DOC for any kind of remuneration must
* first contact Carlos Berguido at the address below for
* authorization. This authorization will be automatically granted
* to distributors recognized by the (ASP) as adhering to its
* guidelines for shareware distributors, and such distributors may
* begin offering DB2DOC immediately (However Carlos Berguido must
* still be advised so that the distributor can be kept up-to-date
* with the latest version of DB2DOC).
* You are encouraged to pass a copy of DB2DOC along to your friends
* for evaluation. Please encourage them to register their copy if
* they find that they can use it. All registered users will
* receive a copy of the latest version of the DB2DOC system on
* diskette with source code and telephone support for 1 year.
* ╓─────────────────────────────────╖
* ║ DISCLAIMER ║
* ╙─────────────────────────────────╜
* Users of DB2DOC must accept the following disclaimer of warranty:
*
* "DB2DOC is supplied as is. The author disclaims all warranties,
* expressed or implied, including, without limitation, the warranties
* of merchantability and of fitness for any purpose. The author
* assumes no liability for damages, direct or consequential, which
* may result from the use of DB2DOC."
* ╓─────────────────────────────────╖
* ║ DEFINITION OF SHAREWARE ║
* ╙─────────────────────────────────╜
* Shareware distribution gives users a chance to try software
* before buying it. If you try a Shareware program and continue
* using it, you are expected to register. Individual programs
* differ on details - some request registration while others
* require it, some specify a maximum trial period. With
* registration, you get anything from the simple right to continue
* using the software to an updated program with printed manual.
* Copyright laws apply to both Shareware and commercial software,
* and the copyright holder retains all rights, with a few specific
* exceptions as stated below. Shareware authors are accomplished
* programmers, just like commercial authors, and the programs are
* of comparable quality. (In both cases, there are good programs
* and bad ones!) The main difference is in the method of
* distribution. The author specifically grants the right to copy
* and distribute the software, either to all and sundry or to a
* specific group. For example, some authors require written
* permission before a commercial disk vendor may copy their
* Shareware.
* Shareware is a distribution method, not a type of software. You
* should find software that suits your needs and pocketbook,
* whether it's commercial or Shareware. The Shareware system makes
* fitting your needs easier, because you can try before you buy.
* And because the overhead is low, prices are low also. Shareware
* has the ultimate money-back guarantee - if you don't use the
* product, you don't pay for it.
* ╓─────────────────────────────────╖
* ║ THE ASP OMBUDSMAN ║
* ╙─────────────────────────────────╜
* Carlos Berguido is a member of the Association of
* Shareware Professionals (ASP). ASP wants to make sure
* that the shareware principle works for you. If you are
* unable to resolve a shareware-related problem with an ASP
* member by contacting the member directly, ASP may be able
* to help. The ASP Ombudsman can help you resolve a dispute
* or problem with an ASP member, but does not provide
* technical support for members' products. Please write to
* the ASP Ombudsman at 545 Grover Road, Muskegon, MI 49442-
* 9427 or send a Compuserve message via CompuServe Mail to
* ASP Ombudsman 70007,3536"
* ╓─────────────────────────────────╖
* ║ DB2DOC DESCRIPTION ║
* ╙─────────────────────────────────╜
* DB2DOC provides a quick and easy way to enhance your FoxPro or FoxBASE+
* development by documenting your data files. DB2DOC creates a standard DBF
* file with the name DB2DOC.DDB that contains the file structures and room
* for a complete data description for every field used in each file in your
* application. If a DB2DOC.DDB file already exists, DB2DOC will update it.
* While developing applications, use CREATE and MODIFY STRUCTURE as usual to
* create and modify data file structures. At any time, as often as you like,
* DO DB2DOC. The most current structure of each DBF will be recorded in
* a standard DBF file named DB2DOC.DDB. Space is provided for an application
* description for DB2DOC reports, each filename found, file descriptions,
* record counts, and field descriptions, If DB2DOC already exists, it will
* be updated with any new fields added since the last time DB2DOC was run.
* Fields that haven't changed will be preserved. In addition, any existing
* descriptions for any fields renamed or deleted will be marked {del} and
* kept in DB2DOC.DDB until you decide to delete them.
* A main menu option is provided to BROWSE through the DB2DOC file, where
* you add application, file, and field descriptions for DB2DOC reports.
* If VAL(field_name) of any db2doc.ddb *file* record is 0, DB2DOC will
* insert the current RECCOUNT() (count of records) for each DBF file it
* finds. You may prevent this action by entering any number > 0. That
* way, the DB2DOC reports will calculate the total disk space required for
* each file for the number of records *you* enter. This is a great way
* to determine disk space requirements for DBFs when you are planning for
* the future when all the DBFs will be full of records. By combining
* this feature with the capability of grouping any combination of DBFs
* in a single report run you will be able to pinpoint places you may
* be able to save space (and time) by changing your data design.
* A feature built in to DB2DOC BROWSE is the ability to copy a description
* from one record to another. After entering a description in a record,
* strike the F5 function key. The current description will be copied to a
* memory buffer. Next, point to any record with a blank description, the
* target record. Strike F6 to copy the description into the new record.
* This feature saves many keystrokes when entering similar descriptions.
* With FoxPro, this feature works between all fields, not just descriptions,
* and the target does not have to be blank. Note that if you strike F6 by
* accident and overwrite something you wanted to keep, just strike Escape
* before striking any other key. You will exit the browse and the data
* you had in that field will be restored.
* DB2DOC reports provide a file by file field listing. You may choose to
* report on all files or any subset of all files. You choose whether the
* reports list the fields sorted by the natural order found in the DBF
* structure or alphabetically by field name. Any DB2DOC report may be
* directed to the Screen, Printer, or Disk File "DB2DOC.PRN". The Screen
* option writes the report to a temporary SYS(3) file and then presents the
* file for viewing using the MODIFY COMMAND editor. This allows scanning
* the report on screen top to bottom, bottom to top as much as you like
* until you are done viewing it.
* ╓─────────────────────────────────╖
* ║ GETTING STARTED ║
* ╙─────────────────────────────────╜
* The DB2DOC system and documentation is completely contained in the
* Fox executable program file DB2DOC.PRG. There are no other files
* needed to start DB2DOC. Simply copy DB2DOC.PRG wherever it is
* convenient to keep it. Normally DB2DOC.PRG is installed in a
* subdirectory below the Fox Software program (FoxPro or FoxBASE+)
* such as C:\FOX\GOODIES.
* The PATH to that subdirectory (such as C:\FOX\GOODIES) should be
* included in a PATH= statement in the CONFIG.FP or CONFIG.FX file.
* See the Fox User Guide for more information on the CONFIG file.
* In addition, a DOS PATH to the subdirectory of the Fox Software
* program (FoxPro or FoxBASE+) such as C:\FOX should be in effect.
* This can be done by typing PATH C:\FOX at any DOS command prompt,
* in the AUTOEXEC.BAT file, and/or in any batch file or other system
* you use to start the Fox Software system.
* Set up this way, no matter what disk or directory you start out from
* on your computer, entering FOXPRO DB2DOC or FOXPLUS DB2DOC at any DOS
* command prompt will get both FoxPro or FoxBASE+ and DB2DOC started
* with just a single command.
* Or, if you would like to start the Fox Software system first, and then
* later start DB2DOC when inside the Fox environment:
* 1. Be in the subdirectory of the DBF files to be documented.
* 2. Start FoxPro or FoxBASE+.
* 3. If you have DB2DOC.PRG in some other sub-directory, SET a PATH to it
* or specify the full path name in the next instruction.
* 4. Enter the command: DO DB2DOC.
* 5. Choose PROCEED from the main menu.
* 6. DB2DOC.DDB and index files DB2DOC1.DDX and DB2DOC2.DDX will be created
* in the current directory.
* ╓─────────────────────────────────╖
* ║ DB2DOC RELEASE HISTORY ║
* ╙─────────────────────────────────╜
* Version 1.0 8/19/1990 initial release - no registration fee required
* Version 2.0 6/30/1991 enhancements
* FoxPro BROWSE selecting and pasting text simplified
* Colors selected for FoxPro and FoxBASE+
* Traps errors when attempting to USE invalid user DBF files
* Additional code commenting and spacing
* DBF file creation without KEYBOARD (FoxPro and FoxBASE+)
* Using SYS(2000) to get DBF file names eliminates 2 temp files
* Corrected improper SYS(3) implementation
* First release as shareware. $10 registration fee.
* Version 2.1 8/28/1991 - fix capture of dbf record counts
* ╓─────────────────────────────────╖
* ║ OTHER PRODUCTS ║
* ╙─────────────────────────────────╜
* File: QQUERY.ZIP
* Title: Elaborate Query manager for FoxPro & FoxBASE+
* Keywords: QQUERY 2.10E 8/1/91 ASP SHAREWARE $10.00 FOX
* QQuery helps users create, store, modify, and replay logical
* expressions. When combined with Fox or 3rd party report
* generators, QQuery makes a simple yet powerful query tool.
* For Fox database application developers, QQuery adds powerful,
* reusable, ad hoc record selection to developer designed data
* and report formats. QQuery has complete online help. Registered
* users receive source code and the right to use QQuery in their
* distributed applications.
* File: DB2PRG.ZIP
* Title: Automatic DBF file creation for FoxPro/FB+
* Keywords: DB2PRG 2.1 6/30/91 ASP SHAREWARE $10.00 FOX
* DB2PRG 2.1 inspects all DBF files in the current directory and quickly
* generates a FoxBASE+/FoxPro program file, "MAKEDBF.prg", containing the
* commands needed to create all or any of your DBF structures. You may
* add "DO MAKEDBF" to the initialization process of your application as
* suggested in the DB2PRG source code. Source code included by QQUERY &
* DB2DOC author, Carlos Berguido.
* ╓─────────────────────────────────╖
* ║ DB2DOC SOURCE CODE ║
* ╙─────────────────────────────────╜
* BEGIN db2doc.prg
PRIVATE massign, mtalk, msafe, mscore, mmessage1, mmessage, mstatus, mbell,;
mcolor, mconfirm, mdelete, mmenu, mtitle, mscreen
PRIVATE proceeding, mchoice, schoice, fdb2doc, fusrdbf, not_open, firstfile;
mkey, mfile, mrow, mstart, mseek, browsing, exitkey, trap, mbuffer
PRIVATE dchoice, poparray, popcount, popfiles, selecting, popchoice, popkey,;
doing_all, temptxt, mtitle, mpage, mwidth, mlines, mline, mheader
PRIVATE mfiledesc, mreccount, fcount, mbytes, mppage, wbrowse, wviewer
* Turn off screen output and cursor
SET CONSOLE OFF
massign = SYS(2002)
* Save environment
mbell = SYS(2001,'BELL') = 'ON'
mconfirm = SYS(2001,'CONFIRM') = 'ON'
mdelete = SYS(2001,'DELETED') = 'ON'
mmenu = SYS(2001,'MENU') = 'ON'
mmessage1 = SYS(2001,'MESSAGE',1)
mmessage = SYS(2001,'MESSAGE')
msafe = SYS(2001,'SAFETY') = 'ON'
mscore = SYS(2001,'SCOREBOARD') = 'ON'
mstatus = SYS(2001,'STATUS') = 'ON'
mtalk = SYS(2001,'TALK') = 'ON'
* Set environment for this program
SET BELL OFF
SET CONFIRM OFF
SET DELETED ON
SET MENU OFF
SET MESSAGE TO
SET MESSAGE TO 23
SET SAFETY OFF
SET SCOREBOARD OFF
SET STATUS OFF
SET TALK OFF
IF ISCOLOR()
mcolor = SYS(2001,'COLOR')
SET COLOR TO W+/B,RG+/W,W
IF "FOXPRO" $ UPPER(VERSION())
ACTIVATE SCREEN
SET COLOR OF SCHEME 2 TO ,W+/B,,,W+/B,RG+/W
ENDIF
ENDIF
* Paint screen frame and save it
CLEAR
mtitle = '(c) Carlos Berguido 1990, 1991 All Rights Reserved'
@ 0, 0 GET mtitle
mtitle = 'Version 2.1 D B 2 D O C Release 8/28/91'
@ 22, 0 GET mtitle
CLEAR GETS
SAVE SCREEN TO mscreen
proceeding = .T.
DO WHILE proceeding
* help screen:
RESTORE SCREEN FROM mscreen
@ 1,0 SAY ''
SET CONSOLE ON
TEXT
DB2DOC provides a quick and easy way to enhance your FoxPro or FoxBASE+
development by organizing your data file documentation. DB2DOC creates
a standard DBF file named "db2doc.ddb" that contains the file structures
of all DBF files in the current directory. Whenever needed, you may add
descriptions of each field used in each file of your application. If a
db2doc.ddb file already exists, DB2DOC can quickly update it with any
structure changes you have made. See the DB2DOC source code for details.
After creating or updating db2doc.ddb, BROWSE to create or modify your
descriptions of each field. REPORT to view or print, PACK for cleanup.
DB2DOC is distributed using the "shareware" method of distribution. It
is not free software. Continued use after a reasonable evaluation period
requires a $10 registration fee. See the DB2DOC source code for details.
Carlos Berguido Author of FB+ and FoxPro utilities
1722 Capella Court QQUERY - $10 shareware
Petaluma, CA 94954 DB2PRG - $10 shareware
(707) 762-9067 DB2DOC - $10 shareware
ENDTEXT
* Light bar menu:
@ 24, 0 PROMPT 'Cancel' MESSAGE 'Cancel this program'
IF FILE("db2doc.ddb")
@ 24,10 PROMPT 'Update' MESSAGE 'Update the doc file DB2DOC.ddb from the DBFs in the current directory'
@ 24,20 PROMPT 'Browse' MESSAGE 'View/Edit the field descriptions and other items in DB2DOC.ddb'
@ 24,30 PROMPT 'Report' MESSAGE 'Print the field listings of one file, all files, or any combination of files'
@ 24,40 PROMPT 'Pack' MESSAGE 'Permanently remove deleted records in DB2DOC.ddb'
ELSE
@ 24,10 PROMPT 'Proceed' MESSAGE 'Create the doc file DB2DOC.ddb from the DBFs in the current directory'
ENDIF
MENU TO mchoice
proceeding = mchoice > 1
IF mchoice = 2 .AND. FILE("db2doc.ddb")
@ 23,0 CLEAR
mchoice = 1
@ 24, 0 PROMPT 'Cancel' MESSAGE 'DB2DOC.DDB data file already exists. Cancel to leave existing file intact'
@ 24,10 PROMPT 'Update' MESSAGE 'Create a new DB2DOC.DDB (keeping all the descriptions from the current one)'
MENU TO mchoice
ENDIF
IF mchoice >= 3
RESTORE SCREEN FROM mscreen
USE db2doc.ddb
IF FILE("db2doc1.ddx") .AND. FILE("db2doc2.ddx")
SET INDEX TO db2doc1.ddx, db2doc2.ddx
ELSE
@ 11,19 SAY 'Creating index files for DB2DOC.ddb . . . '
INDEX ON UPPER(file_name) TO db2doc1.ddx
INDEX ON UPPER(file_name+field_name) TO db2doc2.ddx
ENDIF
IF mchoice = 3 .OR. mchoice = 4
RESTORE SCREEN FROM mscreen
@ 24, 0 PROMPT 'Natural' MESSAGE 'Show fields in the order found in the data files'
@ 24,10 PROMPT 'Sorted' MESSAGE 'Show fields sorted alphabetically within data files'
MENU TO schoice
IF schoice > 0
SET ORDER TO schoice
GOTO TOP
ENDIF
ENDIF
ENDIF
DO CASE
CASE mchoice = 2
* Proceed/Update
* start with all data files closed:
CLOSE DATABASES
SET CONSOLE OFF && output to screen from RESTORE and @ r,c SAY only
RESTORE SCREEN from mscreen
@ 2, 0 SAY 'Filename Fields'
@ 3, 0 SAY REPL(CHR(223),80)
* get name of 1st DBF file, if any
mfile = SYS(2000,'*.dbf')
IF LEN(mfile) = 0
CLOSE ALL
@ 24, 7 SAY '* No DBF files found - DB2DOC.ddb was not created * <press any key>'
SET CONSOLE ON
?? CHR(7)
ELSE
* Create DB2DOC.ddb from the latest DBF structures:
* initialize 2 unique temporary file names:
fdb2doc = SYS(3)+'.db1' && SELECT 1 DB2DOC structure
fusrdbf = SYS(3)+'.db2' && SELECT 2 user DBF structure extended
* create a text file containing the field descriptions for db2doc
SET ALTERNATE TO &fdb2doc
SET ALTERNATE ON
?? 'file_name C 8 0'
? 'field_nameC 10 0'
? 'descript C 55 0'
? 'field_no N 3 0'
? 'field_typeC 1 0'
? 'field_len N 3 0'
? 'field_dec N 3 0'
CLOSE ALTERNATE
firstfile = .T.
mrow = 0
DO WHILE LEN(mfile) > 0
* Display the DBF file name on the screen
mfile = LOWER(LEFT(mfile,AT('.',mfile)-1))
mrow = MOD(mrow,17)
@ mrow + 4, 0 CLEAR TO 21,79
@ mrow + 4, 0 SAY mfile
* attempt to open the user file
* trap FoxBASE+ attempt to open a DBF with a FoxPro memo file
SELECT 2
not_open = .F.
ON ERROR not_open = .T.
USE &mfile
ON ERROR
IF not_open
@ mrow + 4,10 SAY 'ERROR: Can not open file'
ELSE
IF firstfile
firstfile = .F.
* create a structure extended DBF file from the 1st DBF file
COPY TO &fusrdbf STRUCTURE EXTENDED
USE &fusrdbf
ZAP
* append the text file to the structure extended file
APPEND FROM &fdb2doc SDF
USE
* create the db2doc data file from the structure extended file
SELECT 1
CREATE &fdb2doc FROM &fusrdbf
APPEND BLANK
REPLACE file_name WITH ' TITLE',;
descript WITH ;
'<application title for report page header>'
SELECT 2
USE &mfile
ENDIF
* copy the user file structure descriptions
COPY TO &fusrdbf STRUCTURE EXTENDED
* append a file description record to the db2doc file
SELECT 1
APPEND BLANK
REPLACE file_name WITH mfile, ;
field_name WITH STR(RECCOUNT(2),10),;
field_len WITH 1, field_type WITH '.';
descript WITH '<dbf file description for report page header>'
* append the user file structure to the db2doc file
mstart = RECNO()
APPEND FROM &fusrdbf
GOTO mstart
DO WHILE .NOT. EOF()
REPLACE file_name WITH mfile, ;
field_no WITH RECNO() - mstart
* get rid of leading zeros:
REPLACE field_len WITH field_len, ;
field_dec WITH field_dec
@ mrow + 4,10 SAY REPL(CHR(254),MOD(RECNO()-mstart,71))
SKIP
ENDDO
ENDIF
* get next DBF file name, nul string when there are no more
mfile = SYS(2000,'*.dbf',1)
mrow = mrow + 1
ENDDO
IF firstfile
* none of the DBF files could be opened without errors
@ 24,19 SAY '* DB2DOC.ddb not created * <press any key>'
SET CONSOLE ON
?? CHR(7)
ELSE
SAVE SCREEN
@ 10,10 CLEAR TO 12,70
@ 10,10 TO 12,70
IF FILE("db2doc.ddb")
@ 11,15 SAY 'Copying information from existing DB2DOC.ddb . . . '
SELECT 2
USE db2doc.ddb
IF FILE("db2doc2.ddx")
SET INDEX TO db2doc2.ddx
ELSE
INDEX ON UPPER(file_name+field_name) TO db2doc2.ddx
ENDIF
SELECT 1
SET RELATION TO UPPER(file_name+field_name) INTO db2doc
GO TOP
DO WHILE .NOT. EOF()
IF field_type = '.'
* update the file description record with any existing
* count of records the user has in the existing db2doc
mseek = UPPER(file_name)
SELECT db2doc
SEEK mseek
SELECT 1
IF VAL(db2doc->field_name) > 0
REPLACE field_name WITH STR(VAL(db2doc->field_name),10)
ENDIF
ENDIF
SELECT db2doc
IF .NOT. EOF()
* mark the old record when it is in both the old and new
* db2doc files so it won't be appended to the new db2doc
REPLACE field_len WITH 0
ENDIF
SELECT 1
IF LEN(TRIM(db2doc->descript)) > 0
* and copy any description from the old db2doc
REPLACE descript WITH db2doc->descript
ENDIF
SKIP
ENDDO
SET RELATION TO
* mark all field names deleted, close the old db2doc
SELECT db2doc
REPLACE ALL field_name WITH LEFT(field_name,5)+'{Del}',;
field_no WITH 0
USE
* append only those records that are not in the new db2doc
SELECT 1
APPEND FROM db2doc.ddb FOR field_len > 0
ENDIF
* overwrite the old db2doc with the new one and index it
@ 11,15 SAY ' Creating index files for new DB2DOC.ddb . . . '
CLOSE ALL
COPY FILE &fdb2doc TO db2doc.ddb
USE db2doc.ddb
INDEX ON UPPER(file_name) TO db2doc1.ddx
INDEX ON UPPER(file_name+field_name) TO db2doc2.ddx
RESTORE SCREEN
@ 24,21 SAY '* DB2DOC.ddb created * <press any key>'
* select browse option as the likely user next step
mchoice = 3
ENDIF
* erase temporary files
ERASE &fdb2doc
ERASE &fusrdbf
ENDIF
* wait for a keystroke
massign = INKEY(0)
CASE mchoice = 3 .AND. schoice > 0
* Browse
@ 23,0 CLEAR
massign = SYS(2002,1)
SET CONFIRM ON
SET FUNCTION 2 TO ''
SET FUNCTION 3 TO ''
SET FUNCTION 4 TO ''
SET FUNCTION 5 TO ''
SET FUNCTION 6 TO ''
SET FUNCTION 7 TO ''
SET FUNCTION 8 TO ''
SET FUNCTION 9 TO ''
SET FUNCTION 10 TO ''
IF AT('FOXPRO',UPPER(VERSION())) <> 0
* Save/Exit
ON KEY LABEL F2 KEYBOARD CHR(23) PLAIN
* select all, copy to clipboard (^A ^C):
ON KEY LABEL F5 KEYBOARD CHR(1) + CHR(3) PLAIN
* paste at cursor, select all (^V ^A):
ON KEY LABEL F6 KEYBOARD CHR(22) + CHR(1) PLAIN
@ 24, 3 SAY 'F2: Save/Exit F5: Select and Copy text F6: Paste text Esc: Cancel'
DEFINE WINDOW wbrowse FROM 0,0 TO 22,79 PANEL COLOR SCHEME 10 GROW CLOSE
KEYBOARD CHR(13) + CHR(13) && Enter Enter, go to DESCRIPT column
BROWSE NOAPPEND TITLE 'DB2DOC' WINDOW wbrowse
RELEASE WINDOW wbrowse
@ 23,0 CLEAR
ON KEY LABEL F2
ON KEY LABEL F5
ON KEY LABEL F6
ELSE
SET FUNCTION 5 TO CHR(23) + 'P'
SET FUNCTION 6 TO CHR(23) + 'C'
SET MESSAGE TO 'F1: Help F5: Pick description to copy F6: Copy it (target must be blank)'
browsing = .T.
DO WHILE browsing
KEYBOARD CHR(6) + CHR(6) && End End, go to DESCRIPT column
BROWSE NOAPPEND
exitkey = MOD(READKEY(),256)
browsing = .F.
IF exitkey = 14
SET CONSOLE OFF
KEYBOARD CHR(13)
ACCEPT TO trap
DO CASE
CASE trap = 'P'
mbuffer = descript
browsing = .T.
CASE trap = 'C'
IF LEN(TRIM(descript)) = 0 .AND. TYPE('mbuffer') <> 'U'
REPLACE descript WITH mbuffer
ENDIF
browsing = .T.
ENDCASE
SET CONSOLE ON
ENDIF
ENDDO
SET FUNCTION 5 TO ''
SET FUNCTION 6 TO ''
ENDIF
SET CONFIRM OFF
SET MESSAGE TO 23
massign = SYS(2002)
CASE mchoice = 4 .AND. schoice > 0
* Report
RESTORE SCREEN FROM mscreen
@ 24, 0 PROMPT 'Screen' MESSAGE 'Preview the report on the screen'
@ 24,10 PROMPT 'Printer' MESSAGE 'Print the report on the printer - have the printer ready'
@ 24,20 PROMPT 'Disk' MESSAGE 'Print the report to a disk file "DB2DOC.PRN"'
MENU TO dchoice
IF dchoice = 3 .AND. FILE('DB2DOC.PRN')
RESTORE SCREEN FROM mscreen
@ 24, 0 PROMPT 'Cancel' MESSAGE 'DB2DOC.PRN text file already exists. Cancel to leave existing file intact'
@ 24,10 PROMPT 'Replace' MESSAGE 'Erase existing DB2DOC.PRN file and create a new one'
MENU TO dchoice
dchoice = IIF(dchoice = 2, 3, 0)
ENDIF
IF dchoice <> 0
RESTORE SCREEN FROM mscreen
IF TYPE('poparray') = 'U'
RELEASE poparray
DIMENSION poparray(128)
poparray(1) = ' * ALL FILES * '
popcount = 1
mfile = '*'
SKIP && skip title record
DO WHILE .NOT. EOF() .AND. popcount <= 128
IF UPPER(file_name) <> mfile
popcount = popcount + 1
mfile = UPPER(file_name)
poparray(popcount) = ' ' + LOWER(mfile)
ENDIF
SKIP
ENDDO
popfiles = 0
ENDIF
@ 3,30 MENU poparray, popcount, 15 TITLE 'Report'
popchoice = 1
selecting = .T.
@ 24,1 SAY 'Cursor: '+CHR(24)+CHR(25)+' A-Z PgUp PgDn Home End Select: '+CHR(17)+CHR(196)+CHR(217)+' Done: '+CHR(27)+CHR(26)+' Cancel: Esc'
DO WHILE selecting
SET CONFIRM ON
READ MENU TO popchoice
SET CONFIRM OFF
popkey = MOD(READKEY(),256) && Call me paranoid about future versions
DO CASE
CASE popkey <= 1 && left or right arrows exit
popchoice = popchoice + 1 && old FB+ bug
selecting = .F.
CASE popkey = 2 && Home
popchoice = 1
CASE popkey = 3 && End
popchoice = popcount
CASE popkey = 12 && Escape
selecting = .F.
CASE LEFT(poparray(popchoice),1) <> CHR(254)
poparray(popchoice) = CHR(254) + ' ' + SUBSTR(poparray(popchoice),3)
popfiles = popfiles + 1
CASE LEFT(poparray(popchoice),1) = CHR(254)
poparray(popchoice) = ' ' + SUBSTR(poparray(popchoice),3)
popfiles = popfiles - 1
ENDCASE
ENDDO
@ 23,0 CLEAR
doing_all = LEFT(poparray(1),1) = CHR(254)
IF popkey <> 12 .AND. popfiles > 0
* do only if not escape key and at least one selection was made
@ 2, 0 SAY 'Filename Fields'
@ 3, 0 SAY REPL(CHR(223),80)
DO CASE
CASE dchoice = 1
* create the report as an ASCII text file
temptxt = SYS(3)+'.TXT'
SET PRINTER TO &temptxt
CASE dchoice = 2
* send directly to the printer
SET PRINTER TO PRN
CASE dchoice = 3
* create the report as an ASCII text file
temptxt = 'DB2DOC.PRN'
SET PRINTER TO &temptxt
ENDCASE
SET PRINT ON
SET CONSOLE OFF
GOTO TOP
mtitle = TRIM(descript)
mpage = 0
mwidth = 79
mlines = 56
SKIP
popchoice = 2
mrow = 0
mbytesall = 0
DO WHILE popchoice <= popcount
IF LEFT(poparray(popchoice),1) = CHR(254) .OR. doing_all
* print page for the file
mline = mlines
mfile = UPPER(SUBSTR(poparray(popchoice),3))
SEEK mfile
@ mrow + 4, 0 CLEAR TO 21,79
@ mrow + 4, 0 SAY LOWER(mfile)
mheader = TRIM(mfile) + '.dbf'
mfiledesc = TRIM(descript)
mreccount = VAL(field_name)
fcount = 0
mbytes = 1 && xbase overhead of 1 byte per record
SKIP && past description record to 1st field
DO WHILE UPPER(file_name) = mfile
IF mline >= mlines
IF mpage > 0
* page footer info can go here
? CHR(12)
ENDIF
* page header info:
mpage = mpage + 1
mppage = 'Page '+LTRIM(STR(mpage,3))
? DATE()
?? SPACE((mwidth-LEN(mtitle))/2-IIF(SYS(2001,'CENTURY') = 'ON', 6, 8))
?? mtitle
?? SPACE((mwidth-LEN(mtitle))/2-LEN(mppage)) + mppage
?
? SPACE((mwidth-LEN(mheader))/2) + mheader
?
? SPACE((mwidth-LEN(mfiledesc))/2) + mfiledesc
?
? 'No. Field Name Type Description'
? '--- ---------- -------- -------------------------------------------------------'
?
* 999 ----10---- - 999 99 ---------------------------55--------------------------
mline = 8
ENDIF
IF field_no > 0 && skip fields not found in last update
?? STR(field_no,3) + ' '
?? UPPER(field_name) + ' '
?? field_type+' '+STR(field_len,3)+' '+SUBSTR(TRANSFORM(field_dec,'@Z 999'),2) + ' '
?? descript
?
mbytes = mbytes + field_len
@ mrow + 4,10 SAY REPL(CHR(254),MOD(field_no,71))
mline = mline + 1
fcount = fcount + 1
ENDIF
SKIP
ENDDO
?? '--- -----'
? STR(fcount,3) + ' fields ' + TRANSFORM(mbytes,'9,999') + ' bytes / record '
? '=== ====='
?
mbytes = (fcount + 1) * 32 + 1 + mbytes * mreccount
mbytesall = mbytesall + mbytes
? LTRIM(TRANSFORM(mreccount,'9,999,999,999')) + ' records use ' + LTRIM(TRANSFORM(mbytes,'99,999,999,999,999')) + ' bytes of diskspace'
mrow = MOD(mrow + 1, 17)
ENDIF
popchoice = popchoice + 1
ENDDO
?
? 'Listed files use ' + LTRIM(TRANSFORM(mbytesall,'99,999,999,999,999')) + ' bytes of diskspace'
IF dchoice = 2
* omit final page eject if to screen or disk file
? CHR(12)
ENDIF
SET CONSOLE ON
SET PRINT OFF
SET PRINTER TO PRN
IF dchoice = 1 .OR. dchoice = 3
* View/Edit the ASCII text version of the documentation file
IF AT('FOXPRO',UPPER(VERSION())) <> 0
RESTORE SCREEN FROM mscreen
DEFINE WINDOW wviewer FROM 2,-1 TO 21,79 NONE
@ 24,15 SAY 'View Report: PgUp PgDn Done: Esc'
MODI COMM &temptxt WINDOW wviewer NOEDIT
RELEASE WINDOW wviewer
RESTORE SCREEN FROM mscreen
ELSE
massign = SYS(2002,1)
MODI COMM &temptxt
ENDIF
massign = SYS(2002)
ENDIF
IF dchoice = 1
ERASE &temptxt
ENDIF
ENDIF
ENDIF
CASE mchoice = 5
* Pack
@ 11,17 SAY 'Packing and reindexing DB2DOC.ddb file . . . '
PACK
ENDCASE
ENDDO
CLOSE ALL
* Restore environment
SET CONSOLE OFF
IF ISCOLOR()
SET COLOR TO &mcolor
IF "FOXPRO" $ UPPER(VERSION())
SET COLOR OF SCHEME 2 TO
ENDIF
ENDIF
IF mbell
SET BELL ON
ENDIF
IF mconfirm
SET CONFIRM ON
ENDIF
IF .NOT. mdelete
SET DELETED OFF
ENDIF
IF mmenu
SET MENU ON
ENDIF
SET MESSAGE TO VAL(mmessage)
SET MESSAGE TO mmessage1
IF msafe
SET SAFETY ON
ENDIF
IF mscore
SET SCOREBOARD ON
ENDIF
IF mstatus
SET STATUS ON
ENDIF
IF mtalk
SET TALK ON
ENDIF
* restore cursor and activate screen output
massign = SYS(2002,1)
SET CONSOLE ON
RETURN
* eof db2doc.prg