* (FBH) File Base Handler: by Douglas Bell Copyright 1991 * TBBS Version Required: 2.2+ ***************************** ** Assign PUBLIC variables ** ***************************** public tdbs public key, key2, intload, intfar, intdir, count, dirkey, desmatch public locfile public towhom, version, accesspriv public username, userpriv, expert, line, width, length, userlen, userwid public upnumber, downnumber, uprotocol, dprotocol public totalup, totaldown public daymin, daybyte, callmin public auth1, auth2, auth3, auth4 public drvpath, rampath, farfile public numfar, numdir public numext, dir_dbf, dir_ndx, des_dbf, des_ndx *************************************************** ** Default settings for dBase III+ compatibility ** *************************************************** set talk off set status off set scoreboard off **************************************** ** Optional settings for this program ** **************************************** on disconnect do goodbye on error do goodbye set typeahead to 10 set intensity off set exclusive off set softseek off set escape off set exact on set bell off ************************************************ ** Clear the screen using ANSI or Ascii codes ** ************************************************ do cls ************************** ** Start of the program ** ************************** tmp = right(ltrim(rtrim(opdata())),len(opdata())-(at("+",opdata()))) tmp1 = 0 if .NOT. empty(tmp) do while "+" $ tmp if "+" $ tmp tmp1 = tmp1 + 1 tmp = stuff(tmp,at("+",tmp),1,"þ") endif enddo private tmp0[tmp1] tmp1 = 0 do while "þ" $ tmp tmp1 = tmp1 + 1 tmp = iif(empty(substr(tmp,1,at("þ",tmp))),tmp,stuff(tmp,1,len(substr(tmp,1,at("þ",tmp))),"")) tmp0[tmp1] = left(ltrim(rtrim(tmp)),at("]",tmp)-1) tmp0[tmp1] = stuff(tmp0[tmp1],at("[",tmp0[tmp1]),1,"þ") tmp = stuff(tmp,at(tmp0[tmp1],tmp),len(tmp0[tmp1]),"") enddo endif tmp2 = tmp1 tmp1 = 0 do while tmp1 < tmp2 tmp1 = tmp1 + 1 tmp = "Fþ" && FAR file specifier if tmp $ upper(tmp0[tmp1]) farfile = left(stuff(upper(tmp0[tmp1]),1,len(tmp),""),8) drvpath = iif(.NOT. empty(farfile),homepath()+farfile+"\",farfile) endif tmp = "Rþ" && RAM drive specifier if tmp $ upper(tmp0[tmp1]) rampath = stuff(upper(tmp0[tmp1]),1,len(tmp),"") rampath = left(rampath,1)+":\"+farfile+"\" endif tmp = "Aþ" && Assume file extension specifier if tmp $ upper(tmp0[tmp1]) assume = stuff(upper(tmp0[tmp1]),1,len(tmp),"") assume = iif("." $ left(assume,1),left(stuff(assume,1,1,""),3),left(assume,3)) endif tmp = "Sþ" && All other 1 letter specifiers if tmp $ upper(tmp0[tmp1]) settings = stuff(upper(tmp0[tmp1]),1,len(tmp),"") endif enddo * ? "Fþ "+farfile * ? "Dþ "+drvpath * ? "Rþ "+rampath * ? "Aþ "+assume * ? "Sþ "+settings * wait * quit if empty(drvpath) tmpstr = "** A file must be specified for use as a FAR file! **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) tmpstr = "** Please remedy the situation and try again **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) tmpstr = "** Press any key to return to the previos menu **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) wait "" do goodbye endif ************************* ** To whom OLC belongs ** ************************* version = "File Base Handler by Douglas Bell Version: 0.1a" do c_str with version,79,"Y" *towhom = "DEMO ONLY!" && "DEMO ONLY!" Un-Registered towhom = "ŸÎÑÄƺ" && "Aquila" Kevin Behrens *towhom = "ÖÃÂÒ~¯ÊÀÍ" && "tbbs eSoft" Phil Becker *towhom = "¥Ö̌‰®»¼" && "Cul-de-Sac" Steve White do messy_str with towhom,"-" registered = "This software registered to: "+towhom do c_str with registered,79,"Y" *************************** ** Assign Misc Variables ** *************************** accesspriv = 254 dot = iif(uibm(),"ú",".") box = iif(uibm(),"þ","*") sp = 2 ************************** ** Start of the program ** ************************** *@set color to *@? chr(13)+version+chr(13) *@? registered+chr(13) *@do longline *@tmp = inkey(2) do userinfo do loadfar dirkey = "0" do loaddir key = space(40) key2 = "" intfar = 0 tmp = ulreplace(umore,0) if userwid < 80 tmp = ulreplace(uwidth,80) endif do showfar do goodbye ****************** ** Quit routine ** ****************** procedure goodbye tmp = ulreplace(umore,userlen) tmp = ulreplace(uwidth,userwid) set color to do cls close all clear typeahead quit return ***************** ** CLS routine ** ***************** procedure cls set color to If uansi() @ 0,0 clear else ?? chr(12) endIf return ***************** ** CLS routine ** ***************** procedure clsline if uansi() @ row(),0 clear to row(),79 else ? endif return *********************** ** Ansprnt routine ** *********************** procedure ansprnt if uansi() ? endif return ********************** ** LongLine routine ** ********************** procedure longline ? replicate("Ä",80) return ********************** ** TimeLeft routine ** ********************** procedure timeleft private lod = ulpeek(74,7) loh = ulpeek(77,1) lom = ulpeek(78,1) los = (loh * 3600) + (lom * 60) sec = seconds() mpd = ulpeek(149,2) mpc = ulpeek(73,1) mut = ulpeek(151,2) mrt = min(mpd-mut,mpc) dis = sec - los mrt = mrt - (dis / 60) ? ? " Minutes Per Day: " + ltrim(str(mpd)) ? " Minutes Per Call: " + ltrim(str(mpc)) ? "Minutes Used Today: " + ltrim(str(mut)) ? " Minutes Remaining: " + ltrim(str(mrt)) ? ? "Log On Date & Time: " + dtoc(lod) + " " + ltrim(str(loh)) + ":" + ltrim(str(lom)) ? ? " Current Time: " + time() ? " Current Seconds: " + ltrim(str(sec,8,2)) ? " Log On Seconds: " + ltrim(str(los,8,2)) ? " Current - Log On: " + ltrim(str(dis,8,2)) ? ? return ********************** ** Download routine ** ********************** procedure download private tmp, tmp1, tmp2, null do while .T. tmp = space(13) set color to w/n do clsline if empty(assume) if uansi() set color to w/n @ row(),0 say "Filename To Download, " set color to w+/n ?? "(" set color to bg+/n ?? "Enter" set color to w+/n ?? ")" set color to w/n ?? "=None: " set color to w+/n @ row(),col() get tmp picture "@R (xxxxxxxxxxxx)" read else accept "Filename To Download, (Enter)=None: " to tmp endif else if uansi() set color to w/n @ row(),0 say "Filename To Download, " set color to w+/n ?? "[" set color to bg+/n ?? "."+assume set color to w+/n ?? "] " set color to w/n ?? "Assumed, " set color to w+/n ?? "(" set color to bg+/n ?? "Enter" set color to w+/n ?? ")" set color to w/n ?? "=None: " set color to w+/n @ row(),col() get tmp picture "@R (xxxxxxxxxxxx)" read else accept "Filename To Download, [."+assume+"] Assumed, (Enter)=None: " to tmp endif endif tmp = left(upper(ltrim(rtrim(tmp))),12) if empty(tmp) exit endif do while at(".",tmp) <> rat(".",tmp) tmp = stuff(tmp, rat(".",tmp), 1, "") enddo do while " " $ tmp tmp = stuff(tmp, rat(" ",tmp), 1, "") enddo if .NOT. "." $ tmp .OR. at(".",tmp) > 9 tmp = left(tmp,8)+"."+assume else tmp = left(tmp,at(".",tmp)-1)+substr(tmp,at(".",tmp),4) endif select B seek "&tmp" if found() if .NOT. file(f_path) set color to bg/n ? "Un-able to locate " set color to w+/n ?? "(" set color to bg+/n ?? tmp set color to w+/n ?? ")" set color to bg/n ?? " on " set color to bg+/n ?? upper(left(f_path,2)) do ansprnt loop endif tmp1 = drvpath+"FBH_"+uline()+".DIR" set alternate to (tmp1) set alternate on set console off ?? ltrim(rtrim(f_path)) + " " + ltrim(rtrim(f_name)) set console on set alternate off close alternate null = ulreplace(umore,userlen) tmp2 = stuff(tmp1,len(tmp1)-3,4,"")+' /NL /I:"D '+tmp+'"' dotbbs type 46 optdata tmp2 null = ulreplace(umore,0) do loadfar select A goto val(dirkey) do loaddir erase &tmp1 do cls set color to w/n ?? "Download executed on file " set color to w+/n ?? "(" set color to bg+/n ?? tmp set color to w+/n ?? ")" do ansprnt exit else set color to w+/n ? "(" set color to bg+/n ?? tmp set color to w+/n ?? ")" set color to bg/n ?? " was not found in " set color to bg+/n ?? "DIR "+dirkey do ansprnt loop endif enddo set color to return * ?? ltrim(rtrim(f_path))+" " * ?? ltrim(rtrim(f_name))+" " * ?? ltrim(rtrim(str(f_size)))+" " * tmp1 = dtoc(f_date) * tmp1 = stuff(tmp1,3,1,"-") * tmp1 = stuff(tmp1,6,1,"-") * ?? ltrim(rtrim(tmp1))+" " * ?? "'"+ltrim(rtrim(f_owner))+"' " * ?? ltrim(rtrim(f_des)) ************************** ** View Archive routine ** ************************** procedure viewfile private tmp, tmp1, tmp2, null do while .T. tmp = space(13) set color to w/n do clsline if empty(assume) if uansi() set color to w/n @ row(),0 say "Filename To View, " set color to w+/n ?? "(" set color to bg+/n ?? "Enter" set color to w+/n ?? ")" set color to w/n ?? "=None: " set color to w+/n @ row(),col() get tmp picture "@R (xxxxxxxxxxxx)" read else accept "Filename To View, (Enter)=None: " to tmp endif else if uansi() set color to w/n @ row(),0 say "Filename To View, " set color to w+/n ?? "[" set color to bg+/n ?? "."+assume set color to w+/n ?? "] " set color to w/n ?? "Assumed, " set color to w+/n ?? "(" set color to bg+/n ?? "Enter" set color to w+/n ?? ")" set color to w/n ?? "=None: " set color to w+/n @ row(),col() get tmp picture "@R (xxxxxxxxxxxx)" read else accept "Filename To View, [."+assume+"] Assumed, (Enter)=None: " to tmp endif endif tmp = left(upper(ltrim(rtrim(tmp))),12) if empty(tmp) exit endif do while at(".",tmp) <> rat(".",tmp) tmp = stuff(tmp, rat(".",tmp), 1, "") enddo do while " " $ tmp tmp = stuff(tmp, rat(" ",tmp), 1, "") enddo if .NOT. "." $ tmp .OR. at(".",tmp) > 9 tmp = left(tmp,8)+"."+assume else tmp = left(tmp,at(".",tmp)-1)+substr(tmp,at(".",tmp),4) endif select B seek "&tmp" if found() if .NOT. file(f_path) set color to bg/n ? "Un-able to locate " set color to w+/n ?? "(" set color to bg+/n ?? tmp set color to w+/n ?? ")" set color to bg/n ?? " on " set color to bg+/n ?? upper(left(f_path,2)) do ansprnt loop endif tmp1 = drvpath+"FBH_"+uline()+".DIR" set alternate to (tmp1) set alternate on set console off ?? ltrim(rtrim(f_path)) + " " + ltrim(rtrim(f_name)) set console on set alternate off close alternate null = ulreplace(umore,userlen) tmp2 = stuff(tmp1,len(tmp1)-3,4,"")+' /NL /I:"E '+tmp+'"' dotbbs type 46 optdata tmp2 null = ulreplace(umore,0) do loadfar select A goto val(dirkey) do loaddir erase &tmp1 do cls set color to w/n ?? "View executed on file " set color to w+/n ?? "(" set color to bg+/n ?? tmp set color to w+/n ?? ")" do ansprnt exit else set color to w+/n ? "(" set color to bg+/n ?? tmp set color to w+/n ?? ")" set color to bg/n ?? " was not found in " set color to bg+/n ?? "DIR "+dirkey do ansprnt loop endif enddo set color to return ********************** ** FindFile routine ** ********************** procedure findfile private tmp, tmp1, tmp2, null tmp = space(13) set color to w/n do clsline if uansi() set color to w/n @ row(),0 say "Filename To Find, " set color to w+/n ?? "(" set color to bg+/n ?? "Enter" set color to w+/n ?? ")" set color to w/n ?? "=None: " set color to w+/n @ row(),col() get tmp picture "@R (xxxxxxxxxxxx)" read else accept "Filename To Find, (Enter)=None: " to tmp endif tmp = left(upper(ltrim(rtrim(tmp))),12) if empty(tmp) return else ? endif do while at(".",tmp) <> rat(".",tmp) tmp = stuff(tmp, rat(".",tmp), 1, "") enddo do while " " $ tmp tmp = stuff(tmp, rat(" ",tmp), 1, "") enddo if "." $ tmp .OR. at(".",tmp) > 9 tmp = left(tmp,at(".",tmp)-1)+substr(tmp,at(".",tmp),4) endif locfile = ltrim(rtrim(tmp)) select B set exact off set filter to locfile $ dir->f_name * select A * goto val(key) * do loaddir * if intload = 1 * return * endif ********************** intdir = 0 backtmp = 0 backfile = "" toftmp = .F. key2 = "" count = 1 length = userlen select C goto top select B goto top set color to w+/n ?? "Scanning Directory " + dirkey set color to g+/n ?? " (" + ltrim(rtrim(far->dir_desc)) + ")" ? ********************************************** do while .NOT. eof() if bof() toftmp = .T. set color to r+/n tmpstr = box+" Top Of DIR "+dirkey+" Reached "+box do c_str with tmpstr,79,"Y" ?? tmpstr+chr(13) set color to count = length-2 select B skip do dirprompt toftmp = .F. key2 = iif(key2 = "B", "b", key2) intdir = 0 count = 1 if key2 = "J" intdir = 1 endif if key2 $ "NXRS" exit endif endif if intdir = 0 set color to bg+/n ?? dir->f_name tmp = str(dir->f_size,7) set color to gr+/n ?? " " + tmp tmp = dtoc(dir->f_date) tmp = stuff(tmp,3,1,"-") tmp = stuff(tmp,6,1,"-") set color to rb+/n ?? " " + tmp tmp = iif(dtos(dir->f_date) >= dtos(ulpeek(79,7)), "*", " ") if dir->numext > 0 tmp = iif(tmp = "*", "!", "+") endif set color to w+/n ?? tmp + " " set color to g+/n ?? upper(ltrim(rtrim(dir->f_des))) + chr(13) else intdir = 0 endif do dirprompt tmp = dir->numext if intdir = 1 intdir = 0 tmp = 0 count = 1 endif if key2 $ "NXS" exit endif if tmp > 0 select C goto top tmp = ltrim(rtrim(dir->f_name)) seek "&tmp" do while des->f_name = dir->f_name set color to g+/n if intdir = 0 if uansi() @ row(),33 say upper(ltrim(rtrim(des->f_ext)))+chr(13) else ?? space(33) + upper(ltrim(rtrim(des->f_ext)))+chr(13) endif endif do dirprompt if intdir = 1 intdir = 0 count = 1 exit endif if key2 $ "NXS" exit endif select C skip enddo if key2 $ "NXS" exit endif endif select B if key2 = "J" key2 = "+" intdir = 0 else if key2 $ "-þ" skip -1 else if key2 $ "Bb" if key2 = "b" skip endif key2 = "b" else skip toftmp = .F. endif endif endif if eof() set color to r+/n tmpstr = box+" Scan Complete On DIR "+dirkey+" "+box do c_str with tmpstr,79,"Y" ?? tmpstr+chr(13) set color to exit endif enddo if key2 = "C" length = userlen endif ******************** set filter to set exact on numfiles = 0 if numfiles > 0 set color to w+/n ? "(" set color to bg+/n ?? tmp set color to w+/n ?? ")" set color to bg/n ?? " was not found in " set color to bg+/n ?? "DIR "+dirkey do ansprnt endif set color to locfile = " " return ****************************************** ** Load the .FAR file and process DIR's ** ****************************************** procedure loadfar private null null = iif(file(rampath+farfile+".DBF"),rampath+farfile+".DBF",drvpath+farfile+".DBF") if file(null) select A use &null alias far numfar = ltrim(str(reccount())) goto top else tmpstr = "** Unable to find: "+null+" **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) tmpstr = "** Please notify the SysOp **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) tmpstr = "** File directories are currently UN-available **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) tmpstr = "Press any key to return to the previous menu." do c_str with tmpstr,79,"Y" ? tmpstr do longline wait "" do goodbye endif return ************************** ** Show the FAR screens ** ************************** procedure showfar do cls If uansi() ext = ".AN" else ext = ".AS" endIf num = 1 tmp = iif(file(rampath+farfile+ext+ltrim(str(num))),rampath+farfile+ext,drvpath+farfile+ext) if .NOT. file(tmp+ltrim(str(num))) ext = ".AS" endif do while .T. if .NOT. file(tmp+ltrim(str(num))) exit endif set color to type (tmp+ltrim(str(num))) num = num + 1 tmp = iif(file(rampath+farfile+ext+ltrim(str(num))),rampath+farfile+ext,drvpath+farfile+ext) if .NOT. file(tmp+ltrim(str(num))) intfar = 1 set color to w/n ?? "Press " set color to w+/n ?? "(" set color to bg+/n ?? "Enter" set color to w+/n ?? ")" set color to w/n ?? " For The Main Menu Or" do ansprnt else set color to w/n ?? "Press " set color to w+/n ?? "(" set color to bg+/n ?? "Enter" set color to w+/n ?? ")" set color to w/n ?? " For Page "+ltrim(str(num))+" Or" do ansprnt endif do farprompt if intfar = 1 do goodbye endif enddo return **************************** ** Display the FAR prompt ** **************************** procedure displayfar set color to if uansi() do clsline set color to w+/n ?? "(" set color to bg+/n ?? "1-"+numfar set color to w+/n ?? ")" set color to w/n ?? ", " set color to w+/n ?? "(" set color to bg+/n ?? "H" set color to w+/n ?? ")" set color to w/n ?? "elp, File List Command? " key = space(40) @ row(),col() get key picture "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" read else accept "(1-"+numfar+"), (H)elp, File List Command? " to key ?? "(1-"+numfar+"), (H)elp, File List Command? " endif key = upper(ltrim(rtrim(key))) set color to return ***************************** ** Prompt for Input at FAR ** ***************************** procedure farprompt do while .T. if key2 = "R" key2 = "" key = "R" else do displayfar endif clear typeahead do case case key = "H" ? set color to w+/n ? " (" set color to bg+/n ?? "Enter" set color to w+/n ?? ") " set color to w/n ?? "Displays Next Page Of The Directory Or Exits The File Base" set color to w+/n ? " (" set color to bg+/n ?? "###" set color to w+/n ?? ") " set color to w/n ?? "Displays The File List For That Area" set color to w+/n ? " (" set color to bg+/n ?? "C" set color to w+/n ?? "/" set color to bg+/n ?? "NS" set color to w+/n ?? ") " set color to w/n ?? "When After ###, Displays The File List In Non-Stop Mode" set color to w+/n ? " (" set color to bg+/n ?? "+" set color to w+/n ?? "/" set color to bg+/n ?? "-" set color to w+/n ?? ") " set color to w/n ?? "Display The (Next/Previous) Page Of The Directory" set color to w+/n ? " (" set color to bg+/n ?? "R" set color to w+/n ?? ") " set color to w/n ?? "Re-Display The Directory Menu (Starting With Page 1)" set color to w+/n ? " (" set color to bg+/n ?? "V" set color to w+/n ?? ") " set color to w/n ?? "Lists Files Inside Of An Archive" set color to w+/n ? " (" set color to bg+/n ?? "U" set color to w+/n ?? ") " set color to w/n ?? "Upload A File (Single Or Batch)" set color to w+/n ? " (" set color to bg+/n ?? "D" set color to w+/n ?? ") " set color to w/n ?? "Download A File (Single Or Batch)" set color to w+/n ? " (" set color to bg+/n ?? "F" set color to w+/n ?? "/" set color to bg+/n ?? "T" set color to w+/n ?? ") " set color to w/n ?? "Tag Files For Later Download" set color to w+/n ? " (" set color to bg+/n ?? "S" set color to w+/n ?? ") " set color to w/n ?? "Send Or Input A List Of Files To Download (via ASCII)" set color to w+/n ? " (" set color to bg+/n ?? "G" set color to w+/n ?? ") " set color to w/n ?? "GoodBye, Log Off Of "+towhom+chr(13) do ansprnt set color to loop case key = "+" .OR. len(key) = 0 exit case key = "TIME" do timeleft intfar = 1 loop case key = "INFO" if userpriv >= 254 tmp = ltrim(rtrim(substr(far->dir_file,2))) tmp = iif(file(left(rampath+farfile,1)+tmp+"_1.DBF"),left(rampath+farfile,1)+tmp+"_1.DBF",ltrim(rtrim(far->dir_file))+"_1.DBF") set color to bg+/n ? chr(13)+version() ? "Running under "+os()+chr(13) ? "Number of users currently in ANY TDBS application : "+str(nusers(),2) ? "Number of users currently in THIS TDBS application: "+str(nmyusers(),2)+chr(13) ? "This area is "+iif(isshare(using()),"","not ")+"currently being shared." ? "("+using(1)+")"+chr(13) select B ? "DBF file currently being used "+upper(dbf()) ? "NDX file currently being used "+upper(ndx(1)) select C ? "DBF file currently being used "+upper(dbf()) ? "NDX file currently being used "+upper(ndx(1))+chr(13) do ansprnt intfar = 1 loop endif exit case key = "-" if intfar = 1 intfar = 0 num = num - 2 num = iif(num<1,1,num) do showfar else intfar = 0 num = num - 2 num = iif(num<1,1,num) exit endif case key = "R" if intfar = 1 intfar = 0 num = 1 do showfar else intfar = 0 num = 1 exit endif case key = "D" do download case key = "U" * do upload case key = "V" do viewfile case key = "L" do findfile case key = "S" * do sendlist case key = "F" .OR. key = "T" * do filetag case key = "G" if uansi() do clsline set color to w+/n ?? "(" set color to r+/n ?? "N" set color to w+/n ?? ")" set color to w/n ?? "o Delays, Logoff Of " + towhom + " Now! " set color to w+/n ?? "(" set color to r+/n ?? "Enter" set color to w+/n ?? ")" set color to w/n ?? "=Continue? " set color to else ? "(N)o Delays, Logoff Of " + towhom + " Now! (Enter)=Continue? " endif if upper(chr(inkey(0))) = "N" tmp = ulreplace(umore,userlen) tmp = ulreplace(uwidth,userwid) set color to do cls close all dotbbs type 10 optdata "*none*" endif case val(key) >= 1 .AND. val(key) <= val(numfar) dirkey = ltrim(rtrim(key)) intfar = 1 do showdir endcase enddo return ********************* ** LoadDir routine ** ********************* procedure loaddir private tmp intload = 0 tmp = ltrim(rtrim(far->dir_file)) tmp = rampath+substr(tmp,rat("\",tmp)+1) tmp = iif(file(tmp+"_1.DBF"),tmp,ltrim(rtrim(far->dir_file))) dir_dbf = iif(file(tmp+"_1.DBF"),tmp+"_1",ltrim(rtrim(far->dir_file))+"_1") if .NOT. file(tmp+"_1.DBF") if dirkey = "0" tmpstr = "** FBH Must Be Able To Find Directory 1 To Proceed **" do c_str with tmpstr,79,"Y" ? chr(13)+tmpstr+chr(13) tmpstr = "** Please Notify The SysOp **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) tmpstr = "** Press Any Key To Continue **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) do longline wait "" do goodbye endif tmpstr = "** Unable To Find File Directory "+dirkey+" **" do c_str with tmpstr,79,"Y" ? chr(13)+tmpstr+chr(13) tmpstr = "** Please Notify The SysOp **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) do longline intload = 1 return endif tmp = ltrim(rtrim(far->dir_file)) tmp = rampath+substr(tmp,rat("\",tmp)+1) tmp = iif(file(tmp+"_1.NDX"),tmp,ltrim(rtrim(far->dir_file))) dir_ndx = iif(file(tmp+"_1.NDX"),tmp+"_1",ltrim(rtrim(far->dir_file))+"_1") if .NOT. file(tmp+"_1.NDX") if dirkey = "0" tmpstr = "** FBH Must Be Able To Find Directory 1 To Proceed **" do c_str with tmpstr,79,"Y" ? chr(13)+tmpstr+chr(13) tmpstr = "** Please Notify The SysOp **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) tmpstr = "** Press Any Key To Continue **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) do longline wait "" do goodbye endif tmpstr = "** Unable To Find File Index For Directory "+dirkey+" **" do c_str with tmpstr,79,"Y" ? chr(13)+tmpstr+chr(13) tmpstr = "** Please Notify The SysOp **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) do longline intload = 1 return endif tmp = ltrim(rtrim(far->dir_file)) tmp = rampath+substr(tmp,rat("\",tmp)+1) tmp = iif(file(tmp+"_2.DBF"),tmp,ltrim(rtrim(far->dir_file))) des_dbf = iif(file(tmp+"_2.DBF"),tmp+"_2",ltrim(rtrim(far->dir_file))+"_2") if .NOT. file(tmp+"_2.DBF") if dirkey = "0" tmpstr = "** FBH Must Be Able To Find Directory 1 To Proceed **" do c_str with tmpstr,79,"Y" ? chr(13)+tmpstr+chr(13) tmpstr = "** Please Notify The SysOp **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) tmpstr = "** Press Any Key To Continue **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) do longline wait "" do goodbye endif tmpstr = "** Unable To Find Extension Directory "+dirkey+" **" do c_str with tmpstr,79,"Y" ? chr(13)+tmpstr+chr(13) tmpstr = "** Please Notify The SysOp **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) do longline intload = 1 return endif tmp = ltrim(rtrim(far->dir_file)) tmp = rampath+substr(tmp,rat("\",tmp)+1) tmp = iif(file(tmp+"_2.NDX"),tmp,ltrim(rtrim(far->dir_file))) des_ndx = iif(file(tmp+"_2.NDX"),tmp+"_2",ltrim(rtrim(far->dir_file))+"_2") if .NOT. file(tmp+"_2.NDX") if dirkey = "0" tmpstr = "** FBH Must Be Able To Find Directory 1 To Proceed **" do c_str with tmpstr,79,"Y" ? chr(13)+tmpstr+chr(13) tmpstr = "** Please Notify The SysOp **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) tmpstr = "** Press Any Key To Continue **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) do longline wait "" do goodbye endif tmpstr = "** Unable To Find File Extension Index For Directory "+dirkey+" **" do c_str with tmpstr,79,"Y" ? chr(13)+tmpstr+chr(13) tmpstr = "** Please Notify The SysOp **" do c_str with tmpstr,79,"Y" ? tmpstr+chr(13) do longline intload = 1 return endif ******************** ** Open databases ** ******************** select B use use &dir_dbf index &dir_ndx alias dir numdir = reccount() - 1 numdir = iif(numdir < 1,0,numdir) numdir = ltrim(str(numdir)) select C use use &des_dbf index &des_ndx alias des dirkey = iif(dirkey = "0","1",dirkey) return ********************* ** ShowDir routine ** ********************* procedure showdir do cls select A goto val(key) do loaddir if intload = 1 return endif select B set color to n+/n ?? "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·" ? "³" tmp = iif(empty(far->dir_desc),"Future",far->dir_desc) tmpstr = towhom+" Directory Listing: " + tmp do c_str with tmpstr,77,"Y" set color to w+/b+ ?? tmpstr set color to n+/n ?? "º" ? "³ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹" ? "³" tmp = dtoc(date()) tmp = stuff(tmp,3,1,"-") tmp = stuff(tmp,6,1,"-") set color to gr+/n ?? " Current As Of: " set color to bg+/n ?? tmp + " " set color to gr+/n ?? "Number Of Files: " set color to bg+/n tmp = iif(far->num_files <= 0, "0", ltrim(rtrim(str(far->num_files)))) ?? tmp ?? space(15-len(tmp)) set color to n+/n ?? "º" ? "³" tmp = dtoc(far->new_file) tmp = stuff(tmp,3,1,"-") tmp = stuff(tmp,6,1,"-") set color to gr+/n ?? " Most Recent File: " set color to bg+/n ?? tmp + " " set color to gr+/n ?? "Number Of Bytes: " set color to bg+/n tmp = iif(far->total_size <= 0, "0", ltrim(rtrim(str(far->total_size)))) ?? tmp ?? space(15-len(tmp)) set color to n+/n ?? "º" ? "³ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ" ? "³" set color to r+/n ?? " FileName Size Date Description " set color to n+/n ?? "º" ? "ÀÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ" ? if val(numdir) = 0 set color to r+/n tmpstr = box+" No Files Found In DIR "+dirkey+" "+box do c_str with tmpstr,79,"Y" ?? tmpstr+chr(13) set color to return endif set color to r+/n tmpstr = box+" Top Of DIR "+dirkey+" "+box do c_str with tmpstr,79,"Y" ?? tmpstr+chr(13) set color to ********************** set filter to set exact on intdir = 0 backtmp = 0 backfile = "" toftmp = .F. key2 = "" count = 9 length = userlen select C goto top select B goto top do while .NOT. eof() if bof() toftmp = .T. set color to r+/n tmpstr = box+" Top Of DIR "+dirkey+" Reached "+box do c_str with tmpstr,79,"Y" ?? tmpstr+chr(13) set color to count = length-2 select B skip do dirprompt toftmp = .F. key2 = iif(key2 = "B", "b", key2) intdir = 0 count = 1 if key2 = "J" intdir = 1 endif if key2 $ "NXRS" exit endif endif if intdir = 0 set color to bg+/n ?? dir->f_name tmp = str(dir->f_size,7) set color to gr+/n ?? " " + tmp tmp = dtoc(dir->f_date) tmp = stuff(tmp,3,1,"-") tmp = stuff(tmp,6,1,"-") set color to rb+/n ?? " " + tmp tmp = iif(dtos(dir->f_date) >= dtos(ulpeek(79,7)), "*", " ") if dir->numext > 0 tmp = iif(tmp = "*", "!", "+") endif set color to w+/n ?? tmp + " " set color to g+/n ?? upper(ltrim(rtrim(dir->f_des))) + chr(13) else intdir = 0 endif do dirprompt tmp = dir->numext if intdir = 1 intdir = 0 tmp = 0 count = 1 endif if key2 $ "NXS" exit endif if tmp > 0 select C goto top tmp = ltrim(rtrim(dir->f_name)) seek "&tmp" do while des->f_name = dir->f_name set color to g+/n if intdir = 0 if uansi() @ row(),33 say upper(ltrim(rtrim(des->f_ext)))+chr(13) else ?? space(33) + upper(ltrim(rtrim(des->f_ext)))+chr(13) endif endif do dirprompt if intdir = 1 intdir = 0 count = 1 exit endif if key2 $ "NXS" exit endif select C skip enddo if key2 $ "NXS" exit endif endif select B if key2 = "J" key2 = "+" intdir = 0 else if key2 $ "-þ" skip -1 else if key2 $ "Bb" if key2 = "b" skip endif key2 = "b" else skip toftmp = .F. endif endif endif if eof() set color to r+/n tmpstr = box+" End Of DIR "+dirkey+" "+box do c_str with tmpstr,79,"Y" ?? tmpstr+chr(13) set color to exit endif enddo if key2 = "C" length = userlen endif return **************************** ** Display the DIR prompt ** **************************** procedure displaydir set color to if uansi() do clsline set color to w+/n ?? "(" set color to bg+/n ?? "DIR "+dirkey set color to w+/n ?? ")" set color to w/n ?? ", " set color to w+/n ?? "(" set color to bg+/n ?? "H" set color to w+/n ?? ")" set color to w/n ?? "elp, " set color to w+/n ?? "(" set color to bg+/n ?? "V" set color to w+/n ?? ")" set color to w/n ?? "iew, " set color to w+/n ?? "(" set color to bg+/n ?? "F" set color to w+/n ?? ")" set color to w/n ?? "lag, More" set color to w+/n ?? "(" set color to bg+/n ?? "Y" set color to w+/n ?? "/" set color to bg+/n ?? "n" set color to w+/n ?? "/" set color to bg+/n ?? "c" set color to w+/n ?? ")" set color to w/n ?? "? " else ?? "(DIR "+dirkey+"), (H)elp, (V)iew, (F)lag, More(Y/n/c)? " endif set color to return *********************** ** DirPrompt routine ** *********************** procedure dirprompt tmp0 = upper(chr(inkey())) if asc(tmp0) = 32 length = userlen count = length - 2 clear typeahead endif if tmp0 = "X" .OR. tmp0 = "N" .OR. tmp0 = "S" key2 = "N" length = userlen clear typeahead endif if tmp0 = "P" tmp0 = upper(chr(inkey(0))) if tmp0 = "X" .OR. tmp0 = "N" .OR. tmp0 = "S" key2 = "N" length = userlen clear typeahead else clear typeahead endif endif count = count + 1 if count = length-1 count = 0 if asc(tmp0) = 32 intdir = 1 endif do displaydir do while .T. key2 = ltrim(rtrim(upper(chr(inkey(0))))) key2 = iif(key2 = "þ","",key2) clear typeahead do case case key2 = "H" set color to w+/n do clsline set color to w+/n ? " (" set color to bg+/n ?? "Enter" set color to w+/n ?? "/" set color to bg+/n ?? "Y" set color to w+/n ?? "/" set color to bg+/n ?? "+" set color to w+/n ?? ") " set color to w/n ?? "Continue On With The File List" set color to w+/n ? " (" set color to bg+/n ?? "-" set color to w+/n ?? ") " set color to w/n ?? "Move Backward Through The File List" set color to w+/n ? " (" set color to bg+/n ?? "B" set color to w+/n ?? ") " set color to w/n ?? "Move To The Top Of The File List" set color to w+/n ? " (" set color to bg+/n ?? "J" set color to w+/n ?? ") " set color to w/n ?? "Jump To Where You Were Before Pressing The (-/B) Keys" set color to w+/n ? " (" set color to bg+/n ?? "C" set color to w+/n ?? ") " set color to w/n ?? "Continous Display Of The File List (Non-Stop)" set color to w+/n ? " (" set color to bg+/n ?? "SpaceBar" set color to w+/n ?? ") " set color to w/n ?? "Returns The DIR Prompt To You At Any Time" ? " Press (Enter), (Y) Or (+) To Continue From Where You Stopped" set color to w+/n ? " (" set color to bg+/n ?? "S" set color to w+/n ?? "/" set color to bg+/n ?? "X" set color to w+/n ?? "/" set color to bg+/n ?? "N" set color to w+/n ?? ") " set color to w/n ?? "Stop The File List" set color to w+/n ? " (" set color to bg+/n ?? "P" set color to w+/n ?? ") " set color to w/n ?? "Pause The File List (Any Key To Resume)" set color to w+/n ? " (" set color to bg+/n ?? "V" set color to w+/n ?? ") " set color to w/n ?? "View Inside An Archived File (ZIP, ARC, SIT, etc.)" set color to w+/n ? " (" set color to bg+/n ?? "D" set color to w+/n ?? ") " set color to w/n ?? "Download A File, Then Continue The File List" set color to w+/n ? " (" set color to bg+/n ?? "F" set color to w+/n ?? "/" set color to bg+/n ?? "T" set color to w+/n ?? ") " set color to w/n ?? "Flag Files For Later Download, Then Continue The File List" set color to w+/n ? " (" set color to bg+/n ?? "G" set color to w+/n ?? ") " set color to w/n ?? "GoodBye, Log Off Of "+towhom+chr(13) set color to ? do displaydir loop case key2 = "G" if uansi() do clsline set color to w+/n ?? "(" set color to r+/n ?? "N" set color to w+/n ?? ")" set color to w/n ?? "o Delays, Logoff Of " + towhom + " Now! " set color to w+/n ?? "(" set color to r+/n ?? "Enter" set color to w+/n ?? ")" set color to w/n ?? "=Continue? " set color to else ? "(N)o Delays, Logoff Of " + towhom + " Now! (Enter)=Continue? " endif if upper(chr(inkey(0))) = "N" tmp = ulreplace(umore,userlen) tmp = ulreplace(uwidth,userwid) set color to do cls close all dotbbs type 10 optdata "*none*" else do clsline do displaydir loop endif case key2 = "B" if backtmp = 0 intdir = 1 backtmp = 2 backfile = dir->f_name else intdir = 1 endif count = 1 set color to r+/n tmpstr = box+" Moving To The Top Of DIR "+dirkey+" "+box do c_str with tmpstr,79,"Y" do clsline if uansi() ?? tmpstr+chr(13) else ?? tmpstr endif set color to select C goto top select B goto top exit case key2 = "+" .OR. asc(key2) = 13 if backtmp = 1 .OR. backtmp = 2 key2 = "+" intdir = 1 backtmp = 0 else intdir = 0 endif count = 1 set color to r+/n tmpstr = box+" Moving Forward One Page In DIR "+dirkey+" "+box do c_str with tmpstr,79,"Y" do clsline if uansi() ?? tmpstr+chr(13) else ?? tmpstr endif case key2 = "V" dotbbstmp = dir->f_name do viewfile select B seek "&dotbbstmp" do clsline do displaydir loop case key2 = "D" dotbbstmp = dir->f_name do download select B seek "&dotbbstmp" do clsline do displaydir loop case key2 = "C" length = 0 case key2 = "J" if backtmp = 1 .OR. backtmp = 2 intdir = 1 backtmp = 0 set color to r+/n tmpstr = box+" Returning You To Where You Were Before Pressing (-) or (B) "+box do c_str with tmpstr,79,"Y" do clsline if uansi() ?? tmpstr+chr(13) else ?? tmpstr endif set color to select C goto top select B goto top seek "&backfile" exit else loop endif case key2 = "-" if toftmp loop endif if backtmp = 0 intdir = 1 backtmp = 1 backfile = dir->f_name else if backtmp = 1 intdir = 0 else intdir = 1 endif endif count = 1 set color to r+/n tmpstr = box+" Moving Backward One Page In DIR "+dirkey+" "+box do c_str with tmpstr,79,"Y" do clsline if uansi() ?? tmpstr+chr(13) else ?? tmpstr endif set color to case key2 $ "NXS" otherwise loop endcase exit enddo do clsline endif return ************************************ ** How: do messy_str with tmp,"+" ** ************************************ procedure messy_str parameters miustr, route private tmp, tmpchr, tmpstr, tmpplus, tmpminus, tmpval tmp = 0 tmpchr = "" tmpstr = "" tmpval = 89 if route = "+" .OR. empty(route) do while tmp < len(miustr) tmp = tmp+1 tmpchr = substr(miustr,tmp,1) tmpplus = asc(tmpchr)+tmpval+(len(miustr)-tmp) tmpchr = iif(tmpplus>255,chr(tmpplus-254),chr(tmpplus)) tmpstr = tmpstr+tmpchr enddo else do while tmp < len(miustr) tmp = tmp+1 tmpchr = substr(miustr,tmp,1) tmpminus = asc(tmpchr)-tmpval-(len(miustr)-tmp) tmpchr = iif(tmpminus<0,chr(tmpminus+254),chr(tmpminus)) tmpstr = tmpstr+tmpchr enddo endif miustr = tmpstr return ********************************************************* ** c_str() - Centers with leading and trailing spaces. ** ** usage - do c_str "The End",80,"Y" ** ********************************************************* procedure c_str parameters string,strlen,strip private tmp,lead,trail if upper(strip) = "N" lead = int((strlen-len(string))/2) trail = strlen-lead-len(string) string = space(lead)+string+space(trail) else lead = int((strlen-len(ltrim(rtrim(string))))/2) trail = strlen-lead-len(ltrim(rtrim(string))) string = space(lead)+ltrim(rtrim(string))+space(trail) endif return **************************************** ** Retreive UserInfo from Userlog.bbs ** **************************************** procedure userinfo line = right(space(2)+uline(),2) username = left(uname()+space(30),30) expert = ulpeek(69,1) userpriv = upriv() userwid = uwidth() width = userwid userlen = umore() length = userlen upnumber = ulpeek(239,1) downnumber = ulpeek(240,1) totalup = right(space(8)+ltrim(rtrim(str(ulpeek(139,4)/1024000,7,1))),7) totaldown = right(space(8)+ltrim(rtrim(str(ulpeek(135,4)/1024000,7,1))),7) daymin = left(ltrim(rtrim(str(ulpeek(149,2),4)))+space(16),16) daymin = iif(daymin="0","Infinite",daymin) daybyte = left(ltrim(rtrim(str(ulpeek(143,4),8)))+space(16),16) daybyte = iif(daybyte="0","Infinite",daybyte) callmin = left(ltrim(rtrim(str(ulpeek(73,1),3)))+space(16),16) callmin = iif(callmin="0","Infinite",callmin) auth1 = ltrim(rtrim(uauth(1))) auth2 = ltrim(rtrim(uauth(2))) auth3 = ltrim(rtrim(uauth(3))) auth4 = ltrim(rtrim(uauth(4))) return **************************** ** Select proper protocol ** **************************** procedure protocol do case ** Upload Protocol ** case upnumber = 0 uprotocol = "Auto Select " case upnumber = 1 uprotocol = "Ascii (Prompted) " case upnumber = 2 uprotocol = "Ascii (XON ) " case upnumber = 3 uprotocol = "Ascii (XON/XOFF) " case upnumber = 4 uprotocol = "XModem " case upnumber = 5 uprotocol = "XModem-1k " case upnumber = 6 uprotocol = "YModem Batch " case upnumber = 7 uprotocol = "YModem-G Batch " case upnumber = 8 uprotocol = "SEAlink " case upnumber = 9 uprotocol = "Kermit " case upnumber = 10 uprotocol = "Super Kermit " case upnumber = 11 uprotocol = "ZModem-90(Tm) " case upnumber > 12 uprotocol = " * * Unknown * * " ** Download Protocol ** case downnumber = 0 dprotocol = "Auto Select " case downnumber = 1 dprotocol = "Ascii to Screen " case downnumber = 2 dprotocol = "Ascii (^R/^T) " case downnumber = 3 dprotocol = "Ascii (Pure) " case downnumber = 4 dprotocol = "XModem " case downnumber = 5 dprotocol = "XModem-1k " case downnumber = 6 dprotocol = "YModem Batch " case downnumber = 7 dprotocol = "YModem-G Batch " case downnumber = 8 dprotocol = "SEAlink " case downnumber = 9 dprotocol = "Kermit " case downnumber = 10 dprotocol = "Super Kermit " case downnumber = 11 dprotocol = "ZModem-90(Tm) " case downnumber > 12 dprotocol = " * * Unknown * * " endcase return ******************* * FUNCTION FINDIT * ******************* procedure findit parameters lookstr, field lookstr = upper(trim(lookstr)) lowlim = 0 uplim = reccount() + 1 do while uplim > lowlim + 1 point = int((uplim - lowlim) / 2) + lowlim goto point do case case lookstr > substr(upper(&field),1,len(lookstr)) lowlim = point case lookstr < substr(upper(&field),1,len(lookstr)) uplim = point otherwise if point = lowlim + 1 return(.T.) else uplim = point + 1 endif endcase enddo return(.F.)