/**/ /*// */ /*\\ Upl v1.0 - (c) S.Gillibrand 1996 - Digital Design Production */ /*// */ /*\\ This programme is a replacement for the standard TransAmiga UPLOAD */ /*// command */ /*\\ */ /*// Edit these variables Mr.SysOp :-) */ /*\\ See The Docs For Further Details On These */ /*// */ unarcd="T:" /* Path To Unarchive The FILE_ID.DIZ's to */ descln=10 /* Maximum Number Of Lines Of Description */ maxdiz=15 /* Maximum Number Of Lines Taken From DIZ */ upldev="BBS:" /* Actual PHYSICAL Device of Upload Drive */ switch=1 /* Area To Switch To If User's Access */ /* Isn't High Enough To Upload To Area */ logging=1 /* Logging To TransAmiga.Log? 1=On, 0=Off */ ulbonus=2 /* Integer To Multiply Time Taken To */ /* Upload By, As A Time Bonus For User */ /* 0=No Time Bonus */ /* -1=Don't Even Refund Time Taken To Ul */ /*\\ */ /**/ Options Results Signal On Syntax sl=sysoplog ver$="1.0" monty.JAN="01" monty.FEB="02" monty.MAR="03" monty.APR="04" monty.MAY="05" monty.JUN="06" monty.JUL="07" monty.AUG="08" monty.SEP="09" monty.OCT="10" monty.NOV="11" monty.DEC="12" Userinfo 'a' username=result Userinfo 'x' Ansi=result if ansi="ON" then do up="" lclr="" red="" grn="" yel="" blu="" mag="" cyn="" wht="" bred="" bgrn="" byel="" bblu="" bmag="" bcyn="" bwht="" bld="" fsh="" clr="" end else do up="" lclr="" red="" grn="" yel="" blu="" mag="" cyn="" wht="" bred="" bgrn="" byel="" bblu="" bmag="" bcyn="" bwht="" bld="" fsh="" clr="" end ab=0 tots=0 systeminfo '8' line=result if right(unarcd,1)~="/"&right(unarcd,1)~=":" then unarcd=unarcd'/' sendfile "BBS:Text/Preupload" userinfo 'o' useraccess=result systeminfo '7' upt=result userinfo '7' frat=result userinfo '$' brat=result cls newline if logging=1 then sl " [Upl] Upl v"ver$" Started - Digital Design 96'" print bld||blu"["wht"Upl v"ver$" - (c) S.Gillibrand 1995 - Digital Design Production"blu"]" newline print grn"Please Wait..." call readarealist do i=1 to areas if upper(path.i)=upper(upt)&useraccessram:nink' call open(In,'ram:nink','r') data=readln(in) call close(in) sfree=right(data,length(data)-length(upldev)) address command 'info "'upldev'" >ram:nink' call open(In,'ram:nink','r') do 3;dummy=readln(in);end data=readln(in) sfull=word(data,5) call close(in) address command 'delete ram:nink QUIET >NIL:' print yel"Space Free On Upload Device:"mag||sfree||yel" ("mag||sfull" Full"yel")" if logging=1 then sl " [Upl] Protocol: "proto if logging=1 then sl " [Upl] Space :"sfree" ("sfull" Full)" newline print grn"Waiting For File(s)..." if line=0 then craydead="T:Xfers.Temp" else craydead="T:Xfers_"line".Temp" BBSIDENTIFY TERM lres=result locl=0 err=time('r') if word(lres,1)=80&word(lres,3)=0 then do locl=1 newline if logging=1 then sl " [Upl] Local Logon Detected" queryy "Local Logon, Select File(s) For Upload?" if upper(result)="N" then signal boomtown if logging=1 then sl " [Upl] Awaiting Local Upload" if exists("C:Requestfile") then do if logging=1 then sl " [Upl] Using File Requester" address command 'requestfile MULTISELECT TITLE "...Upl: Select File(s)..." >T:RFR' call open(ind,'T:RFR','r') filez=translate(readln(ind),'','"') if compress(filez)="nomoreentriesindirectory" then signal boomtown call close(in) call open(oud,craydead,'w') call open(ox,'T:DelSmeg','w') do b=1 to words(filez) wingman=word(filez,b) if pos(":",wingman)=0&pos("/",wingman)=0 then wingman='SYS:'wingman call writeln(oud,wingman) address command "copy "wingman" "upt" >NIL: NIL:') end call close(ox) call close(oud) end else do if logging=1 then sl " [Upl] Using Manual Strings" call open(oud,craydead,'w') call pragma('Directory',upt) call open(ox,'T:DelSmeg','w') do until upper(wingman)="RESULT"|compress(wingman)="" prompt 60 'NORMAL' '"'bld||yel'Enter Filename: 'red'"' wingman=result if upper(wingman)~="RESULT"&compress(wingman)~="" then call writeln(oud,wingman) address command "copy "wingman" "upt" >NIL: NIL:') end call close(ox) call close(oud) end call open(int,craydead,'r') size=seek(int,0,'E') call close(int) if size<3 then signal boomtown end if locl=0 then protocolreceive upt if ~open(in,craydead,'r') then signal boomtown if exists('bbs:Rexx/upload.trans') then call 'bbs:Rexx/upload.trans' send bld||grn"Processing File(s)..." files=0 call pragma('Directory',unarcd) do until eof(in) fpath=readln(in) spesh='/' if pos('/',fpath)=0 then spesh=':' if compress(fpath)="" then leave files=files+1 fname=reverse(delstr(reverse(fpath),pos(spesh,reverse(fpath)))) filepath.files=fpath filename.files=fname end call close(in) newline;newline print yel"Files Uploaded: "wht"["red||files||wht"]" print "Please Wait..." newline if logging=1 then sl " [Upl] Files Uploaded: "files call open(in,'BBS:Configs/file.cfg','r') do 3;dummy=readln(in);end dat=compress(readln(in)) do dat*8;dummy=readln(in);end dat=compress(readln(in)) do dat*3;dummy=readln(in);end dat=compress(readln(in)) do dat*4;dummy=readln(in);end narc=compress(readln(in)) if narc>0 then do do i=1 to narc suffix.i=readln(in) comm.i=readln(in) end end call close(in) call open(dOut,'T:Upl_'line'.Dat','W') call writeln(dOut,'@-UplData') call writeln(dOut,files) do i=1 to files if ~exists(filepath.i) then iterate call open(in,filepath.i,'r') fsize=seek(in,0,'e') call close(in) dar=date() bean=upper(substr(dar,4,3)) dmy=right(dar,2)||monty.bean||left(dar,2) chunk=upt'Files.BBS' if ~exists(chunk) then call open(fbbs,chunk,'w') else call open(fbbs,chunk,'a') found=0 if logging=1 then sl " [Upl] File: "filename.i call writeln(dOut,filename.i) call writeln(dOut,upt||filename.i) call writeln(dOut,fsize) if narc>0 then do send CYN"Checking "YEL||left(filename.i,22)||CYN" For "MAG"FILE_ID.DIZ"CYN" Description..." do ii=1 to narc ltc=upper(right(filename.i,length(suffix.ii))) if ltc=upper(suffix.ii) then do don=pos('%f',comm.ii) if don>0 then do comic=left(comm.ii,don-1)||filepath.i||right(comm.ii,length(comm.ii)-(don+1)) don=pos('%w',comic) if don>0 then do comic=left(comic,don-1)||unarcd||right(comic,length(comic)-(don+1)) address command "delete "unarcd"FILE_ID.DIZ >NIL:" address command comic" NIL:" found=1 end end end end end call writeln(dOut,'#desc') if found=1&exists(unarcd"FILE_ID.DIZ") then do if logging=1 then sl " [Upl] FILE_ID.DIZ Found" send GRN"Found." newline call open(in,unarcd"FILE_ID.DIZ",'r') call writeln(fbbs,left(filename.i,23)' 'right(fsize,7)' 'left(dmy,6)' File_ID.DIZ description') do maxdiz deoy=readln(in) if eof(in) then leave call writeln(fbbs,'\'copies(' ',33)||left(deoy,45)) call writeln(dOut,left(deoy,45)) end call close(in) call open(oudes,upt||filename.i'.Desc','w') call writeln(oudes,username) call close(oudes) newline end else do if narc>0 then do send RED"Not Found." if logging=1 then sl " [Upl] FILE_ID.DIZ Not Found" end newline;newline print wht" Please Enter Up To "right(descln,2,'0')" Lines Description." print blu||bld" [--------------------------------------]"clr do z=1 to descln do until compress(upper(descline.z))~="RESULT"|z>1 prompt 40 'NORMAL' '"'bld||cyn||right(z,2,'0')||wht': 'grn'"' descline.z=result end newline if compress(upper(descline.z))="RESULT" then leave end z=z-1 newline call open(oudes,upt||filename.i'.Desc','w') call writeln(oudes,username) bigdes=0 queryn blu||bld"Enter Long Description?"||clr if upper(result)="Y" then do if logging=1 then sl " [Upl] Entering Long Description" textedit if result~="###ABORTED" then do bigdes=1 if logging=1 then sl " [Upl] Long Desc: Ok" systeminfo 8 ; node=result file="t:editor.temp" if node~=0 then file="t:editor_"node".temp" call open(tedin,file,'r') do until eof(tedin) data=readln(tedin) if compress(data)~="" then call writeln(oudes,data) end call close(tedin) end else if logging=1 then sl " [Upl] Long Desc: Aborted" end call close(oudes) if z=1 then do call writeln(fbbs,left(filename.i,23)' 'right(fsize,7)' 'left(dmy,6)' 'left(descline.1,40)) call writeln(dOut,left(descline.1,40)) end else do call writeln(fbbs,left(filename.i,23)' 'right(fsize,7)' 'left(dmy,6)' File_ID.DIZ description') do t=1 to z call writeln(fbbs,'\'copies(' ',38)||left(descline.t,40)) call writeln(dOut,left(descline.t,40)) end end newline end call close(fbbs) address command "delete "unarcd"FILE_ID.DIZ >NIL:" addulfiles '1' call writeln(dOut,'#endesc') call writeln(dOut,bigdes) siyze=fsize bss=siyze tots=tots+bss if siyze<1024 then siyze=1 else do siyze=siyze/1024 pod=pos('.',siyze) if pod>0 then siyze=left(siyze,pod-1) end addulkb siyze print red||bld||bss" Bytes Added To FileBase" if ava=0 then ava="Infinite" print frat" File(s) Credit Added, "bss*brat" Byte(s) Credit Added" call writeln(dOut,frat) call writeln(dOut,bss*brat) if logging=1 then sl " [Upl] Credit; Files ["frat"], Bytes ["bss*brat"]" newline end newline print Bld||Grn"Thanks "caseconvert(word(username,1))", for your upload(s)..." newline timetake=time('e') if pos('.',timetake)>0 then timetake=left(timetake,pos('.',timetake)-1) if timetake<60 then timetaken=1 else do timetaken=timetake/60 if pos('.',timetaken)>0 then timetaken=left(timetaken,pos('.',timetaken)-1)+1 end call writeln(dOut,tots) call writeln(dOut,files*frat) call writeln(dOut,tots*brat) if logging=1 then sl " [Upl] Total Credit; Files ["files*frat"], Bytes ["tots*brat"]" print clr||bld||wht"---["clr"Statistics"bld"]--- "clr"File Ratio: "bld||right(frat,3)||clr" Byte Ratio: "bld||right(brat,3) newline print yel"Files Uploaded This Session: "wht"["red||right(files,10,'0')||wht"] x "yel||frat||wht" = "mag||files*frat||blu" Files Credit" print yel"Bytes Uploaded This Session: "wht"["red||right(tots,10,'0')||wht"] x "yel||brat||wht" = "mag||tots*brat||blu" Bytes Credit" sl " [Upl] Files Ul'd This Session: "files" x "frat" = "files*frat sl " [Upl] Bytes Ul'd This Session: "tots" x "brat" = "tots*brat newline /* Nice little files before upload routine - Rip it if you want - BUT credit me :) */ userinfo '7' frat=result userinfo 'p' fdl=result userinfo 'q' ful=result cred=(ful*frat)-fdl+frat if frat=0|frat=255 then cred="Infinite" /* (-) */ userinfo '!' kava=result ava=kava*1024 if ava=0|ava=261120 then do;ava="Infinite";kava="Infinite";end call writeln(dOut,cred) call writeln(dOut,ava) print yel"Files Available Before Next Upload: "wht"["red||cred||wht"]" print yel"Bytes Available Before Next Upload: "wht"["red||ava||wht"] ("red||kava||yel"K"wht")" sl " [Upl] Files Available Before Next Ul: "cred sl " [Upl] Bytes Available Before Next Ul: "ava" ("kava"K)" systeminfo 'm' timeleft=result if ulbonus>=0 then do newline tetris=timeleft+(timetaken*ulbonus) settime tetris print bld||red"Time Used For Ul And Descs: "yel"["cyn||timetaken||yel"] "blu"Minute(s)"clr newline sl " [Upl] Time Used For Ul And Descs: "timetaken print bld||red"Time Awarded For Upload(s): "yel"["cyn||timetaken*ulbonus||yel"] "blu"Minute(s)"clr print bld||red"Time Remaining On-Line : "yel"["cyn||tetris||yel"] "blu"Minute(s)"clr sl " [Upl] Time Awarded For Upload(s): "timetaken*ulbonus sl " [Upl] Time Remaining On-Line : "tetris call writeln(dOut,timetaken) call writeln(dOut,timetaken*ulbonus) call writeln(dOut,tetris) end else do call writeln(dOut,timetaken) call writeln(dOut,'0') call writeln(dOut,timeleft) end newline continue newline if word(lres,1)=80&word(lres,3)=0 then do queryn bld||red"Delete the file(s) from original directory(s)?" if upper(result)="Y" then address command 'execute "T:DelSmeg" >NIL: NIL:" signal boomtown CaseConvert: arg conv_str conv_str=translate(CONV_STR,Xrange('a','z'),Xrange('A','Z')) ; tmp='' do a=1 to words(CONV_STR) tmp=tmp||upper(left(word(CONV_STR,A),1))substr(word(CONV_STR,A),2)' ' end CONV_STR=left(tmp,length(tmp)-1) return(CONV_STR) syntax: golf=sigl code=rc newline print "Oh dear we have an error!!" newline print "Line# : "golf print "Code : "code print "Error : "errortext(code) newline sl clr||bld"[Upl] *** Error, Line #"golf", Code "code", Error ["errortext(code)"] *** " print " ** Please Leave The SysOp Feedback And (s)he Will Check The Logs ** " newline continue signal boomtown readarealist: call open(ina,"BBS:configs/file.cfg",r) do 4; junk=readln(ina); end areas=word(junk,1) do i=1 to areas name.i=readln(ina) path.i=readln(ina) junk=readln(ina) write.i=readln(ina) do 4; junk=readln(ina);end end call close(ina) return boomtown: call close(dOut) if logging=1 then sl " [Upl] Upl v"ver$" Terminated - Digital Design 96'" exit