home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Beter Homes & Gardens: Complete Guide to Gardening
/
GARDENS.BIN
/
gardens
/
pstdis
/
psavarbl.bak
next >
Wrap
Text File
|
1994-03-31
|
5KB
|
208 lines
SET exclusive off
SET safety off
USE d:\grdncd\gardens\pstdis\pstdisal.dbf EXCLUSIVE
*DO WHILE .NOT. EOF()
* cmdline = "mkdir d:\grdncd\gardens\pstdis\" + ALLTRIM(file)
* RUN &cmdline
* cmdline = "copy d:\grdncd\gardens\pstdis\index\" + ALLTRIM(file) + ".* d:\grdncd\gardens\pstdis\" + ALLTRIM(file)
* RUN &cmdline
* cmdline = "copy d:\grdncd\gardens\pstdis\index\" + ALLTRIM(image) + ".fif d:\grdncd\gardens\pstdis\" + ALLTRIM(file)
* RUN &cmdline
* cmdline = "del d:\grdncd\wil\" + ALLTRIM(dir) + ".*"
* RUN &cmdline
* SKIP
*ENDDO
*CANCEL
* Alphabetize list
SET ORDER TO TAG name
GOTO TOP
* Housekeeping
goto top
index = 1
handle = 0
* SET up file handle
filename = "d:\grdncd\gardens\pstdis\pstdisal.var"
IF FILE(filename)
ERASE filename
handle = FCREATE(filename) && If not create it
* handle = FOPEN(filename,12) && If so, open read/write
ELSE
handle = FCREATE(filename) && If not create it
ENDIF
* Done for each record
DO WHILE .NOT. EOF()
* Output name
=FWRITE(handle,'@name[')
=FWRITE(handle,ALLTRIM(STR(index)))
=FPUTS(handle,']')
=FPUTS(handle,ALLTRIM(name))
* Output preview image name
=FWRITE(handle,'@image[')
=FWRITE(handle,ALLTRIM(STR(index)))
=FPUTS(handle,']')
* Get first image name
strptr = 1
DO WHILE strptr <= LEN(ALLTRIM(images))
IF SUBSTR(images,strptr,1) <> ";"
=FWRITE(handle,SUBSTR(images,strptr,1))
ELSE
EXIT
ENDIF
strptr = strptr + 1
ENDDO
=FPUTS(handle,'')
* Output directory
=FWRITE(handle,'@dir[')
=FWRITE(handle,ALLTRIM(STR(index)))
=FPUTS(handle,']')
=FPUTS(handle,ALLTRIM(dir))
* Increment and get next record
index = index + 1 && increment list index
SKIP && get next record
enddo
* Output final list total
=FPUTS(handle,'@total')
=FPUTS(handle,ALLTRIM(STR(index-1)))
* Close file
=FCLOSE(handle)
* Rewind file to build species VAR files
SET ORDER TO TAG dir
GOTO TOP
savname = name
**savbotan = botan
savimages = images
savdir = dir
**savsect = section
**savtype = type
**savshape = shape
**savinterest = interest
**savcolor = color
aka = ""
* Done for each record
DO WHILE .NOT. EOF()
* Output VAR file at level break
IF dir <> savdir
DO write_var && write VAR file
* Garden Type specific data
savname = name
**savbotan = botan
savimages = images
savdir = dir
**savsect = section
**savtype = type
**savshape = shape
**savinterest = interest
**savcolor = color
ELSE && else of level break
* Build aka name
IF seq > "1"
aka = aka + ALLTRIM(name) + ";"
ENDIF
ENDIF
* Get next record
SKIP && get next record
ENDDO
DO write_var && handle last record
*
* PROCEDURE write_var - Writes the VAR file
*
PROCEDURE write_var
* set up file handle
filename = "d:\grdncd\gardens\" + SUBSTR(savsect,1,3) + "\pstdis\" + ALLTRIM(savdir) + "\"
filename = filename + ALLTRIM(savdir) + ".var"
IF FILE(filename) && if file exists, delete it
ERASE filename
handle = FCREATE(filename) && If not create it
ELSE
handle = FCREATE(filename) && If not create it
ENDIF
* Output name
=FPUTS(handle,'@name')
=FPUTS(handle,ALLTRIM(savname))
* Output botanical name
* =FPUTS(handle,'@botan')
* =FPUTS(handle,'None')
* Output aka name
=FPUTS(handle,'@aka')
IF LEN(aka) = 0
=FPUTS(handle,'None') && if no aka, put None
ELSE
=FPUTS(handle,substr(aka,1,len(aka)-1)) && if aka, lose last semicolon
ENDIF
aka = "" && init to null
* Output images
index = 1
=FWRITE(handle,'@image[')
=FWRITE(handle,ALLTRIM(STR(index)))
=FPUTS(handle,']')
* Get first image name
strptr = 1
DO WHILE strptr <= LEN(ALLTRIM(savimages))
IF SUBSTR(savimages,strptr,1) <> ";"
=FWRITE(handle,SUBSTR(savimages,strptr,1))
ELSE
index = index + 1
=FPUTS(handle,'') && force CR to new image
=FWRITE(handle,'@image[')
=FWRITE(handle,ALLTRIM(STR(index)))
=FPUTS(handle,']')
ENDIF
strptr = strptr + 1
ENDDO
=FPUTS(handle,'') && force last CR
* Output final image total
=FPUTS(handle,'@images')
=FPUTS(handle,ALLTRIM(STR(index)))
* Output Color, height,light, season, and soil
*=FPUTS(handle,'@parm[1]')
*=FPUTS(handle,ALLTRIM(savtype))
*=FPUTS(handle,'@parm[2]')
*=FPUTS(handle,ALLTRIM(savcolor))
*=FPUTS(handle,'@parm[3]')
*=FPUTS(handle,ALLTRIM(savshape))
*=FPUTS(handle,'@parm[4]')
*=FPUTS(handle,ALLTRIM(savheight))
*=FPUTS(handle,'@parm[5]')
*=FPUTS(handle,ALLTRIM(savinterest))
* Close file
=FCLOSE(handle)
RETURN