Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : PROGEN32.ZIP
Filename : PROGGEN.PRG

*******************************************ProgGen.PRG
* ---------------------Program Generator for dBase III
* -- Date 8-2-86
* -- Corrected to work--4/7/87
* -- After Alan Simpson
* -- (His books on Dbase are highly Recommended)
*--------------Set Paramaters and display instructions
CLOSE DATABASES
CLEAR ALL
SET TALK OFF
CLEAR
TEXT

The purpose of this program is to create a set
of programs for managing a database and it's
related files; some must have been predefined.

Specifically, the database (.DBF) file must
have already been created; any label (.LBL) or
report (.FRM) format files must have already been
created; any screen (.FMT) format files must have
already been created; and any custom program (.PRG)
files must have been created. This program will
create its own index (.NDX) files as required.

To create those files needed, the dBase command is:

File type Command
.DBF CREATE
.LBL MODIFY LABEL
.FRM MODIFY REPORT
.FMT MODIFY SCREEN
.PRG MODIFY COMMAND

ENDTEXT
YesNo = " "
@ Row()+2,6 SAY "Do you want to continue? (Y/N)";
GET YesNo PICTURE "!"
READ
IF YesNo # "Y"
CANCEL
ENDIF
*-------------------------Get General Information
SET PROCEDURE TO ProgProc
MDrive = " "
MAbbrev = SPACE(4)
Ok = " "
SET CONFIRM ON
CLEAR
@ 1,16 SAY "dBase III Program Generator"
@ 3, 1 SAY "Default Drive for your programs (B or C):"
@ 3,42 GET MDrive PICTURE "A"
@ 5, 1 SAY "Four letter keyword (PROG is not allowed):"
@ 5,43 GET MAbbrev PICTURE "AAAA"
@ 10, 1 SAY "Press UP arrow to make corrections,"
@ 12, 1 SAY "or press any key to continue...";
GET Ok PICTURE "!"
READ

IF UPPER(MAbbrev) = "PROG"
? "Illegal abbreviation"
CLEAR ALL
CANCEL
ENDIF

DO WHILE LEN(TRIM(MAbbrev)) < 4
MAbbrev = TRIM(MAbbrev) + "_"
ENDDO

DO PROPER with MAbbrev
MDrive = UPPER(MDrive)
ParamFile = TRIM(MAbbrev)+"Prm.DBF"
IF .NOT. FILE(ParamFile)
USE ProgData
COPY STRUCTURE TO &ParamFile
USE &ParamFile
APPEND BLANK
REPLACE Abbrev WITH MAbbrev
REPLACE Drive WITH MDrive
ENDIF
USE &ParamFile

*---------------------------Get Database Information
CLEAR
OK=" "
@ 3, 1 SAY "Database Name:"
@ 3,16 GET Database
@ 5, 1 SAY "Main Menu Program Name:"
@ 6, 1 SAY "(Use DOS file convention FILENAME):"
@ 6,37 GET MainProg PICTURE "AAAAAAAA"
@ 8, 1 SAY "System Title:"
@ 8,15 GET MainTitle
@ 18, 1 SAY "Press UP arrow to make corrections"
@ 19, 1 SAY "or press any key to continue";
GET Ok
READ
MMainProg = MainProg
DO PROPER with MMainProg

*------------------------Verify Database file name
@ 22, 0 SAY "Verifying..."
DBName = TRIM(DataBase)
DO PROPER with DBName
DBName = DBName+".DBF"
IF .NOT. FILE(DBName)
? "Database file &DBName does not exist..."
WAIT "Create it now? (Y/N) " TO YesNo
IF UPPER(YesNo) = "Y"
CREATE &DBName
ELSE
? "Database must exist to generate programs."
? "Returning to dot prompt..."
CLEAR ALL
CLOSE DATABASES
CLOSE PROCEDURE
CANCEL
ENDIF
ENDIF

*------------------------Make Database of field names and types
SET SAFETY OFF
StruFile = TRIM(MAbbrev)+"Str.DBF"
? "Creating Structure file: &StruFile..."
IF .NOT. FILE(StruFile)
USE &DBName
COPY TO Temp STRUCTURE EXTENDED
USE ProgStru
COPY STRUCTURE TO &StruFile
USE &StruFile
APPEND FROM Temp
ERASE Temp.DBF
ELSE
USE &StruFile
COPY TO Temp
USE &DBName
COPY TO Temp2 STRUCTURE EXTENDED
USE &StruFile
ZAP
APPEND FROM Temp2
SELECT A
USE &StruFile
SELECT B
USE Temp
INDEX ON Field_name TO TempNdx
SELECT A
SET RELATION TO Field_name INTO Temp
REPLACE ALL Common WITH B->Common ;
FOR Field_name = B->Field_Name
CLOSE DATABASES
ERASE Temp.DBF
ERASE Temp2.DBF
ERASE TempNdx.NDX
ENDIF
USE &StruFile
COUNT TO NoFields
USE &ParamFile
REPLACE NoFields WITH M->NoFields
CLOSE DATABASES

