* DB2PRG.PRG - Automatic DBF file creation for FoxBASE+ and FoxPro * Version 1.0 7/19/1990 first release * Version 2.0 3/16/1991 enhancements * DBF file creation without KEYBOARD (FoxPro only) * Using SYS(2000) to get dbf file names eliminates 2 temp files * Corrected improper SYS(3) implementation * Colors selected for FoxPro and FoxBASE+ * Additional code commenting and spacing * - Using DB2PRG.PRG - * While developing applications, use CREATE and MODIFY STRUCTURE as usual to * create and modify data file structures. * Just before distributing your application, use DB2PRG.PRG. The most * current structure of each DBF will be recorded in the MAKEDBF.PRG generated. * DB2PRG.PRG does not need to be distributed with an application, only * the MAKEDBF.PRG it creates need be distributed with your application. * Your applications could use the following code in it's initialization * process to let it know if it needs to DO MAKEDBF: * * mmakedbf = .NOT. FILE('myfile1.dbf') * mmakedbf = mmakedbf .OR. .NOT. FILE('myfile2.dbf') * mmakedbf = mmakedbf .OR. .NOT. FILE('myfile3.dbf') * * ... and so forth for every dbf file in the application * IF mmakedbf * DO makedbf * * makedbf will only create missing files. * * makedbf will never overwrite any dbf files that already exist. * DO reindex && application specific reindexing procedure you supply * ENDIF * - INSTRUCTIONS - * 1. Be in the subdirectory of the DBF files to be used. * 2. If you have DB2PRG.PRG in some other sub-directory, SET a PATH to it * or specify the full path name in the next instruction. * 3. Enter the command: DO DB2PRG * 4. The file MAKEDBF.PRG will be created in the current directory. * - ACKNOWLEDGEMENT - * The author acknowledges John Bauman for his article "DBF'S ON THE FLY" in * the August 1989 DATA BASED ADVISOR. The article ably proved the value of * DBF from scratch capabilities. DB2PRG has incorporated adaptations of * some of the methodologies described in John's article. * BEGIN db2prg.prg PRIVATE massign, mmessage, mtalk, msafe, mscore, mstatus,; mcolor, mtitle, mscreen, mchoice, mfile, fstruct, mrow * Turn off screen output and cursor SET CONSOLE OFF massign = SYS(2002) * Save environment mmessage = SYS(2001,'MESSAGE') mtalk = SYS(2001,'TALK') = 'ON' msafe = SYS(2001,'SAFETY') = 'ON' mscore = SYS(2001,'SCOREBOARD') = 'ON' mstatus = SYS(2001,'STATUS') = 'ON' * Set environment for this program SET MESSAGE TO 23 SET TALK OFF SET SAFETY OFF SET SCOREBOARD OFF SET STATUS 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 Listed Rights Reserved' @ 0, 0 GET mtitle mtitle = 'Version 2.0 D B 2 P R G Release 3/16/91' @ 22, 0 GET mtitle CLEAR GETS SAVE SCREEN TO mscreen * Sign on help screen: @ 1,0 SAY '' SET CONSOLE ON TEXT DB2PRG provides a quick and easy way to enhance your FoxPro or FoxBASE+ applications. DB2PRG automates the task of creating all the DBF file structures needed by your application. If you choose to "Proceed", DB2PRG will search the current directory and quickly generate a program file, "makedbf.prg", containing the commands needed to create all of any of the DBF files DB2PRG found. You may add "DO makedbf" to the initialization process of your application. See the DB2PRG source code for details. Permission to obtain, use, and copy this utility without charge is granted to all for any purpose. Permission is NOT granted to sell this utility. No restrictions apply to the products of this utility, any "makedbf.prg". Carlos Berguido 1722 Capella Court Petaluma, CA 94954 (707) 762-9067 ENDTEXT * Light bar menu: @ 24, 0 PROMPT 'Cancel' MESSAGE 'Cancel this program' @ 24,10 PROMPT 'Proceed' MESSAGE 'Create or replace the program file MAKEDBF.PRG in the current directory' MENU TO mchoice IF mchoice = 2 * make sure that all dbf files are 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) mfile = SYS(2000,'*.dbf') IF LEN(mfile) = 0 @ 11,12 SAY 'No DBF files were found - Makedbf.prg was not created.' @ 24,30 SAY 'Strike any key to exit ' ELSE * Create makedbf.prg file SET ALTERNATE TO makedbf.prg SET ALTERNATE ON ?? '* MAKEDBF.PRG Creates missing dbf files. Requires FoxBASE+ or FoxPro.' ? '* This program code was generated by DB2PRG.prg on', DATE() ? 'PRIVATE mscreen, mprinter, mprint, mtalk, msafe, mscore, mstatus,;' ? ' fstrutxt, fstrudbf' ? ? '* Save environment' ? 'SAVE SCREEN TO mscreen' ? 'SET CONSOLE OFF' ? 'mprinter= SYS(2001,"PRINT",1)' ? 'mprint = SYS(2001,"PRINT") = "ON"' ? 'mtalk = SYS(2001,"TALK") = "ON"' ? 'msafe = SYS(2001,"SAFETY") = "ON"' ? 'mscore = SYS(2001,"SCOREBOARD") = "ON"' ? 'mstatus = SYS(2001,"STATUS") = "ON"' ? ? '* Set environment for this program' ? 'SET TALK OFF' ? 'SET SAFETY OFF' ? 'SET SCOREBOARD OFF' ? 'IF mstatus' ? ' SET STATUS OFF' ? 'ENDIF' ? ? '* Obtain 2 unique filenames' ? 'fstrutxt = SYS(3)+".txt"' ? 'fstrudbf = SYS(3)+".dbf"' ? ? '* Create a seed dbf file for STRUCTURE EXTENDED' ? 'IF "FOXPRO" $ UPPER(VERSION())' ? ' SET PRINTER TO &fstrudbf' ? ' SET PRINT ON' ? ' ?? CHR(3)+"["+CHR(3)+CHR(6)+REPL(CHR(0),4)+CHR(161)+CHR(0)+CHR(18)' ? ' ?? REPL(CHR(0),21)' ? ' ?? "FIELD_NAME" + CHR(0) + "C" + CHR(1) + REPL(CHR(0),3)' ? ' ?? CHR(10) + REPL(CHR(0),15)' ? ' ?? "FIELD_TYPE" + CHR(0) + "C" + CHR(11) + REPL(CHR(0),3)' ? ' ?? CHR(1) + REPL(CHR(0),15)' ? ' ?? "FIELD_LEN" + CHR(0) + CHR(0) + "N" + CHR(12) + REPL(CHR(0),3)' ? ' ?? CHR(3) + REPL(CHR(0),15)' ? ' ?? "FIELD_DEC" + CHR(0) + CHR(0) + "N" + CHR(15) + REPL(CHR(0),3)' ? ' ?? CHR(3) + REPL(CHR(0),15) + CHR(13) + CHR(26)' ? ' SET PRINT OFF' ? ' * restore original printer port assignment' ? ' SET PRINTER TO &mprinter' ? 'ELSE' ? ' * if FoxBASE+, use the CREATE user interface' ? ' CLEAR TYPEAHEAD' ? ' KEYBOARD "FIELD_NAME" + "C10" +CHR(13)' ? ' KEYBOARD "FIELD_TYPE" + "C1" +CHR(13)' ? ' KEYBOARD "FIELD_LEN" + CHR(13) + "N3" +CHR(13)+"0"+CHR(13)' ? ' KEYBOARD "FIELD_DEC" + CHR(13) + "N3" +CHR(13)+"0"+CHR(13)+CHR(13)+CHR(13)+"N"' ? ' CREATE &fstrudbf' ? ' RESTORE SCREEN FROM mscreen' ? 'ENDIF' ? ? '* Draw alert box to display dbf file name being created' ? '@ 10,29 CLEAR TO 12,50' ? '@ 10,29 TO 12,50 DOUBLE' ? '@ 11,31 SAY "Creating: "' * get a unique filename for a temporary dbf file fstruct = SYS(3) + ".dbf" 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 mrow + 5,79 @ mrow + 4, 0 SAY mfile * Make a STRUCTURE EXTENDED version of the dbf file USE &mfile COPY TO &fstruct STRUCTURE EXTENDED USE &fstruct * Generate the makedbf lines for the file ? ? 'IF .NOT. FILE("&mfile..dbf")' ? ' @ 11,41 CLEAR TO 11,49' ? ' @ 11,41 SAY UPPER("&mfile")' ? ' SET ALTERNATE TO &fstrutxt' ? ' SET ALTERNATE ON' ? ' TEXT' DO WHILE .NOT. EOF() @ mrow + 4, 10 SAY REPL(CHR(254),MOD(RECNO(),71)) ? field_name + field_type + STR(field_len,3) + STR(field_dec,3) SKIP ENDDO ? ' ENDTEXT' ? ' CLOSE ALTERNATE' ? ' USE &fstrudbf' ? ' ZAP' ? ' APPEND FROM &fstrutxt SDF FOR field_name<>" "' ? ' USE' ? ' CREATE &mfile. FROM &fstrudbf' ? 'ENDIF' * get rid of the temp file so SYS(2000) won't see it USE DELETE FILE &fstruct * get next dbf file name, nul string when there are no more mfile = SYS(2000,'*.dbf',1) mrow = mrow + 1 ENDDO ? ? '* Erase the temporary files' ? 'USE' ? 'DELE FILE &fstrudbf' ? 'DELE FILE &fstrutxt' ? ? '* Restore the environment' ? 'IF mprint' ? ' SET PRINT ON' ? 'ENDIF' ? ? '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 SCREEN FROM mscreen' ? 'SET CONSOLE ON' ? ? 'RETURN' ? CLOSE ALTERNATE @ 24,20 SAY 'Makedbf.prg created. Strike any key to exit ' ENDIF ENDIF * Restore cursor massign = SYS(2002,1) IF mchoice = 2 * Wait with files closed massign = INKEY(0) @ 24, 0 CLEAR TO 24,79 ENDIF * Restore environment IF ISCOLOR() SET COLOR TO &mcolor IF "FOXPRO" $ UPPER(VERSION()) SET COLOR OF SCHEME 2 TO ENDIF ENDIF SET MESSAGE TO VAL(mmessage) IF msafe SET SAFETY ON ENDIF IF mtalk SET TALK ON ENDIF IF mstatus SET STATUS ON ENDIF IF mscore SET SCOREBOARD ON ENDIF SET CONSOLE ON RETURN * EOF db2prg.prg