home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / fox / db2doc / db2doc.prg
Text File  |  1991-08-28  |  37KB  |  920 lines
  1. *  ╓───────────────────────────────────────────────────────────────────────╖
  2. *  ║ DB2DOC.PRG - Automatic DBF file documentation for FoxBASE+ and FoxPro ║
  3. *  ║              Version 2.1   8/28/1991                                  ║
  4. *  ╙───────────────────────────────────────────────────────────────────────╜
  5.  
  6. *  ╓─────────────────────────────────╖
  7. *  ║   SOFTWARE LICENSE AGREEMENT    ║
  8. *  ╙─────────────────────────────────╜
  9.  
  10. *  DB2DOC is not public domain or free software.  If you 
  11. *  continue using DB2DOC after a 30 day trial period, you 
  12. *  must register for a license to use DB2DOC.
  13.  
  14. *  To register, send $10 (Ten dollars U.S.) directly to the
  15. *  author:   (90 day unconditional money back guarantee)
  16.  
  17. *  Carlos Berguido         Inquiries:
  18. *  1722 Capella Court      Voice phone 707 / 762-9067
  19. *  Petaluma, CA 94954      Compuserve  72411,1071
  20.  
  21. *  Please include your name, address, and DB2DOC version
  22. *  number.  You will receive the latest version of DB2DOC
  23. *  INCLUDING ALL SOURCE CODE on a 5¼ inch diskette.
  24.  
  25. *  DB2DOC.PRG is a "shareware program" and is provided at no charge 
  26. *  to the user for evaluation.  Feel free to share it with your
  27. *  friends, but please do not give it away altered or as part of
  28. *  another system.  The essence of "user-supported" software is to
  29. *  provide personal computer users with quality software without
  30. *  high prices, and yet to provide incentive for programmers to
  31. *  continue to develop new products.  
  32.  
  33. *  If you find this program useful and find that you are using
  34. *  DB2DOC and continue to use DB2DOC after a 30 day trial period,
  35. *  you must make a registration payment of $10.00 to Carlos
  36. *  Berguido.  The $10.00 registration fee will license one copy for
  37. *  use on any one computer at any one time.
  38.  
  39. *  You must treat this software just like a book.  For example, this
  40. *  software may be used by any number of people and may be freely
  41. *  moved from one computer location to another.  However, two or
  42. *  more computers must not be running DB2DOC at the same time with
  43. *  only a single registration, just as one copy of a book cannot be
  44. *  read by two different persons at the same time.
  45.  
  46. *  Commercial users of DB2DOC must register and pay for their copies
  47. *  of DB2DOC within 30 days of first use or their license is
  48. *  withdrawn.  Site-License arrangements may be made by contacting
  49. *  Carlos Berguido.
  50.  
  51. *  Anyone distributing DB2DOC for any kind of remuneration must
  52. *  first contact Carlos Berguido at the address below for
  53. *  authorization.  This authorization will be automatically granted
  54. *  to distributors recognized by the (ASP) as adhering to its
  55. *  guidelines for shareware distributors, and such distributors may
  56. *  begin offering DB2DOC immediately (However Carlos Berguido must
  57. *  still be advised so that the distributor can be kept up-to-date
  58. *  with the latest version of DB2DOC).
  59.  
  60. *  You are encouraged to pass a copy of DB2DOC along to your friends
  61. *  for evaluation.  Please encourage them to register their copy if
  62. *  they find that they can use it.  All registered users will
  63. *  receive a copy of the latest version of the DB2DOC system on 
  64. *  diskette with source code and telephone support for 1 year.
  65.  
  66. *  ╓─────────────────────────────────╖
  67. *  ║           DISCLAIMER            ║
  68. *  ╙─────────────────────────────────╜
  69.  
  70. *  Users of DB2DOC must accept the following disclaimer of warranty:
  71. *
  72. *  "DB2DOC is supplied as is.  The author disclaims all warranties,
  73. *  expressed or implied, including, without limitation, the warranties
  74. *  of merchantability and of fitness for any purpose. The author 
  75. *  assumes no liability for damages, direct or consequential, which 
  76. *  may result from the use of DB2DOC."
  77.  
  78. *  ╓─────────────────────────────────╖
  79. *  ║     DEFINITION OF SHAREWARE     ║
  80. *  ╙─────────────────────────────────╜
  81.  
  82. *  Shareware distribution gives users a chance to try software
  83. *  before buying it.  If you try a Shareware program and continue
  84. *  using it, you are expected to register.  Individual programs
  85. *  differ on details - some request registration while others
  86. *  require it, some specify a maximum trial period.  With
  87. *  registration, you get anything from the simple right to continue
  88. *  using the software to an updated program with printed manual.
  89.   
  90. *  Copyright laws apply to both Shareware and commercial software,
  91. *  and the copyright holder retains all rights, with a few specific
  92. *  exceptions as stated below.  Shareware authors are accomplished
  93. *  programmers, just like commercial authors, and the programs are
  94. *  of comparable quality.  (In both cases, there are good programs
  95. *  and bad ones!)  The main difference is in the method of
  96. *  distribution.  The author specifically grants the right to copy
  97. *  and distribute the software, either to all and sundry or to a
  98. *  specific group.  For example, some authors require written
  99. *  permission before a commercial disk vendor may copy their
  100. *  Shareware.
  101.  
  102. *  Shareware is a distribution method, not a type of software.  You
  103. *  should find software that suits your needs and pocketbook,
  104. *  whether it's commercial or Shareware.  The Shareware system makes
  105. *  fitting your needs easier, because you can try before you buy. 
  106. *  And because the overhead is low, prices are low also.  Shareware
  107. *  has the ultimate money-back guarantee - if you don't use the
  108. *  product, you don't pay for it.
  109.  
  110. *  ╓─────────────────────────────────╖
  111. *  ║        THE ASP OMBUDSMAN        ║
  112. *  ╙─────────────────────────────────╜
  113.  
  114. *  Carlos Berguido is a member of the Association of 
  115. *  Shareware Professionals (ASP).  ASP wants to make sure
  116. *  that the shareware principle works for you. If you are
  117. *  unable to resolve a shareware-related problem with an ASP
  118. *  member by contacting the member directly, ASP may be able
  119. *  to help. The ASP Ombudsman can help you resolve a dispute
  120. *  or problem with an ASP member, but does not provide
  121. *  technical support for members' products. Please write to
  122. *  the ASP Ombudsman at 545 Grover Road, Muskegon, MI 49442-
  123. *  9427 or send a Compuserve message via CompuServe Mail to
  124. *  ASP Ombudsman 70007,3536"
  125.  
  126. *  ╓─────────────────────────────────╖
  127. *  ║       DB2DOC DESCRIPTION        ║
  128. *  ╙─────────────────────────────────╜
  129.  
  130. * DB2DOC provides a quick and easy way to enhance your FoxPro or FoxBASE+
  131. * development by documenting your data files.  DB2DOC creates a standard DBF
  132. * file with the name DB2DOC.DDB that contains the file structures and room
  133. * for a complete data description for every field used in each file in your
  134. * application.  If a DB2DOC.DDB file already exists, DB2DOC will update it.
  135.  
  136. * While developing applications, use CREATE and MODIFY STRUCTURE as usual to
  137. * create and modify data file structures.  At any time, as often as you like,
  138. * DO DB2DOC.  The most current structure of each DBF will be recorded in
  139. * a standard DBF file named DB2DOC.DDB.  Space is provided for an application
  140. * description for DB2DOC reports, each filename found, file descriptions,
  141. * record counts, and field descriptions,   If DB2DOC already exists, it will
  142. * be updated with any new fields added since the last time DB2DOC was run.
  143. * Fields that haven't changed will be preserved.  In addition, any existing
  144. * descriptions for any fields renamed or deleted will be marked {del} and
  145. * kept in DB2DOC.DDB until you decide to delete them.
  146.  
  147. * A main menu option is provided to BROWSE through the DB2DOC file, where
  148. * you add application, file, and field descriptions for DB2DOC reports.
  149.  
  150. * If VAL(field_name) of any db2doc.ddb *file* record is 0, DB2DOC will
  151. * insert the current RECCOUNT() (count of records) for each DBF file it 
  152. * finds.  You may prevent this action by entering any number > 0. That
  153. * way, the DB2DOC reports will calculate the total disk space required for
  154. * each file for the number of records *you* enter.  This is a great way
  155. * to determine disk space requirements for DBFs when you are planning for
  156. * the future when all the DBFs will be full of records.  By combining
  157. * this feature with the capability of grouping any combination of DBFs
  158. * in a single report run you will be able to pinpoint places you may 
  159. * be able to save space (and time) by changing your data design.
  160.  
  161. * A feature built in to DB2DOC BROWSE is the ability to copy a description
  162. * from one record to another.  After entering a description in a record,
  163. * strike the F5 function key.  The current description will be copied to a
  164. * memory buffer.  Next, point to any record with a blank description, the
  165. * target record.  Strike F6 to copy the description into the new record.
  166. * This feature saves many keystrokes when entering similar descriptions.
  167.  
  168. * With FoxPro, this feature works between all fields, not just descriptions,
  169. * and the target does not have to be blank.  Note that if you strike F6 by
  170. * accident and overwrite something you wanted to keep, just strike Escape
  171. * before striking any other key.  You will exit the browse and the data
  172. * you had in that field will be restored.
  173.  
  174. * DB2DOC reports provide a file by file field listing.  You may choose to 
  175. * report on all files or any subset of all files.  You choose whether the
  176. * reports list the fields sorted by the natural order found in the DBF
  177. * structure or alphabetically by field name.  Any DB2DOC report may be
  178. * directed to the Screen, Printer, or Disk File "DB2DOC.PRN".  The Screen
  179. * option writes the report to a temporary SYS(3) file and then presents the
  180. * file for viewing using the MODIFY COMMAND editor.  This allows scanning 
  181. * the report on screen top to bottom, bottom to top as much as you like 
  182. * until you are done viewing it.
  183.  
  184.  
  185. *  ╓─────────────────────────────────╖
  186. *  ║        GETTING STARTED          ║
  187. *  ╙─────────────────────────────────╜
  188.  
  189. * The DB2DOC system and documentation is completely contained in the
  190. * Fox executable program file DB2DOC.PRG.  There are no other files
  191. * needed to start DB2DOC.  Simply copy DB2DOC.PRG wherever it is
  192. * convenient to keep it.  Normally DB2DOC.PRG is installed in a 
  193. * subdirectory below the Fox Software program (FoxPro or FoxBASE+) 
  194. * such as C:\FOX\GOODIES.
  195.  
  196. * The PATH to that subdirectory (such as C:\FOX\GOODIES) should be 
  197. * included in a PATH= statement in the CONFIG.FP or CONFIG.FX file.
  198. * See the Fox User Guide for more information on the CONFIG file.
  199. * In addition, a DOS PATH to the subdirectory of the Fox Software
  200. * program (FoxPro or FoxBASE+) such as C:\FOX should be in effect. 
  201. * This can be done by typing PATH C:\FOX at any DOS command prompt,
  202. * in the AUTOEXEC.BAT file, and/or in any batch file or other system
  203. * you use to start the Fox Software system.
  204.  
  205. * Set up this way, no matter what disk or directory you start out from
  206. * on your computer, entering FOXPRO DB2DOC or FOXPLUS DB2DOC at any DOS 
  207. * command prompt will get both FoxPro or FoxBASE+ and DB2DOC started 
  208. * with just a single command.
  209.  
  210. * Or, if you would like to start the Fox Software system first, and then
  211. * later start DB2DOC when inside the Fox environment:
  212.  
  213. * 1. Be in the subdirectory of the DBF files to be documented.
  214.  
  215. * 2. Start FoxPro or FoxBASE+.
  216.  
  217. * 3. If you have DB2DOC.PRG in some other sub-directory, SET a PATH to it
  218. *    or specify the full path name in the next instruction.
  219.  
  220. * 4. Enter the command: DO DB2DOC.
  221.  
  222. * 5. Choose PROCEED from the main menu.
  223.  
  224. * 6. DB2DOC.DDB and index files DB2DOC1.DDX and DB2DOC2.DDX will be created
  225. *    in the current directory.
  226.  
  227. *  ╓─────────────────────────────────╖
  228. *  ║     DB2DOC RELEASE HISTORY      ║
  229. *  ╙─────────────────────────────────╜
  230.  
  231. * Version 1.0  8/19/1990 initial release - no registration fee required
  232.  
  233. * Version 2.0  6/30/1991 enhancements
  234. *              FoxPro BROWSE selecting and pasting text simplified
  235. *              Colors selected for FoxPro and FoxBASE+
  236. *              Traps errors when attempting to USE invalid user DBF files
  237. *              Additional code commenting and spacing
  238. *              DBF file creation without KEYBOARD (FoxPro and FoxBASE+)
  239. *              Using SYS(2000) to get DBF file names eliminates 2 temp files
  240. *              Corrected improper SYS(3) implementation
  241. *              First release as shareware.  $10 registration fee.
  242.  
  243. * Version 2.1  8/28/1991 - fix capture of dbf record counts
  244.  
  245. *  ╓─────────────────────────────────╖
  246. *  ║         OTHER PRODUCTS          ║
  247. *  ╙─────────────────────────────────╜
  248.  
  249. *       File: QQUERY.ZIP
  250.  
  251. *      Title: Elaborate Query manager for FoxPro & FoxBASE+ 
  252.  
  253. *   Keywords: QQUERY 2.10E 8/1/91 ASP SHAREWARE $10.00 FOX
  254.  
  255. *  QQuery helps users create, store, modify, and replay logical
  256. *  expressions. When combined with Fox or 3rd party report
  257. *  generators, QQuery makes a simple yet powerful query tool.
  258.  
  259. *  For Fox database application developers, QQuery adds powerful,
  260. *  reusable, ad hoc record selection to developer designed data
  261. *  and report formats. QQuery has complete online help. Registered
  262. *  users receive source code and the right to use QQuery in their
  263. *  distributed applications.
  264.  
  265.  
  266.  
  267. *       File: DB2PRG.ZIP
  268.  
  269. *      Title: Automatic DBF file creation for FoxPro/FB+
  270.  
  271. *   Keywords: DB2PRG 2.1 6/30/91 ASP SHAREWARE $10.00 FOX
  272.  
  273. *  DB2PRG 2.1 inspects all DBF files in the current directory and quickly
  274. *  generates a FoxBASE+/FoxPro program file, "MAKEDBF.prg", containing the
  275. *  commands needed to create all or any of your DBF structures.  You may
  276. *  add "DO MAKEDBF" to the initialization process of your application as
  277. *  suggested in the DB2PRG source code.  Source code included by QQUERY & 
  278. *  DB2DOC author, Carlos Berguido. 
  279.  
  280.  
  281. *  ╓─────────────────────────────────╖
  282. *  ║       DB2DOC SOURCE CODE        ║
  283. *  ╙─────────────────────────────────╜
  284.  
  285. * BEGIN db2doc.prg
  286. PRIVATE massign, mtalk, msafe, mscore, mmessage1, mmessage, mstatus, mbell,;
  287.         mcolor, mconfirm, mdelete, mmenu, mtitle, mscreen
  288. PRIVATE proceeding, mchoice, schoice, fdb2doc, fusrdbf, not_open, firstfile;
  289.         mkey, mfile, mrow, mstart, mseek, browsing, exitkey, trap, mbuffer
  290. PRIVATE dchoice, poparray, popcount, popfiles, selecting, popchoice, popkey,;
  291.         doing_all, temptxt, mtitle, mpage, mwidth, mlines, mline, mheader
  292. PRIVATE mfiledesc, mreccount, fcount, mbytes, mppage, wbrowse, wviewer
  293.  
  294. * Turn off screen output and cursor
  295. SET CONSOLE OFF
  296. massign = SYS(2002)
  297.  
  298. * Save environment
  299. mbell     = SYS(2001,'BELL')       = 'ON'
  300. mconfirm  = SYS(2001,'CONFIRM')    = 'ON'
  301. mdelete   = SYS(2001,'DELETED')    = 'ON'
  302. mmenu     = SYS(2001,'MENU')       = 'ON'
  303. mmessage1 = SYS(2001,'MESSAGE',1)
  304. mmessage  = SYS(2001,'MESSAGE')
  305. msafe     = SYS(2001,'SAFETY')     = 'ON'
  306. mscore    = SYS(2001,'SCOREBOARD') = 'ON'
  307. mstatus   = SYS(2001,'STATUS')     = 'ON'
  308. mtalk     = SYS(2001,'TALK')       = 'ON'
  309.  
  310. * Set environment for this program
  311. SET BELL OFF
  312. SET CONFIRM OFF
  313. SET DELETED ON
  314. SET MENU OFF
  315. SET MESSAGE TO
  316. SET MESSAGE TO 23
  317. SET SAFETY OFF
  318. SET SCOREBOARD OFF
  319. SET STATUS OFF
  320. SET TALK OFF
  321. IF ISCOLOR()
  322.    mcolor = SYS(2001,'COLOR')
  323.    SET COLOR TO W+/B,RG+/W,W
  324.    IF "FOXPRO" $ UPPER(VERSION())
  325.       ACTIVATE SCREEN
  326.       SET COLOR OF SCHEME 2 TO ,W+/B,,,W+/B,RG+/W
  327.    ENDIF
  328. ENDIF
  329.  
  330. * Paint screen frame and save it
  331. CLEAR
  332. mtitle = '(c) Carlos Berguido 1990, 1991                               All Rights Reserved'
  333. @  0, 0 GET mtitle
  334. mtitle = 'Version 2.1                      D B 2 D O C                     Release 8/28/91'
  335. @ 22, 0 GET mtitle
  336. CLEAR GETS
  337. SAVE SCREEN TO mscreen
  338.  
  339. proceeding = .T.
  340.  
  341. DO WHILE proceeding
  342.  
  343.    * help screen:
  344.    RESTORE SCREEN FROM mscreen
  345.    @ 1,0 SAY ''
  346.    SET CONSOLE ON
  347.    TEXT
  348.    DB2DOC provides a quick and easy way to enhance your FoxPro or FoxBASE+
  349.    development by organizing your data file documentation.  DB2DOC creates 
  350.    a standard DBF file named "db2doc.ddb" that contains the file structures 
  351.    of all DBF files in the current directory.  Whenever needed, you may add
  352.    descriptions of each field used in each file of your application.  If a
  353.    db2doc.ddb file already exists, DB2DOC can quickly update it with any
  354.    structure changes you have made.  See the DB2DOC source code for details.
  355.  
  356.    After creating or updating db2doc.ddb, BROWSE to create or modify your
  357.    descriptions of each field.  REPORT to view or print, PACK for cleanup.
  358.  
  359.    DB2DOC is distributed using the "shareware" method of distribution.  It
  360.    is not free software.  Continued use after a reasonable evaluation period
  361.    requires a $10 registration fee.  See the DB2DOC source code for details.
  362.  
  363.         Carlos Berguido                 Author of FB+ and FoxPro utilities
  364.         1722 Capella Court                  QQUERY - $10 shareware
  365.         Petaluma, CA 94954                  DB2PRG - $10 shareware
  366.         (707) 762-9067                      DB2DOC - $10 shareware
  367.  
  368.    ENDTEXT
  369.  
  370.    * Light bar menu:
  371.    @ 24, 0 PROMPT 'Cancel' MESSAGE 'Cancel this program'
  372.    IF FILE("db2doc.ddb")
  373.       @ 24,10 PROMPT 'Update'  MESSAGE 'Update the doc file DB2DOC.ddb from the DBFs in the current directory'
  374.       @ 24,20 PROMPT 'Browse'  MESSAGE 'View/Edit the field descriptions and other items in DB2DOC.ddb'
  375.       @ 24,30 PROMPT 'Report'  MESSAGE 'Print the field listings of one file, all files, or any combination of files'
  376.       @ 24,40 PROMPT 'Pack'    MESSAGE 'Permanently remove deleted records in DB2DOC.ddb'
  377.    ELSE
  378.       @ 24,10 PROMPT 'Proceed' MESSAGE 'Create the doc file DB2DOC.ddb from the DBFs in the current directory'
  379.    ENDIF
  380.  
  381.    MENU TO mchoice
  382.    proceeding = mchoice > 1
  383.  
  384.    IF mchoice = 2 .AND. FILE("db2doc.ddb")
  385.       @ 23,0 CLEAR
  386.       mchoice = 1
  387.       @ 24, 0 PROMPT 'Cancel' MESSAGE 'DB2DOC.DDB data file already exists.  Cancel to leave existing file intact'
  388.       @ 24,10 PROMPT 'Update' MESSAGE 'Create a new DB2DOC.DDB (keeping all the descriptions from the current one)'
  389.       MENU TO mchoice
  390.    ENDIF
  391.  
  392.    IF mchoice >= 3
  393.       RESTORE SCREEN FROM mscreen
  394.       USE db2doc.ddb
  395.       IF FILE("db2doc1.ddx") .AND. FILE("db2doc2.ddx")
  396.          SET INDEX TO db2doc1.ddx, db2doc2.ddx
  397.       ELSE
  398.          @ 11,19 SAY 'Creating index files for DB2DOC.ddb . . . '
  399.          INDEX ON UPPER(file_name)            TO db2doc1.ddx
  400.          INDEX ON UPPER(file_name+field_name) TO db2doc2.ddx
  401.       ENDIF
  402.       IF mchoice = 3 .OR. mchoice = 4
  403.          RESTORE SCREEN FROM mscreen
  404.          @ 24, 0 PROMPT 'Natural' MESSAGE 'Show fields in the order found in the data files'
  405.          @ 24,10 PROMPT 'Sorted'  MESSAGE 'Show fields sorted alphabetically within data files'
  406.          MENU TO schoice
  407.          IF schoice > 0
  408.             SET ORDER TO schoice
  409.             GOTO TOP
  410.          ENDIF
  411.       ENDIF
  412.    ENDIF
  413.  
  414.    DO CASE
  415.    CASE mchoice = 2
  416.       * Proceed/Update
  417.  
  418.       * start with all data files closed:
  419.       CLOSE DATABASES
  420.       SET CONSOLE OFF  && output to screen from RESTORE and @ r,c SAY only
  421.  
  422.       RESTORE SCREEN from mscreen
  423.       @ 2, 0 SAY 'Filename  Fields'
  424.       @ 3, 0 SAY REPL(CHR(223),80)
  425.  
  426.       * get name of 1st DBF file, if any
  427.       mfile = SYS(2000,'*.dbf')
  428.  
  429.       IF LEN(mfile) = 0
  430.          CLOSE ALL
  431.          @ 24, 7 SAY '* No DBF files found - DB2DOC.ddb was not created * <press any key>'
  432.          SET CONSOLE ON
  433.          ?? CHR(7)
  434.       ELSE
  435.          * Create DB2DOC.ddb from the latest DBF structures:
  436.  
  437.          * initialize 2 unique temporary file names:
  438.          fdb2doc = SYS(3)+'.db1' && SELECT 1 DB2DOC structure
  439.          fusrdbf = SYS(3)+'.db2' && SELECT 2 user DBF structure extended
  440.  
  441.          * create a text file containing the field descriptions for db2doc
  442.          SET ALTERNATE TO &fdb2doc
  443.          SET ALTERNATE ON
  444.          ?? 'file_name C  8  0'
  445.          ?  'field_nameC 10  0'
  446.          ?  'descript  C 55  0'
  447.          ?  'field_no  N  3  0'
  448.          ?  'field_typeC  1  0'
  449.          ?  'field_len N  3  0'
  450.          ?  'field_dec N  3  0'
  451.          CLOSE ALTERNATE
  452.  
  453.          firstfile = .T.
  454.          mrow      = 0
  455.          DO WHILE LEN(mfile) > 0
  456.  
  457.             * Display the DBF file name on the screen
  458.             mfile = LOWER(LEFT(mfile,AT('.',mfile)-1))
  459.             mrow  = MOD(mrow,17)
  460.             @ mrow + 4, 0 CLEAR TO 21,79
  461.             @ mrow + 4, 0 SAY mfile
  462.  
  463.             * attempt to open the user file
  464.             * trap FoxBASE+ attempt to open a DBF with a FoxPro memo file
  465.             SELECT 2
  466.             not_open = .F.
  467.             ON ERROR not_open = .T.
  468.             USE &mfile
  469.             ON ERROR
  470.             
  471.             IF not_open
  472.                @ mrow + 4,10 SAY 'ERROR: Can not open file'
  473.             ELSE
  474.                IF firstfile
  475.                   firstfile = .F.
  476.  
  477.                   * create a structure extended DBF file from the 1st DBF file
  478.                   COPY TO &fusrdbf STRUCTURE EXTENDED
  479.                   USE &fusrdbf 
  480.                   ZAP
  481.  
  482.                   * append the text file to the structure extended file
  483.                   APPEND FROM &fdb2doc SDF
  484.                   USE
  485.  
  486.                   * create the db2doc data file from the structure extended file
  487.                   SELECT 1
  488.                   CREATE &fdb2doc FROM &fusrdbf
  489.                   APPEND BLANK
  490.                   REPLACE file_name WITH '   TITLE',;
  491.                            descript WITH ;
  492.                            '<application title for report page header>'
  493.                   SELECT 2
  494.                   USE &mfile
  495.                ENDIF
  496.                * copy the user file structure descriptions
  497.                COPY TO &fusrdbf STRUCTURE EXTENDED
  498.  
  499.                * append a file description record to the db2doc file
  500.                SELECT 1
  501.                APPEND BLANK
  502.                REPLACE file_name  WITH mfile, ;
  503.                        field_name WITH STR(RECCOUNT(2),10),;
  504.                        field_len  WITH 1,  field_type WITH '.';
  505.                        descript WITH '<dbf file description for report page header>'
  506.  
  507.                * append the user file structure to the db2doc file
  508.                mstart = RECNO()
  509.                APPEND FROM &fusrdbf
  510.                GOTO mstart
  511.                DO WHILE .NOT. EOF()
  512.                   REPLACE file_name WITH mfile, ;
  513.                           field_no  WITH RECNO() - mstart
  514.                   * get rid of leading zeros:
  515.                   REPLACE field_len WITH field_len, ;
  516.                           field_dec WITH field_dec
  517.                   @ mrow + 4,10 SAY REPL(CHR(254),MOD(RECNO()-mstart,71))
  518.                   SKIP
  519.                ENDDO
  520.                
  521.             ENDIF
  522.  
  523.             * get next DBF file name, nul string when there are no more
  524.             mfile = SYS(2000,'*.dbf',1)
  525.             mrow  = mrow + 1
  526.  
  527.          ENDDO
  528.  
  529.          IF firstfile
  530.             * none of the DBF files could be opened without errors
  531.             @ 24,19 SAY '* DB2DOC.ddb not created * <press any key>'
  532.             SET CONSOLE ON
  533.             ?? CHR(7)
  534.          ELSE
  535.             SAVE SCREEN
  536.             @ 10,10 CLEAR TO 12,70
  537.             @ 10,10 TO 12,70
  538.  
  539.             IF FILE("db2doc.ddb")
  540.                @ 11,15 SAY 'Copying information from existing DB2DOC.ddb . . . '
  541.                SELECT 2
  542.                USE db2doc.ddb
  543.                IF FILE("db2doc2.ddx")
  544.                   SET INDEX TO db2doc2.ddx
  545.                ELSE
  546.                   INDEX ON UPPER(file_name+field_name) TO db2doc2.ddx
  547.                ENDIF
  548.                SELECT 1
  549.                SET RELATION TO UPPER(file_name+field_name) INTO db2doc
  550.                GO TOP
  551.                DO WHILE .NOT. EOF()
  552.                   IF field_type = '.'
  553.                      * update the file description record with any existing 
  554.                      * count of records the user has in the existing db2doc
  555.                      mseek = UPPER(file_name)
  556.                      SELECT db2doc
  557.                      SEEK mseek
  558.                      SELECT 1
  559.                      IF VAL(db2doc->field_name) > 0
  560.                         REPLACE field_name WITH STR(VAL(db2doc->field_name),10)
  561.                      ENDIF
  562.                   ENDIF
  563.                   SELECT db2doc
  564.                   IF .NOT. EOF()
  565.                      * mark the old record when it is in both the old and new
  566.                      * db2doc files so it won't be appended to the new db2doc
  567.                      REPLACE field_len WITH 0
  568.                   ENDIF
  569.                   SELECT 1
  570.                   IF LEN(TRIM(db2doc->descript)) > 0
  571.                      * and copy any description from the old db2doc
  572.                      REPLACE descript WITH db2doc->descript
  573.                   ENDIF
  574.                   SKIP
  575.                ENDDO
  576.                SET RELATION TO
  577.             
  578.                * mark all field names deleted, close the old db2doc
  579.                SELECT db2doc
  580.                REPLACE ALL field_name WITH LEFT(field_name,5)+'{Del}',;
  581.                         field_no WITH 0
  582.                USE
  583.  
  584.                * append only those records that are not in the new db2doc
  585.                SELECT 1
  586.                APPEND FROM db2doc.ddb FOR field_len > 0
  587.             ENDIF
  588.  
  589.             * overwrite the old db2doc with the new one and index it
  590.             @ 11,15 SAY '  Creating index files for new DB2DOC.ddb . . .   '
  591.             CLOSE ALL
  592.             COPY FILE &fdb2doc TO db2doc.ddb
  593.             USE db2doc.ddb
  594.             INDEX ON UPPER(file_name)            TO db2doc1.ddx
  595.             INDEX ON UPPER(file_name+field_name) TO db2doc2.ddx
  596.  
  597.             RESTORE SCREEN
  598.  
  599.             @ 24,21 SAY '* DB2DOC.ddb created * <press any key>'
  600.             * select browse option as the likely user next step
  601.             mchoice = 3
  602.          ENDIF
  603.  
  604.          * erase temporary files
  605.          ERASE &fdb2doc
  606.          ERASE &fusrdbf
  607.       
  608.       ENDIF
  609.       
  610.       * wait for a keystroke
  611.       massign = INKEY(0)
  612.  
  613.    CASE mchoice = 3 .AND. schoice > 0
  614.       * Browse
  615.       @ 23,0 CLEAR
  616.       massign = SYS(2002,1)
  617.       SET CONFIRM ON
  618.       SET FUNCTION 2 TO ''
  619.       SET FUNCTION 3 TO ''
  620.       SET FUNCTION 4 TO ''
  621.       SET FUNCTION 5 TO ''
  622.       SET FUNCTION 6 TO ''
  623.       SET FUNCTION 7 TO ''
  624.       SET FUNCTION 8 TO ''
  625.       SET FUNCTION 9 TO ''
  626.       SET FUNCTION 10 TO ''
  627.       IF AT('FOXPRO',UPPER(VERSION())) <> 0
  628.          * Save/Exit
  629.          ON KEY LABEL F2 KEYBOARD CHR(23) PLAIN
  630.          * select all, copy to clipboard (^A ^C):
  631.          ON KEY LABEL F5 KEYBOARD CHR(1) + CHR(3) PLAIN
  632.          * paste at cursor, select all (^V ^A):
  633.          ON KEY LABEL F6 KEYBOARD CHR(22) + CHR(1) PLAIN
  634.          @ 24, 3 SAY 'F2: Save/Exit    F5: Select and Copy text    F6: Paste text    Esc: Cancel'
  635.          DEFINE WINDOW wbrowse FROM 0,0 TO 22,79 PANEL COLOR SCHEME 10 GROW CLOSE
  636.          KEYBOARD CHR(13) + CHR(13)     && Enter Enter, go to DESCRIPT column
  637.          BROWSE NOAPPEND TITLE 'DB2DOC' WINDOW wbrowse
  638.          RELEASE WINDOW wbrowse
  639.          @ 23,0 CLEAR
  640.          ON KEY LABEL F2
  641.          ON KEY LABEL F5
  642.          ON KEY LABEL F6
  643.       ELSE
  644.          SET FUNCTION 5 TO CHR(23) + 'P'
  645.          SET FUNCTION 6 TO CHR(23) + 'C'
  646.          SET MESSAGE TO 'F1: Help    F5: Pick description to copy    F6: Copy it (target must be blank)'
  647.          browsing = .T.
  648.          DO WHILE browsing
  649.             KEYBOARD CHR(6) + CHR(6)     && End End, go to DESCRIPT column
  650.             BROWSE NOAPPEND
  651.             exitkey  = MOD(READKEY(),256)
  652.             browsing = .F.
  653.             IF exitkey = 14
  654.                SET CONSOLE OFF
  655.                KEYBOARD CHR(13)
  656.                ACCEPT TO trap
  657.                DO CASE
  658.                CASE trap = 'P'
  659.                   mbuffer = descript
  660.                   browsing = .T.
  661.                CASE trap = 'C'
  662.                   IF LEN(TRIM(descript)) = 0 .AND. TYPE('mbuffer') <> 'U'
  663.                      REPLACE descript WITH mbuffer
  664.                   ENDIF
  665.                   browsing = .T.
  666.                ENDCASE
  667.                SET CONSOLE ON
  668.             ENDIF
  669.          ENDDO
  670.          SET FUNCTION 5 TO ''
  671.          SET FUNCTION 6 TO ''
  672.       ENDIF
  673.       SET CONFIRM OFF
  674.       SET MESSAGE TO 23
  675.       massign = SYS(2002)
  676.  
  677.    CASE mchoice = 4 .AND. schoice > 0
  678.       * Report
  679.       RESTORE SCREEN FROM mscreen
  680.       @ 24, 0 PROMPT 'Screen'  MESSAGE 'Preview the report on the screen'
  681.       @ 24,10 PROMPT 'Printer' MESSAGE 'Print the report on the printer - have the printer ready'
  682.       @ 24,20 PROMPT 'Disk'    MESSAGE 'Print the report to a disk file "DB2DOC.PRN"'
  683.       MENU TO dchoice
  684.       IF dchoice = 3 .AND. FILE('DB2DOC.PRN')
  685.          RESTORE SCREEN FROM mscreen
  686.          @ 24, 0 PROMPT 'Cancel'  MESSAGE 'DB2DOC.PRN text file already exists.  Cancel to leave existing file intact'
  687.          @ 24,10 PROMPT 'Replace' MESSAGE 'Erase existing DB2DOC.PRN file and create a new one'
  688.          MENU TO dchoice
  689.          dchoice = IIF(dchoice = 2, 3, 0)
  690.       ENDIF
  691.       IF dchoice <> 0
  692.          RESTORE SCREEN FROM mscreen
  693.          IF TYPE('poparray') = 'U'
  694.             RELEASE poparray
  695.             DIMENSION poparray(128)
  696.             poparray(1) = '  * ALL FILES * '
  697.             popcount    = 1
  698.             mfile       = '*'
  699.             SKIP  && skip title record
  700.             DO WHILE .NOT. EOF() .AND. popcount <= 128
  701.                IF UPPER(file_name) <> mfile
  702.                   popcount = popcount + 1
  703.                   mfile    = UPPER(file_name)
  704.                   poparray(popcount) = '  ' + LOWER(mfile)
  705.                ENDIF
  706.                SKIP
  707.             ENDDO
  708.             popfiles = 0
  709.          ENDIF
  710.          @ 3,30 MENU poparray, popcount, 15  TITLE 'Report'
  711.          popchoice = 1
  712.          selecting = .T.
  713.          @ 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'
  714.          DO WHILE selecting
  715.             SET CONFIRM ON
  716.             READ MENU TO popchoice
  717.             SET CONFIRM OFF
  718.             popkey = MOD(READKEY(),256)   && Call me paranoid about future versions
  719.             DO CASE
  720.             CASE popkey <= 1              && left or right arrows exit
  721.                popchoice = popchoice + 1  && old FB+ bug
  722.                selecting = .F.
  723.             CASE popkey = 2               && Home
  724.                popchoice = 1
  725.             CASE popkey = 3               && End
  726.                popchoice = popcount
  727.             CASE popkey = 12              && Escape
  728.                selecting = .F.
  729.             CASE LEFT(poparray(popchoice),1) <> CHR(254)
  730.                poparray(popchoice) = CHR(254) + ' ' + SUBSTR(poparray(popchoice),3)
  731.                popfiles = popfiles + 1
  732.             CASE LEFT(poparray(popchoice),1) = CHR(254)
  733.                poparray(popchoice) = '  ' + SUBSTR(poparray(popchoice),3)
  734.                popfiles = popfiles - 1
  735.             ENDCASE
  736.          ENDDO
  737.          @ 23,0 CLEAR
  738.          doing_all = LEFT(poparray(1),1) = CHR(254)
  739.          IF popkey <> 12 .AND. popfiles > 0
  740.             * do only if not escape key and at least one selection was made
  741.             @ 2, 0 SAY 'Filename  Fields'
  742.             @ 3, 0 SAY REPL(CHR(223),80)
  743.             DO CASE
  744.             CASE dchoice = 1
  745.                * create the report as an ASCII text file
  746.                temptxt = SYS(3)+'.TXT'
  747.                SET PRINTER TO &temptxt
  748.             CASE dchoice = 2
  749.                * send directly to the printer
  750.                SET PRINTER TO PRN
  751.             CASE dchoice = 3
  752.                * create the report as an ASCII text file
  753.                temptxt = 'DB2DOC.PRN'
  754.                SET PRINTER TO &temptxt
  755.             ENDCASE
  756.             SET PRINT ON
  757.             SET CONSOLE OFF
  758.             GOTO TOP
  759.             mtitle = TRIM(descript)
  760.             mpage  = 0
  761.             mwidth = 79
  762.             mlines = 56
  763.             SKIP
  764.             popchoice = 2
  765.             mrow      = 0
  766.             mbytesall = 0
  767.             DO WHILE popchoice <= popcount
  768.                IF LEFT(poparray(popchoice),1) = CHR(254) .OR. doing_all
  769.                   * print page for the file
  770.                   mline = mlines
  771.                   mfile = UPPER(SUBSTR(poparray(popchoice),3))
  772.                   SEEK mfile
  773.                   @ mrow + 4, 0 CLEAR TO 21,79
  774.                   @ mrow + 4, 0 SAY LOWER(mfile)
  775.                   mheader   = TRIM(mfile) + '.dbf'
  776.                   mfiledesc = TRIM(descript)
  777.                   mreccount = VAL(field_name)
  778.                   fcount    =  0
  779.                   mbytes    =  1   && xbase overhead of 1 byte per record
  780.                   SKIP             && past description record to 1st field
  781.                   DO WHILE UPPER(file_name) = mfile
  782.                      IF mline >= mlines
  783.                         IF mpage > 0
  784.                            * page footer info can go here
  785.                            ? CHR(12)
  786.                         ENDIF
  787.                         * page header info:
  788.                         mpage  = mpage + 1
  789.                         mppage = 'Page '+LTRIM(STR(mpage,3))
  790.                         ?  DATE()
  791.                         ?? SPACE((mwidth-LEN(mtitle))/2-IIF(SYS(2001,'CENTURY') = 'ON', 6, 8))
  792.                         ?? mtitle
  793.                         ?? SPACE((mwidth-LEN(mtitle))/2-LEN(mppage)) + mppage
  794.                         ?
  795.                         ? SPACE((mwidth-LEN(mheader))/2) + mheader
  796.                         ?
  797.                         ? SPACE((mwidth-LEN(mfiledesc))/2) + mfiledesc
  798.                         ?
  799.                         ? 'No. Field Name   Type   Description'
  800.                         ? '--- ---------- -------- -------------------------------------------------------'
  801.                         ?
  802.                         *  999 ----10---- - 999 99 ---------------------------55--------------------------
  803.                         mline = 8
  804.                      ENDIF
  805.                      IF field_no > 0  && skip fields not found in last update
  806.                         ?? STR(field_no,3) + ' '
  807.                         ?? UPPER(field_name) + ' '
  808.                         ?? field_type+' '+STR(field_len,3)+' '+SUBSTR(TRANSFORM(field_dec,'@Z 999'),2) + ' '
  809.                         ?? descript
  810.                         ?
  811.                         mbytes = mbytes + field_len
  812.                         @ mrow + 4,10 SAY REPL(CHR(254),MOD(field_no,71))
  813.                         mline  = mline + 1
  814.                         fcount = fcount + 1
  815.                      ENDIF
  816.                      SKIP
  817.                   ENDDO
  818.                   ?? '---            -----'
  819.                   ?  STR(fcount,3) + ' fields     ' + TRANSFORM(mbytes,'9,999') + ' bytes / record  '
  820.                   ?  '===            ====='
  821.                   ?
  822.                   mbytes    = (fcount + 1) * 32 + 1 + mbytes * mreccount
  823.                   mbytesall = mbytesall + mbytes
  824.                   ? LTRIM(TRANSFORM(mreccount,'9,999,999,999')) + ' records use ' + LTRIM(TRANSFORM(mbytes,'99,999,999,999,999')) + ' bytes of diskspace'
  825.                   mrow = MOD(mrow + 1, 17)
  826.                ENDIF
  827.                popchoice  =  popchoice + 1
  828.             ENDDO
  829.             ?
  830.             ? 'Listed files use ' + LTRIM(TRANSFORM(mbytesall,'99,999,999,999,999')) + ' bytes of diskspace'
  831.             IF dchoice = 2
  832.                * omit final page eject if to screen or disk file
  833.                ? CHR(12)
  834.             ENDIF
  835.             SET CONSOLE ON
  836.             SET PRINT OFF
  837.             SET PRINTER TO PRN
  838.             IF dchoice = 1 .OR. dchoice = 3
  839.                 * View/Edit the ASCII text version of the documentation file
  840.                IF AT('FOXPRO',UPPER(VERSION())) <> 0
  841.                   RESTORE SCREEN FROM mscreen
  842.                   DEFINE WINDOW wviewer FROM 2,-1 TO 21,79 NONE
  843.                   @ 24,15 SAY 'View Report: PgUp PgDn                   Done: Esc'
  844.                   MODI COMM &temptxt WINDOW wviewer NOEDIT
  845.                   RELEASE WINDOW wviewer
  846.                   RESTORE SCREEN FROM mscreen
  847.                ELSE
  848.                   massign = SYS(2002,1)
  849.                   MODI COMM &temptxt
  850.                ENDIF
  851.                massign = SYS(2002)
  852.             ENDIF
  853.             IF dchoice = 1
  854.                ERASE &temptxt
  855.             ENDIF
  856.          ENDIF
  857.       ENDIF
  858.  
  859.    CASE mchoice = 5
  860.       * Pack
  861.       @ 11,17 SAY 'Packing and reindexing DB2DOC.ddb file . . . '
  862.       PACK
  863.  
  864.    ENDCASE
  865. ENDDO
  866.  
  867. CLOSE ALL
  868.  
  869. * Restore environment
  870. SET CONSOLE OFF
  871.  
  872. IF ISCOLOR()
  873.    SET COLOR TO &mcolor
  874.    IF "FOXPRO" $ UPPER(VERSION())
  875.       SET COLOR OF SCHEME 2 TO
  876.    ENDIF
  877. ENDIF
  878.  
  879. IF mbell
  880.    SET BELL ON
  881. ENDIF
  882.  
  883. IF mconfirm
  884.    SET CONFIRM ON
  885. ENDIF
  886.  
  887. IF .NOT. mdelete
  888.    SET DELETED OFF
  889. ENDIF
  890.  
  891. IF mmenu
  892.    SET MENU ON
  893. ENDIF
  894.  
  895. SET MESSAGE TO VAL(mmessage)
  896. SET MESSAGE TO mmessage1
  897.  
  898. IF msafe
  899.    SET SAFETY ON
  900. ENDIF
  901.  
  902. IF mscore
  903.    SET SCOREBOARD ON
  904. ENDIF
  905.  
  906. IF mstatus
  907.    SET STATUS ON
  908. ENDIF
  909.  
  910. IF mtalk
  911.    SET TALK ON
  912. ENDIF
  913.  
  914. * restore cursor and activate screen output
  915. massign = SYS(2002,1)
  916. SET CONSOLE ON
  917.  
  918. RETURN
  919. * eof db2doc.prg
  920.