*------------------------------Get Common Field Names
Ok = .F.
DO WHILE .NOT. OK
CLEAR
TEXT

Please enter the common name for your fields, for
use in the generated programs. Examples of field
names and more common names are listed below:


Field Name Common Name

LName Last Name
FName First Name
CustNo Customer Number
PartNum Part Number

Do not add any fields during this step, and
do not leave any fields blank in the in the COMMON column.
Press Control-End when finished.

ENDTEXT
?
WAIT
CLEAR
USE &StruFile
GO TOP
BROWSE FIELDS Field_Name, Common NOAPPEND FREEZE Common
LOCATE FOR LEN(TRIM(Common)) = 0
IF EOF()
Ok = .T.
ELSE
CLEAR
TEXT
All COMMON fields must have data. Please
be sure to enter names in all rows of the
COMMON column, even if the common name is
identical to the field name.
ENDTEXT
?
WAIT " Press any key to try again."
ENDIF
ENDDO

CLOSE DATABASES

*--------------------------------Get Format Filenames
CLEAR
TEXT

If you are using custom screens (.FMT) files for
adding or editing data, enter the file names
below. If the same format file is to be used
for both adding and editing records, enter name
twice. If no format files will be used, leave
both options blank.

ENDTEXT
Ok = .F.
USE &ParamFile
DO WHILE .not. Ok
@ 10, 0 clear
@ 10, 5 SAY "Format File for appending: " GET FmtFile1
@ 12, 5 SAY "Format File for editing : " GET FmtFile2
READ
? "Verifying..."

Ok = .T.
IF FmtFile1 # " "
Check = TRIM(FmtFile1)+".FMT"
IF .NOT. FILE(Check)
@ 15, 5 SAY "No Format file &Check"
Ok = .F.
ENDIF
ENDIF

IF FmtFile2 # " " .AND. FmtFile2 # FmtFile1
Check = TRIM(FmtFile2)+".FMT"
IF .NOT. FILE(Check)
@ 15, 5 SAY "No Format file &Check"
Ok = .F.
ENDIF
ENDIF

IF .NOT. Ok
Answer = " "
@ 20, 1 SAY "Type X to exit to dot prompt"
@ 21, 1 SAY "or any other key to try again..." GET Answer Picture "!"
READ
IF Answer = "X"
CLOSE DATABASES
CLOSE PROCEDURE
CANCEL
ENDIF
ENDIF
ENDDO
CLOSE DATABASES

*----------------------------------Get key (lookup) field
Ok = .F.
DO WHILE .NOT. Ok
DO FlDisp with StruFile
USE &ParamFile
@ Row()+2, 1 SAY "Enter key field for searches:" GET Lookup
READ
? "Verifying..."
Lookup = UPPER(TRIM(Lookup))
Common = " "
FldTypeA1 = " "
SrtFldA1 = " "
USE &StruFile
LOCATE FOR Field_Name = Lookup
IF EOF()
?
? "No such field: &Lookup"
?
WAIT
ELSE
Ok = .T.
LookComm = Common
FldTypeA1 = Field_Type
SrtFldA1 = Lookup
LookType = Field_Type
LookLen = Field_Len
ENDIF
ENDDO

USE &ParamFile
REPLACE Lookup WITH M->Lookup
REPLACE LookComm WITH M->LookComm
REPLACE Option1 WITH M->LookComm
REPLACE SrtFldA1 WITH M->SrtFldA1

* ---------------------------------- Set Up Sort Menu
Ok = .F.
DO WHILE .NOT. Ok
CLEAR
TEXT
Please fill in the information for displaying
sort orders to the user. In the left column,
place the option name as it should read on the
menu. In the right column, enter the field
name/names for the sort, as in the examples
below.
(The search field has already been included.)

Sort Menu Option Field(s)

1. Customer Number CustNo

2. Names LName Fname

3. Zip Code Zip

ENDTEXT
?
WAIT
CLEAR
DO FlDisp WITH StruFile
? " Sort Menu Option Field(s)"
Option1 = LookComm
SrtFldA1 = LookUp
DO Proper WITH SrtFldA1
@ ROW()+2,1 SAY " 1. " + Option1
@ ROW(),35 SAY SrtFldA1
Counter = 2
USE &ParamFile
DO WHILE Counter <= 5
Sub = STR(Counter,1)
@ ROW()+2,1 SAY STR(Counter,2) + ". " GET Option&Sub
@ ROW(),35 GET SrtFldA&Sub
@ ROW(),47 GET SrtFldB&Sub
@ ROW(),59 GET SrtFldC&Sub
Counter = Counter + 1
ENDDO
READ
? "Creating index files..."

* -------Make memory variables from fields
Counter = 2
DO WHILE Counter <= 5
Sub = STR(Counter,1)
Option&Sub = Option&Sub
SrtFldA&Sub = SrtFldA&Sub
SrtFldB&Sub = SrtFldB&Sub
SrtFldC&Sub = SrtFldC&Sub
Counter = Counter + 1
ENDDO

