*
* TDBS Type 46 Download Substitute w/ File Tagging
* Revision 1.00
* Written by Alan D. Bryant
* DIR File Parsing Routines by Philip L. Becker
* for eSoft, Inc.
*
****************************************************************************
* This program source is included with your TDBS to illustrate techniques. *
* You may use any or all of the source or techniques illustrated in this *
* program in any fashion you wish. There are no fees or restrictions *
* imposed on the use of this code by eSoft, Inc. *
****************************************************************************
*
* PURPOSE: This program is a basic enhancement to the Type 46 function
* of TBBS. The program is "pointed" to an existing .DIR (pseudo-directory)
* file. The file is parsed, and the files therein are displayed to the
* user. A tagging interface is provided for more convenient file download.
* Batch protocols are required to download multiple files.
*
* CONCEPTS ILLUSTRATED: This program demonstrates the user of the
* file I/O system, as well as .DIR file parsing under TDBS. Downloads
* are provided via the DOTBBS function.
*
* FLOW: The DIR file is read line by line and parsed out. If the DIR
* line is a comment, it is discarded. If it is a valid entry, it is
* displayed to the user with a tag-style interface. Once 7 files have
* been displayed, a prompt line is displayed to allow the user to
* tag, download or view files.
*
* POSSIBLE ENHANCEMENTS: The basic functionality is present to allow the
* program to be developed into a fully functional file upload and download
* system with sophisticated download features. Protocol forcing, private
* directories, and many of TBBS' other download functionality could be
* integrated. The "view" command unconditionally attempts to examine
* archived contents on all files tagged; this could be enhanced greatly
* as well.
*
*
* public declarations
*
public comment, dosname, pseudoname, owner, description, filsize, fildate
public fqueue[10], queuecount, pgtrack[200]
public spfile[8]
public dirpath
*
* initialize screen
*
if uansi()
set color to w/n
endif
clear
*
* parse out the dir file name from the opt data line
* if the %BPS% parameter was designated, parse it out too
* and store it too "bps" memvar
*
bpsoff = rat(" ", optdata())
offset = at(chr(38)+chr(38), optdata())
*
* no bps present; set to 0
*
if bpsoff <= offset
dirname = trim(substr(optdata(), offset + 3))
bps = 0
*
* bps present; store to bps memvar
*
else
dirname = trim(substr(optdata(), offset + 3, bpsoff - offset - 3))
bps = val(substr(optdata(), bpsoff))
endif
*
* if the .DIR extension is not present, add it
*
if upper(substr(dirname, len(dirname) - 3)) # ".DIR"
dirname = dirname + ".DIR"
endif
*
* open the dir file with the low-level fio system
*
fopen handle (dirname) 10 1024
*
* do error check on the file open
*
if handle = -1
? "TAGDIR: Error on opening DIR file "+upper(dirname)
? "TAGDIR: Error was: "+message(ferror(handle))
wait
quit
endif
*
* extract dir file path
*
boff = rat("\", dirname)
if boff = 0
dirpath = ".\"
else
dirpath = substr(dirname, 1, boff)
endif
*
* establish a counter for files and for the page
*
fc = 1
page = 1
*
* store initial offset to the page tracking array
*
fseek handle cpos 0
pgtrack[page] = cpos
*
* initialize the queue counter and premature end of file indicator
*
queuecount = 0
preend = 0
*
* establish a processing loop for the dir file handling
*
do while .t.
*
* read a line out of the DIR file and process it
*
flread handle actcount thisline
if actcount = 0 && if count read is 0 bytes
preend = 1 && set the premature ending flag
else
do dirparse with thisline && parse the dir line read
if empty(comment) && if not a comment
*
* do screen presentation of file entry
*
do cyellow
?? "["
do cwhite
?? ltrim(str(fc)) && file number
do cyellow
?? "] "+pseudoname+" " && display pseudoname
if len(pseudoname) < 12
?? space(12 - len(pseudoname))
endif
do cgreen
?? str(filsize, 10)+ " " && file size
do cwhite
?? dtoc(fildate)+" " && file date
do cred
?? "| "
do cyellow
*
* if description is short, display it
*
if len(description) <= 35
?? description
desc2 = ""
*
* on longer descriptions, break it into two lines
* break on a space if possible, otherwise just break it!
*
else
boff = rat(" ", substr(description, 1, 35))
if boff = 0
?? substr(description, 1, 35)
desc2 = ltrim(substr(description, 36, 70))
else
?? substr(description, 1, boff)
desc2 = ltrim(substr(description, boff))
desc2 = substr(desc2, 1, 35)
endif
endif
do cwhite
? " DL Time "
*
* calculate and display the download estimate
* this formula is a pure "guesstimate" since reliable
* modem data is not available to TDBS applications
* if bps is 0, then say "unknown"
*
if bps # 0
secs = int(filsize / (bps / 10) * 1.25)
if secs > 60
minutes = int(secs / 60)
secs = int(secs - (minutes * 60))
else
minutes = 0
endif
do ccyan
?? str(minutes, 4, 0)+" Mins. "+str(secs, 2)+" Secs. "
else
?? "(Unknown) "
endif
do cred
?? " | "
do cyellow
?? desc2 && display 2nd part of description
? ""
? ""
*
* store pseudoname to array for later reference
*
spfile[fc] = pseudoname
fc = fc + 1 && increment the file counter
endif
endif
*
* show the prompt line
*
if fc = 8 .or. preend = 1
do cyellow
?? "Enter number(s) of file to tag, or ["
do cwhite
?? "C"
do cyellow
?? "]ont, ["
do cwhite
?? "D"
do cyellow
?? "]wnld, ["
do cwhite
?? "V"
do cyellow
?? "]iew, ["
do cwhite
?? "S"
do cyellow
?? "]top? "
do while .t. && set a handling loop
accept to sel
if empty(sel)
sel = "C" && if input is empty, default to "continue"
endif
do case
*
* if input is numeric
*
case val(sel) # 0 && if input is numeric
inc = 1 && set initial value for a counter
*
* since multiple file numbers could have been entered
* on the prompt line, we'll setup a loop and handle
* the string they typed in one character at a time
* valid file number entries have their corresponding
* file tagged for download; anything invalid is discarded
*
do while inc <= len(sel)
which = val(substr(sel, inc, 1))
if queuecount = 6 && if our queue is full (6)
do ccyan
? "You must download files before tagging more. Press any key."
key = inkey(0)
exit
endif
if which > 0 .and. which < fc && if the number is valid
queuecount = queuecount + 1 && increment queue counter
fqueue[queuecount] = spfile[which] && store name to array
do ccyan
endif
inc = inc + 1 && increment handling pointer
enddo
if preend = 1 && if premature end of file redisplay page
fseek handle newpos pgtrack[page] 0
preend = 0
fc = 1
exit
endif
*
* we're here because there's more file left, so read it
*
clear
fc = 1
page = page + 1
fseek handle cpos 0
pgtrack[page] = cpos
exit
*
* if command is "stop"
*
case upper(substr(sel, 1, 1)) = "S"
quit
*
* if command is "download"
*
case upper(substr(sel, 1, 1)) = "D"
if queuecount > 0 && handle if queue is non-zero
*
* build opt data line for dotbbs command
* peel off the ".DIR" from the dirname
* add some switches to it
*
odat = substr(dirname, 1, len(rtrim(dirname)) - 4)
odat = odat + " /NL/I:"+chr(34)
inc = 1
*
* go in a loop and add the pseudonames to the
* developing opt data string (odat)
*
do while inc <= queuecount
odat = odat+fqueue[inc]+" "
inc = inc + 1
enddo
odat = odat + chr(34)
dotbbs type 46 optdata odat && trigger download
*
* reopen the DIR file since it was closed by the
* DOTBBS command
*
fopen handle (dirname) 10 1024
if handle = -1
? "TAGDIR: Error on opening DIR file "+upper(dirname)
? "TAGDIR: Error was: "+message(ferror(handle))
wait
quit
endif
queuecount = 0 && reset queue counter
*
* no files tagged!
*
else
do ccyan
? "You don't have any files tagged. Press any key."
key = inkey(0)
endif
fseek handle newpos pgtrack[page] 0
preend = 0
fc = 1
exit
*
* if command was "view"
* this code is a duplicate of the "download" code above
* and is not commented; it operates the same way, except
* that the "E" (examine) command is placed in the opt data
* string (odat) for an examine command
*
* the queue count is not reset after the view as it is
* in a download situation
*
case upper(substr(sel, 1, 1)) = "V"
if queuecount > 0
odat = substr(dirname, 1, len(rtrim(dirname)) - 4)
odat = odat + " /NL/I:"+chr(34)+"E "
inc = 1
do while inc <= queuecount
odat = odat+fqueue[inc]+" "
inc = inc + 1
enddo
odat = odat + chr(34)
dotbbs type 46 optdata odat
fopen handle (dirname) 10 1024
if handle = -1
? "TAGDIR: Error on opening DIR file "+upper(dirname)
? "TAGDIR: Error was: "+message(ferror(handle))
wait
quit
endif
do ccyan
? "Press any key to continue."
key = inkey(0)
else
do ccyan
? "You don't have any files tagged. Press any key."
key = inkey(0)
endif
fseek handle newpos pgtrack[page] 0
preend = 0
fc = 1
exit
otherwise
if preend = 1
fseek handle newpos pgtrack[page] 0
preend = 0
fc = 1
exit
endif
clear
fc = 1
page = page + 1
fseek handle cpos 0
pgtrack[page] = cpos
exit
endcase
enddo && end of input handling loop
if uansi()
set color to w/n
endif
clear
endif && end of "if file count = 8 or premature ending" if
enddo && end of DIR file handling loop
*******************************************************************************
* "dirparse" procedure
*******************************************************************************
*
* dir file line parsing procedure
* passing "dirlin" as a line from the dir file
*
procedure dirparse
parameters dirlin
*
* get character count of line from dir file
*
count = len(dirlin)
*
* if there's nothing there, null the key return strings and return
* to the calling procedure
*
if count < 1
comment = ""
dosname = ""
pseudoname = ""
return
endif
*
* scan the dir line currently in memvar dirlin
* this code parses out the line from the dir file that was passed
* to the routine - it should accept any valid dir file line as
* input, and output several public memvars with the pertinent
* information
*
dirlin = ltrim(crtrim(dirlin)) && remove leading blanks & eol
if left(dirlin, 1) = ";" .or. left(dirlin, 1) = '!'
comment = left(dirlin, 1)
dirlin = right(dirlin, len(dirlin) - 1) && strip comment byte
if left(dirlin, 1) = ">"
dirlin = space(14) + right(dirlin, len(dirlin) - 1) && format ">"
endif
description = rtrim(dirlin) && return comment text in description
else
comment = "" && indicate not comment
fildate = ctod(" / / ") && init at blank date
filsize = 0 && ... and zero size
owner = "" && ... and no owner
description = "" && ... and no description
dosname = rtrim(left(dirlin, at(" ", dirlin))) && scan dos file name
dirlin = ltrim(right(dirlin, len(dirlin) - len(dosname)))
pseudoname = rtrim(left(dirlin, at(" ", dirlin))) && scan possible size
dirlin = ltrim(right(dirlin, len(dirlin) - len(pseudoname)))
if ltrim(str(val(pseudoname), 12, 0)) = pseudoname
filsize = val(pseudoname) && file size given
fildate = ctod(left(dirlin, at(" ", dirlin))) && scan file date
dirlin = ltrim(right(dirlin, len(dirlin) - at(" ", dirlin)))
pseudoname = rtrim(left(dirlin, at(" ", dirlin))) && scan pseudo name
dirlin = ltrim(right(dirlin, len(dirlin) - len(pseudoname)))
endif
if left(dirlin, 1) = "'"
dirlin = right(dirlin, len(dirlin) - 1)
owner = left(dirlin, at("'", dirlin)) && scan owner
dirlin = ltrim(right(dirlin, len(dirlin) - len(owner)))
owner = left(owner, len(owner) - 1) && strip trailing quote
endif
description = ltrim(rtrim(dirlin)) && rest is description
*
* if the fildate memvar is empty, then the file date and size was
* not forced in the DIR file and we'll need to look it up
*
* this code uses an undocumented technique to manipulate the internals
* that result from the use of a "findfirst" command (something which is
* usually discouraged) - as long as the internals are not CHANGED, you
* can use their information in a clever fashion (as we do here)
*
* the reason we did this here is as an alternative to the fdate() and
* fsize() functions; these functions internally issue the equivalent
* of a "findfirst" command; findfirst generates some DOS
* command overhead, so if we can do it once and read the internals,
* we'll save one DOS "findfirst" call and get some performance gains
* from it
*
* if the internals of the findfirst results are carefully analyzed,
* their format can probably be derived, but the time and date are
* bit mapped into two bytes which necessitates some manipulation of
* bits (as shown); the mapping of time (which is not actually used
* here) is included for reference
*
* the parts of particular concern are:
*
* bytes 22-23 (0 base - add 1 for substr() offset)
* time of file creation or last update
* < byte 23 > < byte 22 >
* 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
* h h h h h m m m m m m x x x x x
*
* hh is the binary number of hours (0-23)
* mm is the binary number of minutes (0-59)
* xx is the binary number of two-second increments
*
* bytes 24-25 (0 base - add 1 for substr() offset)
* date of file creation or last update
* < byte 25 > < byte 24 >
* 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0
* y y y y y y y m m m m d d d d d
*
* mm is the month (1-12)
* dd is the day (1-31)
* yy is the year minus 1980 (0-119)
*
* bytes 26-29 (0 base - add 1 for substr() offset)
* file size in bytes
*
*
if empty(fildate)
if at("\", dosname) = 0
dummy = findfirst(internal, dirpath + dosname)
else
dummy = findfirst(internal, dosname)
endif
if .not. empty(dummy)
*
* get the numeric value of the date bytes
*
stuff = (asc(substr(internal, 26, 1)) * 256) + (asc(substr(internal, 25, 1)))
*
* perform boolean math to find the numeric value of each part
* the concept is to 0-out all bytes we're not interested in,
* then if applicable (it is for everything but the day value)
* divide by the appropriate value to get the number we need
*
dd = stuff .and. 31
mm = (stuff .and. 480) / 32
yy = (stuff .and. 65024) / 512
*
* build a string of our date and convert to a real date in fildate
*
fildate = ctod(str(mm, 2)+"/"+str(dd,2)+"/"+str((yy + 1980) - 1900, 2))
*
* perform math on the 4 bytes which constitute the file size
* and store the result to filsize
*
filsize = (asc(substr(internal, 27, 1))) + (asc(substr(internal, 28, 1)) * 256) + (asc(substr(internal, 29, 1)) * 65536) + (asc(substr(internal, 30, 1)) * 16777216)
endif
endif
endif
return
*******************************************************************************
* procedures for setting colors
*******************************************************************************
*
* set yellow
*
procedure cyellow
if uansi()
set color to gr+
endif
return
*
* set white
*
procedure cwhite
if uansi()
set color to w+
endif
return
*
* set cyan
*
procedure ccyan
if uansi()
set color to bg+
endif
return
*
* set red
*
procedure cred
if uansi()
set color to r+
endif
return
*
* set green
*
procedure cgreen
if uansi()
set color to g+
endif
return