home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Du Jour
/
SoftwareDuJour.iso
/
BUSINESS
/
DBASE
/
DBAPG.ARC
/
PRINTDOC.PRG
< prev
next >
Wrap
Text File
|
1984-08-12
|
8KB
|
291 lines
* Program.: PRINTDOC.PRG
* Author..: Luis A. Castro
* Date....: 06/26/84
* Notice..: Copyright 1984, Luis A. Castro, All Rights Reserved
* Version.: dBASE II, version 2.4x
* Notes...: Prints system documentation. Uses PRINTDOC.DBF
* with the field: PRINTLINE-C-254
*
SET TALK OFF
SET BELL OFF
SET COLON OFF
* ---Initialize the default output text file.
STORE "PRINTDOC.TXT" TO outfile
SET ALTERNATE TO &outfile
DO WHILE T
ERASE
@ 1, 0 SAY "========================================"
@ 1,40 SAY "========================================"
@ 2, 0 SAY "||"
@ 2,21 SAY "P R I N T D O C U M E N T A T I O N"
@ 2,78 SAY "||"
@ 3, 0 SAY "========================================"
@ 3,40 SAY "========================================"
@ 5,25 SAY " 0. exit"
@ 6,25 SAY " 1. data/index file structures"
@ 7,25 SAY " 2. memory file structures"
@ 8,25 SAY " 3. database data dictionary"
@ 9,25 SAY " 4. change output file name"
*
STORE "Current output file :" + outfile TO filename
@ 15, (80 - LEN( filename )) / 2 SAY filename
*
STORE 5 TO selectnum
DO WHILE selectnum < 0 .OR. selectnum > 4
STORE " " TO select
@ 12,33 SAY " select : : "
@ 12,42 GET select PICTURE "#"
READ
STORE VAL(select) TO selectnum
ENDDO
DO CASE
CASE selectnum= 0
SET COLON ON
SET BELL ON
SET TALK ON
CLEAR
RETURN
CASE selectnum= 1
* DO data/index file structures
ERASE
@ 2, 0 SAY "DATA/INDEX FILE STRUCTURES"
@ 2,72 SAY DATE()
@ 3, 0 SAY "========================================"
@ 3,40 SAY "========================================"
ACCEPT "Enter datafile name " TO filename
STORE !( TRIM( filename ) ) + "." TO filename
STORE $( filename, 1, @(".",filename) - 1 ) TO filename
DO CASE
CASE filename = " "
LOOP
CASE .NOT. FILE( filename + ".DBF" )
? "FILE DOES NOT EXIST"
WAIT
LOOP
ENDCASE
ACCEPT "Enter INDEX files [separated by commas] " TO indexline
STORE indexline + " ,*" TO indexline
?
* ---List the datafile structure.
USE &filename
SET ALTERNATE ON
LIST STRUCTURE
SET ALTERNATE OFF
USE
* ---Get index files.
IF indexline <> " "
SET ALTERNATE ON
?
? "Indexes:"
SET ALTERNATE OFF
USE Printdoc.dbf
COPY STRUCTURE TO Printndx.$$$
USE Printndx.$$$
* ---Get one index file at a time.
DO WHILE $( indexline, 1, 1 ) <> "*"
*
DO WHILE $( indexline, 1 ) = " "
* ---Strip leading blanks.
STORE $( indexline, 2 ) TO indexline
ENDDO
* ---Get index file name.
STORE @(",",indexline) TO pos
STORE TRIM( $( indexline, 1, pos - 1 ) ) TO token
STORE $( indexline, pos + 1 ) TO indexline
STORE !( TRIM( token ) ) + "." TO token
STORE $( token, 1, @(".",token) - 1 ) TO token
SET ALTERNATE ON
? " " + token + " = "
SET ALTERNATE OFF
STORE token + ".NDX" TO token
IF .NOT. FILE( token )
? "FILE DOES NOT EXIST - ",token
LOOP
ENDIF
* ---Get index key expression.
* ---This method will NOT always work, because
* ---dBASE II does not accept some control chars.
* ---You may have to edit the expression, afterward.
APPEND FROM &token SDF FOR # < 2
GO TOP
STORE $( Printline, 11, 100 ) TO key:expr
STORE $( key:expr, 1, 1 ) TO char
STORE 1 TO pos
STORE " " TO expression
DO WHILE RANK( char ) <> 0 .AND. pos < 100
STORE expression + char TO expression
STORE pos + 1 TO pos
STORE $( key:expr, pos, 1 ) TO char
ENDDO
SET ALTERNATE ON
?? expression
SET ALTERNATE OFF
DELETE ALL
PACK
ENDDO
USE
DELETE FILE Printndx.$$$
ENDIF
SET ALTERNATE ON
?
? "Linkages:
? " <-->>"
?
? ".PA"
?
SET ALTERNATE OFF
RELEASE ALL EXCEPT outfile
*
CASE selectnum= 2
* DO memory file structures
ERASE
@ 2, 0 SAY "MEMORY FILE STRUCTURES"
@ 2,72 SAY DATE()
@ 3, 0 SAY "========================================"
@ 3,40 SAY "========================================"
ACCEPT "Enter MEMORY file name " TO filename
STORE !( TRIM( filename ) ) + "." TO filename
STORE $( filename, 1, @(".",filename) - 1 ) TO filename
DO CASE
CASE filename = " "
LOOP
CASE .NOT. FILE( filename + ".MEM" )
? "FILE DOES NOT EXIST"
WAIT
LOOP
ENDCASE
SAVE TO Printmem.mem
RELEASE ALL EXCEPT filename
RESTORE FROM &filename ADDITIVE
?
* ---List the memory variables.
SET ALTERNATE ON
? filename + ".MEM"
? $( "------------", 1, LEN( filename ) + 4 )
LIST MEMORY
?
? ".PA"
?
SET ALTERNATE OFF
RELEASE ALL
RESTORE FROM Printmem.mem
RELEASE ALL EXCEPT outfile
CASE selectnum= 3
* DO database data dictionary
ERASE
@ 2, 0 SAY "DATABASE DATA DICTIONARY"
@ 2,72 SAY DATE()
@ 3, 0 SAY "========================================"
@ 3,40 SAY "========================================"
@ 5, 0 SAY "Enter datafile list [separated by commas]"
ACCEPT TO line
IF line = " "
LOOP
ENDIF
?
STORE line + ",*" TO line
* ---Get field names.
USE Printdoc.dbf
COPY STRUCTURE TO Printdat.$$$
USE Printdat.$$$
INDEX ON $(Printline,1,10) TO Printndx.$$$
* ---Get filenames.
DO WHILE $(line,1,1) <> "*"
*
DO WHILE $(line,1) = " " .AND. LEN(line) > 1
* ---Strip leading blanks.
STORE $(line,2) TO line
ENDDO
* ---Get one file name.
STORE TRIM( $( line, 1, @(",",line) - 1 ) ) TO token
STORE $( line, @(",",line) + 1 ) TO line
STORE !( TRIM( token ) ) + "." TO token
STORE $( token, 1, @(".",token) - 1 ) TO token
IF .NOT. FILE( token + ".DBF" )
? "FILE DOES NOT EXIST"
LOOP
ENDIF
SELECT SECONDARY
USE &token
COPY STRUCTURE EXTENDED TO Printdbf.$$$
USE Printdbf.$$$
DO WHILE .NOT. EOF
STORE Field:name TO mkey
SELECT PRIMARY
FIND &mkey
IF # <> 0
STORE LEN( TRIM( Printline ) ) - 15 TO value
STORE ( value - 10 * INT( value / 10 ) ) TO modula
STORE $( STR(0,11), 1, 10 - modula ) TO string
REPLACE Printline WITH TRIM(Printline)+string+token
ELSE
APPEND BLANK
REPLACE Printline WITH S.Field:name+" "+token
ENDIF
SELECT SECONDARY
?? "."
SKIP
ENDDO
ENDDO
USE
SELECT PRIMARY
?
SET ALTERNATE ON
? "DATABASE DATA DICTIONARY"
? "========================"
?
? "FIELD NAME DATA FILE OCCURRENCES"
? "---------- -----------------------------------"
GO TOP
DO WHILE .NOT. EOF
? TRIM(Printline)
SKIP
ENDDO
?
? ".PA"
?
SET ALTERNATE OFF
USE
DELETE FILE Printdat.$$$
DELETE FILE Printdbf.$$$
DELETE FILE Printndx.$$$
RELEASE ALL EXCEPT outfile
CASE selectnum= 4
* DO change output file name
ERASE
@ 2, 0 SAY "CHANGE OUTPUT FILE NAME"
@ 2,72 SAY DATE()
@ 3, 0 SAY "========================================"
@ 3,40 SAY "========================================"
ACCEPT "Enter new file name " TO newfile
STORE !( TRIM( newfile ) ) + "." TO newfile
STORE $( newfile, 1, @(".",newfile) ) + "TXT" TO newfile
DO CASE
CASE newfile = outfile
STORE " " TO select
@ 6,0 SAY "TEXT FILE IS ALREADY OPEN. " +;
"Restart it? [Y/N] ";
GET select PICTURE "!"
READ
CASE FILE( newfile )
STORE " " TO select
@ 6,0 SAY "TEXT FILE ALREADY EXISTS. " +;
"Delete it? [Y/N] ";
GET select PICTURE "!"
READ
CASE newfile <> " .TXT"
STORE "Y" TO select
ENDCASE
IF select = "Y"
STORE newfile TO outfile
SET ALTERNATE TO &outfile
ENDIF
ENDCASE
ENDDO T
* EOF: PRINTDOC.PRG