* -----------Verify and get data types
Ok = .T.
USE &StruFile
Counter = 2
DO WHILE Counter <= 5
Sub = STR(Counter,1)
FldCount&Sub = 0
IF LEN(TRIM(SrtFldA&Sub)) <> 0
SrtFldA&Sub = UPPER(TRIM(SrtFldA&Sub))
FldCount&Sub = FldCount&Sub + 1
LOCATE FOR Field_Name = SrtFldA&Sub
IF EOF()
? "No Such Field: " + SrtFldA&Sub
WAIT
Ok = .F.
Counter = 6
LOOP
ENDIF
FldTypeA&Sub = Field_Type
ENDIF

IF LEN(TRIM(SrtFldB&Sub)) # 0
SrtFldB&Sub = UPPER(TRIM(SrtFldB&Sub))
FldCount&Sub = FldCount&Sub + 1
LOCATE FOR Field_Name = SrtFldB&Sub
IF EOF()
? "No Such Field: " + SrtFldB&Sub
WAIT
Ok = .F.
Counter = 6
LOOP
ENDIF
FldTypeB&Sub = Field_Type
ENDIF

IF LEN(TRIM(SrtFldC&Sub)) # 0
SrtFldC&Sub = UPPER(TRIM(SrtFldC&Sub))
FldCount&Sub = FldCount&Sub + 1
LOCATE FOR Field_Name = SrtFldC&Sub
IF EOF()
? "No Such Field: " + SrtFldC&Sub
WAIT
Ok = .F.
Counter = 6
LOOP
ENDIF
FldTypeC&Sub = Field_Type
ENDIF

Counter = Counter + 1
ENDDO
ENDDO

* --------------------- Set up index file for lookup
USE &DbName
DO Proper WITH MAbbrev
IFile1 = MAbbrev + "NX1"
IFileNm1 = IFile1
IF FldTypeA1 = "C"
SrtFldA1 = "UPPER("+SrtFldA1+")"
ENDIF
INDEX ON &SrtFldA1 TO &IFile1
IndeString = IFile1

* ---------------------- Set up remaining index types
Counter = 2
DO WHILE Counter <= 5
Sub = STR(Counter,1)

IF SrtFldA&Sub # " "
DO CASE
CASE FldTypeA&Sub = " "
LOOP
CASE FldTypeA&Sub = "C"
SrtFldA&Sub = "UPPER("+SrtFldA&Sub+")"
CASE FldTypeA&Sub = "N"
SrtFldA&Sub = "STR("+SrtFldA&Sub+",19,4)"
CASE FldTypeA&Sub = "D"
SrtFldA&Sub = "DTOC("+SrtFldA&Sub+")"
ENDCASE
ENDIF

IF SrtFldB&Sub # " "
DO CASE
CASE FldTypeB&Sub = " "
* Do Nothing
CASE FldTypeB&Sub = "C"
SrtFldB&Sub = "UPPER("+SrtFldB&Sub+")"
CASE FldTypeB&Sub = "N"
SrtFldB&Sub = "STR("+SrtFldB&Sub+",19,4)"
CASE FldTypeB&Sub = "D"
SrtFldB&Sub = "DTOC("+SrtFldB&Sub+")"
ENDCASE
ENDIF

IF SrtFldC&Sub # " "
DO CASE
CASE FldTypeC&Sub = " "
* --- Do Nothing
CASE FldTypeC&Sub = "C"
SrtFldC&Sub = "UPPER("+SrtFldC&Sub+")"
CASE FldTypeC&Sub = "N"
SrtFldC&Sub = "STR("+SrtFldC&Sub+",19,4)"
CASE FldTypeC&Sub = "D"
SrtFldC&Sub = "DTOC("+SrtFldC&Sub+")"
ENDCASE
ENDIF

IndString&Sub = SrtFldA&Sub
IF SrtFldB&Sub # " "
IndString&Sub = IndString&Sub + " + " +SrtFldB&Sub
ENDIF
IF SrtFldC&Sub # " "
IndString&Sub = IndString&Sub + " + " +SrtFldC&Sub
ENDIF
FldName = IndString&Sub
IFileNm&Sub = MAbbrev + "NX" + Sub
IFileNm = IFileNm&Sub
IF FldName # " "
INDEX ON &FldName TO &IFileNm
IndeString = TRIM(IndeString)+", "+IFileNm
ENDIF
Counter = Counter + 1
ENDDO

* ------------------------- Ask about Reports
Ok = .F.
DO WHILE .NOT. Ok
CLEAR
TEXT
Please enter the types of output that can be
produced (.LBL, .FRM, .PRG files) In the left
column, enter the title as it should be on the menu.
In the right column, enter the name of the file
which displays the output, including the file extension;
Examples are shown below:

Report Menu Option File Name

1. Directory of Customers Direct.FRM

2. Mailing Labels Mail.LBL

3. MailMerge File MMerge.PRG

ENDTEXT
?
WAIT
CLEAR

