home *** CD-ROM | disk | FTP | other *** search
/ Beter Homes & Gardens: Complete Guide to Gardening / GARDENS.BIN / gardens / pstdis / psavarbl.prg < prev    next >
Text File  |  1994-03-31  |  4KB  |  163 lines
  1. SET exclusive off
  2. SET safety off
  3.  
  4. USE d:\grdncd\gardens\pstdis\pstdisal.dbf EXCLUSIVE
  5.  
  6.  
  7. *DO WHILE .NOT. EOF()
  8. *        cmdline = "mkdir d:\grdncd\gardens\pstdis\" + ALLTRIM(file)
  9. *        RUN &cmdline
  10. *        cmdline = "copy d:\grdncd\gardens\pstdis\index\" + ALLTRIM(file) + ".* d:\grdncd\gardens\pstdis\" + ALLTRIM(file)
  11. *        RUN &cmdline
  12. *        cmdline = "copy d:\grdncd\gardens\pstdis\index\" + ALLTRIM(image) + ".fif d:\grdncd\gardens\pstdis\" + ALLTRIM(file)
  13. *        RUN &cmdline
  14. *        cmdline = "del d:\grdncd\wil\" + ALLTRIM(dir) + ".*"
  15. *        RUN &cmdline
  16. *    SKIP
  17. *ENDDO
  18. *CANCEL
  19.  
  20. * Alphabetize list
  21. SET ORDER TO TAG name
  22. GOTO TOP
  23.  
  24. * Housekeeping
  25. goto top
  26. index = 1
  27. handle = 0
  28.  
  29. * SET up file handle
  30. filename = "d:\grdncd\gardens\pstdis\pstdisal.var"
  31. IF FILE(filename)
  32.     ERASE filename
  33.     handle = FCREATE(filename)    && If not create it
  34. *    handle = FOPEN(filename,12)    && If so, open read/write
  35. ELSE
  36.     handle = FCREATE(filename)    && If not create it
  37. ENDIF
  38.  
  39. * Done for each record
  40. DO WHILE .NOT. EOF()
  41.  
  42. * Output name
  43.         =FWRITE(handle,'@name[')
  44.         =FWRITE(handle,ALLTRIM(STR(index)))
  45.         =FPUTS(handle,']')
  46.         =FPUTS(handle,ALLTRIM(name))
  47.  
  48. * Output preview image name
  49.         =FWRITE(handle,'@image[')
  50.         =FWRITE(handle,ALLTRIM(STR(index)))
  51.         =FPUTS(handle,']')
  52.  
  53. * Get first image name
  54.         strptr = 1
  55.         DO WHILE strptr <= LEN(ALLTRIM(images))
  56.             IF SUBSTR(images,strptr,1) <> ";"
  57.                 =FWRITE(handle,SUBSTR(images,strptr,1))
  58.             ELSE
  59.                 EXIT
  60.             ENDIF
  61.             strptr = strptr + 1
  62.         ENDDO  
  63.         =FPUTS(handle,'')
  64.  
  65. * Output directory
  66.         =FWRITE(handle,'@dir[')
  67.         =FWRITE(handle,ALLTRIM(STR(index)))
  68.         =FPUTS(handle,']')
  69.         =FPUTS(handle,ALLTRIM(dir))  
  70.  
  71. * Increment and get next record
  72.     index = index + 1    && increment list index
  73.     SKIP    && get next record
  74.  
  75. enddo
  76.  
  77. * Output final list total
  78. =FPUTS(handle,'@total')
  79. =FPUTS(handle,ALLTRIM(STR(index-1)))
  80.  
  81. * Close file
  82. =FCLOSE(handle)
  83.  
  84. * Rewind file to build individual pest/disease VAR files
  85. SET ORDER TO TAG dir
  86. GOTO TOP
  87. savname = name
  88. savimages = images
  89. savdir = dir
  90.  
  91. * Done for each record
  92. DO WHILE .NOT. EOF()
  93.     
  94. * Output VAR file at level break
  95.     IF dir <> savdir
  96.  
  97.     DO write_var        && write VAR file
  98.  
  99. * Garden Type specific data
  100.         savname = name
  101.         savimages = images
  102.         savdir = dir
  103.  
  104.     ENDIF
  105.  
  106. * Get next record
  107.     SKIP    && get next record
  108.  
  109. ENDDO
  110.  
  111. DO write_var    && handle last record
  112.  
  113. *
  114. *    PROCEDURE write_var - Writes the VAR file
  115. *
  116.  
  117. PROCEDURE write_var
  118.  
  119. * set up file handle
  120.     filename = "d:\grdncd\gardens\pstdis\" + ALLTRIM(savdir) + "\" 
  121.     filename = filename + ALLTRIM(savdir) + ".var" 
  122.  
  123.     IF FILE(filename)    && if file exists, delete it
  124.         ERASE filename
  125.         handle = FCREATE(filename)    && If not create it
  126.     ELSE
  127.         handle = FCREATE(filename)    && If not create it
  128.     ENDIF
  129.  
  130. * Output name
  131.     =FPUTS(handle,'@name')
  132.     =FPUTS(handle,ALLTRIM(savname))
  133.  
  134. * Output images
  135.     index = 1
  136.     =FWRITE(handle,'@image[')
  137.     =FWRITE(handle,ALLTRIM(STR(index)))
  138.     =FPUTS(handle,']')
  139.  
  140. * Get first image name
  141.         strptr = 1
  142.         DO WHILE strptr <= LEN(ALLTRIM(savimages))
  143.             IF SUBSTR(savimages,strptr,1) <> ";"
  144.                 =FWRITE(handle,SUBSTR(savimages,strptr,1))
  145.             ELSE
  146.                 index = index + 1
  147.                 =FPUTS(handle,'')    && force CR to new image
  148.                 =FWRITE(handle,'@image[')
  149.                 =FWRITE(handle,ALLTRIM(STR(index)))
  150.                 =FPUTS(handle,']')
  151.             ENDIF
  152.             strptr = strptr + 1
  153.         ENDDO  
  154.         =FPUTS(handle,'')        && force last CR
  155.  
  156. * Output final image total
  157.         =FPUTS(handle,'@images')
  158.         =FPUTS(handle,ALLTRIM(STR(index)))
  159.  
  160. * Close file
  161.     =FCLOSE(handle)
  162.  
  163. RETURN