home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Beter Homes & Gardens: Complete Guide to Gardening
/
GARDENS.BIN
/
gardens
/
pstdis
/
psavarbl.prg
< prev
next >
Wrap
Text File
|
1994-03-31
|
4KB
|
163 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 individual pest/disease VAR files
SET ORDER TO TAG dir
GOTO TOP
savname = name
savimages = images
savdir = dir
* 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
savimages = images
savdir = dir
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\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 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)))
* Close file
=FCLOSE(handle)
RETURN