? " Report Menu Option File Name"
?
Counter = 1
USE &ParamFile
DO WHILE Counter < 9
Sub = STR(Counter,1)
@ ROW()+2,1 SAY STR(Counter,2)+". "
@ ROW(),6 GET RepOpt&Sub
@ ROW(),32 GET RepFile&Sub
Counter = Counter +1
ENDDO
READ

? "Verifying..."
Counter = 1
Ok = .T.
DO WHILE Counter < 9
Sub = STR(Counter,1)
IF RepOpt&Sub = " "
RepOpt&Sub = " "
RepFile&Sub = " "
Counter = Counter + 1
LOOP
ENDIF

RepOpt&Sub = TRIM(RepOpt&Sub)
RepFile&Sub = TRIM(RepFile&Sub)

IF .NOT. "." $ RepFile&Sub
? "No file name extension: " + RepFile&Sub
WAIT "Press any key, then re=enter"
Ok = .F.
Counter = 10
LOOP
ENDIF

IF .NOT. FILE(RepFile&Sub)
? "No file named: " + RepFile&Sub
WAIT "Create one now? (Y/N) " TO YesNo
IF UPPER(YesNo) = "Y"
DO REPCREATE WITH DBName, RepFile&Sub
USE &ParamFile
ELSE
? "Will create program anyway, but"
? "you must eventually create file:"
? RepFile&Sub
?
ENDIF
ENDIF
DO Proper WITH RepFile&Sub
Counter = Counter + 1
ENDDO
ENDDO
RepOpt9 = " "
RepFile9 = " "

* ----------------------- Ask About Duplication Check
Ok = .F.
DO WHILE .NOT. Ok
CLEAR
REPLACE DupCheck WITH .F.
YesNo = " "
Pmt = "Include Duplication Check Option? (Y/N)"
@ 10, 5 SAY Pmt GET YesNo PICTURE "!"
READ
IF YesNo # "N"
REPLACE DupCheck WITH .T.
DO FlDisp WITH StruFile
?
? "Enter fields for duplication check"
?
?
USE &ParamFile
@ ROW(), 2 GET DupFld1
@ ROW(),14 GET DupFld2
@ ROW(),26 GET DupFld3
@ ROW(),38 GET DupFld4
READ

* -------------------------- Verify field names
? "Verifying..."
Ok = .T.
Counter = 1
DO WHILE Counter <= 4
USE &ParamFile
Sub = STR(Counter,1)
IF DupFld&Sub = " "
Counter = 5
LOOP
ENDIF
DupFld = UPPER(TRIM(DupFld&Sub))
USE &StruFile
LOCATE FOR Field_Name = DupFld
IF EOF()
? "No such field: " + DupFld
WAIT "Press a key and re-enter"
Ok = .F.
Counter = 5
LOOP
ELSE
DupType&Sub = Field_Type
DupLen&Sub = Field_Len
ENDIF
Counter = Counter + 1
ENDDO
ELSE
Ok = .T.
ENDIF
ENDDO

* --------------------------- Build index field
Counter = 1
DO Proper WITH LookUp
DupDisp = " "
DDispLen = LookLen
USE &ParamFile
DO WHILE Counter <=4 .AND. DupCheck
Sub = STR(Counter,1)
DupConv&Sub = " "
IF DupFld&Sub # " "
DupFld = UPPER(TRIM(DupFld&Sub))
DupFld&Sub = DupFld
DO CASE
CASE DupType&Sub = "C"
DupFld = "UPPER("+DupFld+")"
CASE DupType&Sub = "N"
DupFld = "STR("+DupFld+",19,4)"
CASE DupType&Sub = "D"
DupFld = "DTOC("+DupFld+")"
ENDCASE
DupConv&Sub = DupFld
IF DDispLen + DupLen&Sub < 65 .AND. .NOT.;
UPPER(TRIM(DupFld&Sub)) $ UPPER(DupDisp)
DO PROPER WITH DupFld&Sub
IF DupDisp = " "
DupDisp = DupFld&Sub
ELSE
DupDisp = TRIM(DupDisp)+","+DupFld&Sub
ENDIF
DDispLen = DDispLen + DupLen&Sub
ENDIF
ENDIF
Counter = Counter + 1
ENDDO

DupFld&Sub = " "
IF DDispLen < 65 .AND. .NOT. ;
UPPER(LOOKUP) $ UPPER(DupDisp)
DupDisp = TRIM(DupDisp)+","+TRIM(M->LookUp)
DDispLen =DDispLen + LookLen
ENDIF
CLOSE DATABASES
USE &StruFile
DO WHILE DDispLen < 65 .AND. .NOT. EOF()
IF Field_Len + DDispLen<= 65 .AND. .NOT. TRIM(Field_Name) $ UPPER(DupDisp)
AddOn = Field_Name
DO PROPER WITH AddOn
DupDisp = TRIM(DupDisp)+","+AddOn
DDispLen = DDispLen + Field_Len
ENDIF
SKIP
ENDDO
CLOSE DATABASES
CLEAR

? "Working..."
USE &ParamFile
MDrive = UPPER(Drive)
MainTitle = TRIM(MainTitle)
DO Proper WITH MAbbrev
DO Proper WITH MMainProg
ProgName = TRIM(MMainProg) + ".PRG"
DO Proper WITH LookUp
RepProg = TRIM(MAbbrev) + "Rep"
EdProg = TRIM(MAbbrev) + "Edi"
LookComm = TRIM(LookComm)
DelProg = TRIM(MAbbrev) + "Del"
DupCheck = DupCheck
IF DupCheck
DupCase1 = 'CASE Choice = "5"'
DupCase2 = " DO "+TRIM(MAbbrev)+"Dup"
DupOpt = "5. Check For Duplicate Records"
DupProg = TRIM(MAbbrev)+"Dup"
ELSE
STORE " " TO DupCase1,DupCase2,DupProg,DupOpt
ENDIF
DbName = SUBSTR(DbName,1,AT(".",DbName)-1)
FullUse = DbName + " INDEX " + IndeString
FmtFile1 = FmtFile1
DO Proper WITH M->FmtFile1
FmtFile2 = FmtFile2
DO Proper WITH M->FmtFile2
NPages = INT(NoFields/15)+1
DO Proper WITH LookUp

SmallDisp = M->LookUp
USE &StruFile
LOCATE FOR Field_Name = UPPER(LookUp)
DispLen = Field_Len
GO TOP
DO WHILE .NOT. EOF()
IF TRIM(Field_Name) # UPPER(LookUp)
DispLen = DispLen + Field_Len
IF DispLen < 65 .AND. LEN(SmallDisp) +;
LEN(TRIM(Field_Name)) < 60
AddOn = TRIM(Field_Name)
DO Proper WITH AddOn
SmallDisp = TRIM(SmallDisp)+","+AddOn
??"-"
ENDIF
ENDIF
SKIP
?? "."
ENDDO

sn = "1"
Right = " "
Counter = 1
DO WHILE Counter <= NoFields
IF Counter < 10
Sub = STR(Counter,1)
ELSE
Sub = STR(Counter,2)
ENDIF
Right = Right + "S"+Sub+","
IF Counter/15 = INT(Counter/15)
SNames&sn = SUBSTR(Right,1,LEN(Right)-1)
Right = " "
sn = str(val(sn)+1,1)
ENDIF
Counter = Counter + 1
?? "."
ENDDO

IF LEN(TRIM(Right)) <> 0
SNames&sn = SUBSTR(Right,1,LEN(Right)-1)
ENDIF

IF NoFields > 8
Answer = "Answer = SPACE(1)"
ELSE
Answer = " "
ENDIF
TopLine1='@1,1 SAY "Enter data and operators for the filter: ;
PgDn for ALL records"'
TopLine2='@2,1 SAY "Valid operators are: =, #, >, <, >=, <=, <>"'
BotLine1='@ 24,1 SAY "Press UP arrow for corrections,;
or RETURN for next page " ;'
BotLine2= ' GET Answer PICTURE "!"'
EndLine = '@ 24, 1 SAY "Use And/Or logic:" GET AndOr PICTURE "!"'
IF LookType ="N"
LookStart = "-1"
LookStop = "0"
LookBeg = "0"
LookConv = " "
LookCount = LookUp
ELSE
LookStart = "X"
LookStop = '" "'
LookBeg = "SPACE("+STR(LookLen,2)+")"
LookConv = "Search = UPPER(TRIM(Search))"
LookCount = "UPPER("+LookUp+")"
ENDIF
IF LookType = "D"
LookConv = "Search = CTOD(Search)"
LookCount = M->LookUp
ENDIF

Counter = 1
DupComp = " "
DO WHILE Counter <= 4 .AND. DupCheck
Sub = STR(Counter,1)
IF DupConv&Sub # " "
IF Counter > 1
DupComp = TRIM(DupComp) + "+"
ENDIF
DupComp = DupComp + DupConv&Sub
ENDIF
Counter = Counter + 1
?? "."
ENDDO
CLOSE DATABASES

* ---------------------- Begin Program Generation
USE ProgGen
?
COPY TO ProgWrk
USE ProgWrk

* special section for SNames

LOCATE FOR "SNames" $ Line
DO WHILE VAL(sn) > 0
INSERT BLANK
REPLACE Line WITH "STORE ' =' TO %%SNames&sn"
REPLACE Program WITH "REPT"
sn = STR(VAL(sn)-1,1)
ENDDO

? "Replacing Variable Names..."
LOCATE FOR "%%" $ Line
DO WHILE .NOT. EOF()
Start = AT("%%",Line)
VarLen = AT(" ",SUBSTR(Line,Start,80))-3
Stop = (VarLen + Start)+2
VarName = SUBSTR(Line,Start+2,VarLen)
REPLACE Line WITH SUBSTR(Line,1,Start-1) + &VarName + SUBSTR(Line,Stop,80)
ENDCASE
CONTINUE
?? "."
ENDDO

* ---------------------Generate Main Menu
CLEAR
? "Creating Main Menu Program: &ProgName"
USE ProgWrk
COPY TO ProgHold FIELDS Line WHILE Program = "MENU"
USE ProgHold
LOCATE FOR "&-AddOpt" $ Line
IF FmtFile1 = " "
REPLACE Line WITH SPACE(11)+"APPEND"
ELSE
REPLACE Line WITH SPACE(11) + ;
"SET FORMAT TO " + FmtFile1
INSERT BLANK
REPLACE Line WITH SPACE(11) + "APPEND"
INSERT BLANK
REPLACE Line WITH SPACE(11) + "CLOSE FORMAT"
ENDIF
COPY TO &ProgName DELIM WITH BLANK

* ------------------------- Generate Reports Program
?
RepProg = RepProg + ".PRG"
? "Generating Reports program &RepProg"
USE ProgWrk
LOCATE FOR Program="REPT"
COPY TO ProgHold FIELDS Line WHILE Program="REPT"

USE ProgHold
?? "."
LOCATE FOR "&-RepMenu" $ Line
?? "."
REPLACE LINE WITH " "
Counter = 1
DO WHILE Counter < 9
Sub = STR(Counter,1)
IF RepOpt&Sub = " "
Counter = 9
LOOP
ENDIF
INSERT BLANK
REPLACE Line WITH SPACE(15) + Sub + ". " +RepOpt&Sub
Counter = Counter + 1
INSERT BLANK
?? "."
ENDDO

* -- Check for .PRG file, don't do SORT/FILTER
?"Generating PRG Check Code"
LOCATE FOR "&-Ask4.PRG" $ LINE
REPLACE Line WITH " "
Counter = 1
DO WHILE Counter < 9
Sub = STR(Counter,1)
IF RepFile&Sub = " " THEN
Counter = 10
LOOP
ENDIF
EXT = SUBSTR(RepFile&Sub,AT(".",RepFile&Sub),4)
IF EXT = ".PRG" THEN
?? "+"
INSERT BLANK
REPLACE Line WITH "IF MChoice = '&Sub' THEN"
INSERT BLANK
EXT = RepFile&Sub
REPLACE Line WITH " DO &EXT"
INSERT BLANK
REPLACE Line WITH " RETURN"
INSERT BLANK
REPLACE Line WITH "ENDIF"
ELSE
?? "."
ENDIF
Counter = Counter + 1
ENDDO

* -- Create sort menu
? "Generating Sort Menu"
LOCATE FOR "&-SortMenu" $ Line
REPLACE Line WITH " "
Counter = 1
DO WHILE Counter <= 5
Sub = STR(Counter,1)
IF Option&Sub = " "
Counter = 6
LOOP
ENDIF
INSERT BLANK
REPLACE Line WITH SPACE(15) + Sub + ". " + Option&Sub
Counter = Counter + 1
INSERT BLANK
?? "."
ENDDO

* -- Create sort cases
? "Generating Sort Cases"
LOCATE FOR "&-SortCase" $ Line
REPLACE Line WITH " "
Counter = 1
DO WHILE Counter <= 5
Sub = STR(Counter,1)
IF Option&Sub = " "
Counter = 6
LOOP
ENDIF
INSERT BLANK
REPLACE Line WITH SPACE(5) + "CASE SChoice = " + Sub
INSERT BLANK
REPLACE Line WITH SPACE(10) + "SET INDEX TO " + IFileNm&Sub
Counter = Counter + 1
?? "."
ENDDO

LOCATE FOR "&-FldLengths" $ Line
REPLACE Line WITH " "
Counter = 1
SELECT B
USE &StruFile
DO WHILE .NOT. EOF()
IF Field_Type = "C"
FLen = Field_Len
IF FLen > 30
FLen =30
ENDIF
Right = "SPACE("+STR(FLen,2)+")"
ENDIF

IF Field_Type = "N"
Right = "0."
X = 1
DO WHILE X <= Field_Dec
Right = Right + "0"
X = X + 1
ENDDO
ENDIF

IF Field_Type = "D"
Right = "SPACE(8)"
ENDIF

FName = TRIM(Field_Name)
DO PROPER WITH FName
FullLine = FName + " = "+Right
SELECT A
INSERT BLANK
REPLACE Line WITH FullLine
SELECT B
SKIP
?? "."
ENDDO
SELECT A

* -- Create search screens
? "Generating Search Screens"
LOCATE FOR "&-SScreen" $ Line
REPLACE Line WITH TopLine1
INSERT BLANK
REPLACE Line WITH TopLine2
INSERT BLANK
REPLACE Line WITH "@ 3,0 SAY ULine"
INSERT BLANK
REPLACE Line WITH "ANSWER = "+CHR(34)+" "+CHR(34)
Counter = 1
Row = 5
SELECT B
USE &StruFile
QUOTE = CHR(34)

DO WHILE .NOT. EOF()
IF Counter < 10
Sub = STR(Counter,1)
ELSE
Sub = STR(Counter,2)
ENDIF
MComm = Common
V1 = "@ "+STR(Row,2)+", 1 SAY "
V1 = V1 + CHR(34) + "&MComm" + CHR(34) + " GET S" + Sub
V2 = "@ "+STR(Row,2)+",35 GET M->"+Field_Name
SELECT A
INSERT BLANK
REPLACE Line WITH V1
INSERT BLANK
REPLACE Line WITH V2
Counter = Counter + 1
Row = Row + 2
SELECT B
SKIP
IF Counter/9 = INT(Counter/9)
SELECT A
INSERT BLANK
REPLACE Line WITH BotLine1
INSERT BLANK
REPLACE Line WITH BotLine2
INSERT BLANK
REPLACE Line WITH "READ"
INSERT BLANK
INSERT BLANK
REPLACE Line WITH "CLEAR"
INSERT BLANK
REPLACE Line WITH TopLine1
INSERT BLANK
REPLACE Line WITH TopLine2
INSERT BLANK
REPLACE Line WITH "@ 3,0 SAY ULine"
SELECT B
Row = 5
ENDIF
?? "."
ENDDO
SELECT A
INSERT BLANK
REPLACE Line WITH "@ 22,0 SAY ULine"
INSERT BLANK
REPLACE Line WITH EndLine
INSERT BLANK
REPLACE LINE WITH "READ"
?? "."

* -- Create Search Strings
? "Generating Search Strings"
LOCATE FOR "&-SearchCase" $ Line
REPLACE Line WITH "@ 24, 30 SAY 'Working...'"
SELECT B
USE &StruFile
Counter = 1
Row = 5
DO WHILE .NOT. EOF()
PropName = Field_Name
DO Proper WITH PropName
IF Field_Type = "C"
TopRight = '" "'
Left = "UPPER("+TRIM(PropName)+")"
Right= "UPPER(TRIM(M->"+TRIM(PropName)+"))"
ENDIF
IF Field_Type = "D"
TopRight = '" "'
Left = TRIM(PropName)
Right= "CTOD(M->"+TRIM(PropName)+"))"
ENDIF
IF Field_Type = "N"
TopRight = "0"
Left = TRIM(PropName)
Right= "M->"+TRIM(PropName)
ENDIF

IF Counter < 10
Sub = STR(Counter,1)
ELSE
Sub = STR(Counter,2)
ENDIF
Mid = " &S" +Sub + " "
V1 = "IF M->"+TRIM(PropName)+" # " + TopRight
V2 = ' Condit = Condit + ' +;
'"' + Left + Mid + Right + '"' + ' + Logic'
SELECT A
INSERT BLANK
REPLACE Line WITH V1
INSERT BLANK
REPLACE Line WITH V2
INSERT BLANK
REPLACE Line WITH "ENDIF"
SELECT B
Counter = Counter +1
SKIP
?? "."
ENDDO
SELECT A
INSERT BLANK
REPLACE Line WITH "@ 24,30 SAY SPACE(15)"

* -- Generate reports CASE statements
? "Generating Report Cases"
LOCATE FOR "&-RepCases" $ Line
REPLACE Line WITH " "
Counter = 1
DO WHILE Counter < 9
Sub = STR(Counter,1)
IF RepFile&Sub = " "
Counter = 10
LOOP
ENDIF
V1 = ' CASE MChoice = "'+Sub+'"'
Ext = SUBSTR(RepFile&Sub,AT(".",RepFile&Sub),4)

IF Ext = ".FRM"
V2 = SPACE(8)+"REPORT FORM "+TRIM(RepFile&Sub)+" &WMacro"
ENDIF
IF Ext = ".LBL"
V2 = SPACE(8)+"LABEL FORM "+TRIM(RepFile&Sub)+" &WMacro"
ENDIF
IF Ext = ".PRG"
V2 = SPACE(8)+"DO "+TRIM(RepFile&Sub)
ENDIF
INSERT BLANK
REPLACE Line WITH V1
INSERT BLANK
REPLACE Line WITH V2
Counter = Counter + 1
?? "."
ENDDO
COPY TO &RepProg DELIM WITH BLANK

* -- Generate Edit Program
?
EdProg = EdProg + ".PRG"
? "Generating Edit Program: &EdProg"
USE ProgWrk
LOCATE FOR Program = "EDIT"
COPY TO ProgHold FIELDS Line WHILE Program = "EDIT"
USE ProgHold
LOCATE FOR "&-EdDecide" $ Line
IF FmtFile2 = " "
REPLACE Line WITH SPACE(8)+"EDIT"
ELSE
REPLACE Line WITH SPACE(8)+"SET FORMAT TO "+FmtFile2
INSERT BLANK
REPLACE Line WITH SPACE(8)+"EDIT"
INSERT BLANK
REPLACE Line WITH SPACE(8)+"CLOSE FORMAT"
ENDIF

COPY TO &EdProg DELIM WITH BLANK

* -- Generate Deletion Program
?
DelProg = DelProg + ".PRG"
? "Generating Deletion Program: &DelProg"
USE ProgWrk
LOCATE FOR Program = "DEL"
COPY TO &DelProg FIELDS Line ;
WHILE Program = "DEL" DELIMITED WITH BLANK

* -- Generate Duplication Check Program (if requested)
IF DupCheck
?
DupProg = DupProg + ".PRG"
? "Generating Duplication Program: &DupProg"
USE ProgWrk
LOCATE FOR Program = "DUP"
COPY TO &DupProg FIELDS Line;
WHILE Program = "DUP" DELIMITED WITH BLANK
ENDIF

* -- Make Installation Batch File
?
? "Creating batch file for copying system to drive A:"
USE ProgWrk
ZAP
DBName = TRIM(DBName) + ".DBF"
DocFile = MAbbrev + "Doc.TXT"
BatFile = MAbbrev + "Copy.BAT"
APPEND BLANK
REPLACE Line WITH "COPY " + DBName + " %1"
APPEND BLANK
REPLACE Line WITH "COPY " + MAbbrev + "Nx*.NDX %1"
APPEND BLANK
REPLACE Line WITH "COPY " + ProgName + " %1"
APPEND BLANK
REPLACE Line WITH "COPY " + RepProg + " %1"
APPEND BLANK
REPLACE Line WITH "COPY " + EdProg + " %1"
APPEND BLANK
REPLACE Line WITH "COPY " + DelProg + " %1"
IF DupCheck
APPEND Blank
REPLACE Line WITH "COPY " + DupProg + " %1"
ENDIF
IF FmtFile1 # " "
APPEND BLANK
REPLACE Line WITH "COPY " + TRIM(FmtFile1) + ".FMT %1"
ENDIF
IF FmtFile2 # " "
APPEND BLANK
REPLACE Line WITH "COPY " + TRIM(FmtFile2) + ".FMT %1"
ENDIF
LBL = 0
FRM = 0
Counter = 1
DO WHILE Counter < 9
Sub = STR(Counter,1)
IF RepFile&Sub = " "
Counter = 10

LOOP
ENDIF
EXT = SUBSTR(RepFile&Sub,AT(".",RepFile&Sub),4)
DO CASE
CASE EXT = ".LBL"
LBL = 1
CASE EXT = ".FRM"
FRM = 1
CASE EXT = ".PRG"
INSERT BLANK
REPLACE Line WITH "COPY " + RepFile&Sub + " %1"
ENDCASE
Counter = Counter + 1
ENDDO
IF LBL = 1
INSERT BLANK
REPLACE Line WITH "COPY *.LBL %1"
ENDIF

IF FRM = 1
INSERT BLANK
REPLACE Line WITH "COPY *.FRM %1"
ENDIF

APPEND BLANK
REPLACE Line WITH "COPY " + DocFile + " %1"
APPEND BLANK
REPLACE Line WITH "COPY " + BatFile + " %1"
COPY TO &BatFile DELIM WITH BLANK
?
?
WAIT "Press any key to see the system files..."
CLEAR
SET ALTERNATE TO &DocFile
SET ALTERNATE ON
? "The following files have been generated to Manage the &DBName database:"
?
? "Index Files Contents"
? IFileNm1 + ": ",UPPER(Lookup)
Counter = 2
DO WHILE Counter <= 5
Sub = STR(Counter,1)
IF Indstring&Sub # " "
? IFileNm&Sub + ": ",IndString&Sub
ENDIF
Counter = Counter + 1
ENDDO
?
? "Command Files Task Performed"
? ProgName + ": Main Menu Program"
? " " + RepProg + ;
": Sort, Search and Display Reports"
? " " + EdProg + ": Edit Data"
? " " + DelProg + ": Delete Data"
IF DupCheck
? " " + DupProg + ": Check for Duplicates"
ENDIF
?
IF FmtFile1 = " "
FMFiles = "None"
ELSE
FMFiles ="Appending: "+TRIM(FmtFile1) + " Editing:" + TRIM(FmtFile2)
ENDIF
? "Format Files accessed:",FMFiles
?
? "Data Files used by ProgGen :"
DO Proper WITH StruFile
DO Proper WITH ParamFile
?? StruFile + " "
?? ParamFile
?
? "Batch file for copying generated system: ",BatFile
? "This information stored in: ",DocFile
DoComm = SUBSTR(ProgName,1,AT(".",ProgName)-1)
? "Memory variable documentation stored in : &DoComm"+".MEM"
? "To run programs, enter DO &DoComm at the dot prompt."
? "To copy all needed files to another disk enter &BatFile at"
? " at the DOS prompt in the proper subdirectory"
SET ALTERNATE OFF
CLOSE ALTERNATE
CLOSE DATABASES
CLOSE PROCEDURE
SAVE TO &DoComm
CLEAR ALL
ERASE ProgWrk.DBF
ERASE ProgHold.DBF
CANCEL