/**************************************************************************\
           $VER: FPArchiveViewer, v2.25 (20-Aug-96) by Dotoran!
\**************************************************************************/
options results;signal on SYNTAX;signal on IOERR;signal on ERROR
tr=transmit;se=sendstring;gc=getchar;gu=getuser;pr=prompt
a="rexxsupport.library";if ~show("l",a) then if ~addlib(a,0,-30) then exit
/**************************************************************************\
  Config Variables now stored in the "<path>FPFiles/FPAV/FPAV.cfg" file!
\**************************************************************************/
gu 1311992;call open(f1,result"FPAV.cfg","r");do until eof(f1);a=readln(f1);if a=""|left(a,1)=";" then iterate;else interpret a;end;call close(f1)
p!="FPAV";v!="2.25";m!="by Dotoran";call pragma("P",-2);gu 23;po=result;gu 1311992;path=result;changewhere p!", v"v!
do i=1 to 10;c.i=word(color,i);end i;a=getclip("FP"po);x=setclip("FP"po,0)
if a~="YEP" then do;tr "b1n1cfNOTEcc: c9Can't find cb"arg(1)"c9!!";exit;end
if arg()=2 then ar=arg(2)"/";else ar="";fn=ar||getclip("FPFN"po);ar=left(fn,max(lastpos("/",fn),lastpos(":",fn)))
fn=substr(fn,length(ar)+1);ex=upper(right(fn,4));gu 47;tlo=(result=-1);lo=tlo*local;se 'n1c6Extracting cb"ca'fn'cb"c6, hold on...'
select;when ex=".ZIP" then do;alst="unzip -vUq ";aext="unzip -Uq ";aadd="zip -r ";adel="zip -dq ";aprs="parse var j sz.la +7 +9 gy.la +29 +2 crc +8 +3 na.la;gy.la=insert(' ',gy.la,9)':00'";end
when ex=".LZX" then do;alst="lzx l ";aext="lzx x ";aadd="lzx -a -x a ";adel="lzx d ";aprs="parse var j +1 sz.la +7 +2 gy.la +32 +1 na.la;gy.la=insert(' ',gy.la,24)";end
when ex=".LHA" | ex=".LZH" | ex=".RUN" then do;alst="lha -b64 -m -Qw -Qo v ";aext="lha -I -b64 -m -Qw -Qo x ";aadd="lha -I -b64 -m -Qw -Qo -x u ";adel="lha -I -b64 -m -Qw -Qo d "
aprs="parse var j +1 sz.la +7 +1 gy.la +32 +2 na.la;gy.la=insert(' ',gy.la,24)";end
otherwise do;if ex=".GIF" then do;call UPIC(gvi);exit;end;if lo & ex=".MPG" then do;call UPIC(mvi);exit;end
if ex=".IFF" then do;call UPIC(ivi);exit;end;if ex=".JPG" then do;call UPIC(jvi);exit;end;if ex=".ANI" then do;call UPIC(avi);exit;end
if ex=".PCX" then do;call UPIC(pvi);exit;end;tr 'n1c9Sorryc6, viewing of cb"ca'ex'cb" c6is not presently supported!';exit;end;end;dlp="";gu 28;term=(result=2|result=4)
li1.0=" ==== ======== ====== ===== =========  ========  =============================";li1.1=" ÍÍÍÍ ÍÍÍÍÍÍÍÍ ÍÍÍÍÍÍ ÍÍÍÍÍ ÍÍÍÍÍÍÍÍÍ  ÍÍÍÍÍÍÍÍ  ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ";li1=li1.term
li2.0=" ==== ======== ====== ===== ==================================================";li2.1=" ÍÍÍÍ ÍÍÍÍÍÍÍÍ ÍÍÍÍÍÍ ÍÍÍÍÍ ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ";li2=li2.term
gu 41;sop=SUBOP(result);gu 1100468;ll=result;gu 17;sy=(result~=0);gu 15;ag=result;ifil="ram:FPAV"po".ID";wfil="ram:FPAV"po".LST";wdir="ram:FPAV"po
call pragma("D",ar);cdir=pragma("D");if right(cdir,1)~=":" then cdir=cdir"/";call makedir(wdir);call pragma("D",wdir);call INIT;mor=BBSLINE(1064)" "
do until gk="NO";la=1;d=7;ud=0;q=0;tr "f1@6r1ca"center(p!" v"v!" "m!" of Frontiers BBS (716)/823-9892",78)"r0n1"
if paths=2 then do;se "ceView cfexpanded paths c6in Archive listing? c7[c9Noc7]cc: c9";gc;a=result;if a="Y" then do;paths=1;tr "Yes!^1";end;else do;paths=0;tr "No.^1";end;end
tr "cbContents of Archivec9: cd"fn"n1";if paths then tr c.1" r1Itemr0 r1Originalr0 r1Packedr0 r1Ratior0 r1 Full Path and Filename of Item within Archive.   r0n1"c.2||li2
else tr c.1" r1Itemr0 r1Originalr0 r1Packedr0 r1Ratior0 r1File-Dater0  r1FileTimer0  r1 Item's Filename in Archive. r0n1"c.2||li1
do while ~ud & la~=hi;if re & la>ti then do;j=readln(fp);interpret(aprs);if substr(sz.la,2,3)="---" | EOF(fp) then do;hi=la;re=0;ud=1;end
if na.la="" | (substr(gy.la,13,1)~="%" & ex~=".LZX") | crc="00000000" then iterate;end;se c.3"@6"right(la,4)". "c.4;parse var gy.la packed ratio fdate ftime .
if paths then tr c.4||right(sz.la,8) c.5||right(packed,6) c.6||right(ratio,5)c.10"  "na.la
else do;se c.4||right(sz.la,8) c.5||right(packed,6) c.6||right(ratio,5) c.7||fdate"  "c.8||ftime"  "
tr c.10||translate(substr(" "na.la,1+lastpos("/",substr(" "na.la,2))),c.9"+","/");end
la=la+1;d=d+1;if ll=d then do;se "@6"mor;gc;ke=CHECK(result);tr "^1";if ke="N" then ud=1;if ke~="C" then d=1;end;end;ti=la-1
query c.2"@6"value(word("li1 li2",paths+1))"n2ceView c6which caItemc6(casc6)? c7[caENTERc6=caNonec6,cf?c6=cfHelpc7]cc: ce"
it=CHECK(result);if it="" then do;gk="NO";iterate;end;pn=0;au=PARSE(it,1,ti);do vn=1 to au while ~pn;call ACTION(it.vn);end
dlp="";pr 1 noyes 'n1c6View archive cb"ca'fn'cb" c6again? c7[c9Noc7]cc: c9';gk=CHECK(result);end;call close(fp)
call pragma("D","RAM:");call pragma("D","RAM:");call delete(wfil);call delete(ifil)
address command "delete "wdir" ALL QUIET";if right(so1,1)="01"x & substr(so1,61,1)~="01"x then call delete(cdir||fn);exit
ACTION:;arg nr;dfil=na.nr;select;when mo=5 & led~="" then do;if UNPACK() then return;call EDFIL;call delete(dpat);call INIT;end
when mo=3 & adel~="" then do;call DELFIL;call INIT;end;when mo=2 & aadd~="" then do;call ADDFIL;call INIT;end
when mo=1 then do;if UNPACK() then return;call DLOAD;call delete(dpat);end;otherwise do;if UNPACK() then return;call IDENT
if vn~=au & ~q then do;se "n2c6Press c7[cdQc7] c6to quit or c7[caRETURNc7] c6to continue...";gc;if CHECK(result)="Q" then pn=1;tr "n1";end;call delete(dpat);end;end;return
DLOAD:;if ~q then do;pr 1 noyes 'n1ceDownload cb"ca'dfil'cb" c6now? c7[c9Noc7]cc: c9';ke=CHECK(result);if ke="NO" then return;end
if tlo then do;if dlp="" then do;pr 40 normal "n1ceCopy c6to pathcc: ca";dlp=CHECK(result);if dlp="" then return;end
tr 'n1ceCopying cb"ca'dfil'cb" c6to cb"ca'dlp'cb"c6...';address command 'copy "'dpat'" TO "'dlp'"';end;else XDN dpat;return
EDFIL:;if ~q then do;pr 1 yesno 'n1ceEdit cb"ca'dfil'cb" c6now? c7[caYesc7]cc: ca ';ke=CHECK(result);if ke="NO" then return;end
se 'n1ceEditing cb"ca'dfil'cb"c6, one moment...';address command led' "'dfil'"';tr "cdDonec6!"
if ~q then do;pr 1 yesno 'n1ceSave cb"ca'dfil'cb" c6to cb"ca'fn'cb" c6now? c7[caYesc7]cc: ca ';ke=CHECK(result);if ke="NO" then return;end;address command aadd'"'cdir||fn'" "'dfil'"';return
ADDFIL:;pr 50 normal "n1c6Enter caPath/file c6to ceADD c6to archivecc: ca";ake=CHECK(result);if ake="" then return
if ~exists(ake) then do;tr 'n1c9Errorc6, cb"ca'ake'cb" c6not found!';signal ADDFIL;end;adc=aadd
if ~q & index(ake,"/")>0 then do;pr 1 yesno "n1c6Include cafull path c6when adding file? c7[caYesc7]cc: ca";ke=CHECK(result);if ke="NO" then adc=delstr(adc,index(adc," -x"),3);end
se 'n1ceAdding cb"ca'ake'cb" c6to cb"ca'fn'cb"c6, one moment...';address command adc'"'cdir||fn'" "'ake'"';tr 'cdDonec6!';return
DELFIL:;if ~q then do;pr 1 yesno 'n1ceDelete cb"ca'dfil'cb" c6now? c7[caYesc7]cc: ca';ke=CHECK(result);if ke="NO" then return;end
se 'n1ceDeleting cb"ca'dfil'cb"c6, one moment...';address command adel'"'cdir||fn'" "'dfil'"';tr "cdDonec6!";return
UNPACK:;if sz.nr>storage()-fmem*1024 then do;tr 'n1c9Sorryc6, the file cb"ca'dfil'cb" c6is too big to fit into memory!';return 1;end
se 'n1ceUn-arcing cb"ca'dfil'cb"c6, one moment...';address command aext'"'cdir||fn'" "'dfil'"';dpat=wdir"/"dfil
if ~exists(dpat) then do;tr "c9Errorc6, file not found!";return 1;end;tr "cdDonec6!";return 0
IDENT:;pp=1;xp=1;IDENT2:;address command 'WhatIs >'ifil' "'dpat'"';call open(pf,ifil,"R");id=strip(strip(substr(readln(pf),36),"B",""),"B","");call close(pf)
if pp & ((index(id,"PP ")>0 & index(id,"Pass")=0) | (index(id,"Pow")>0 & index(id,"/E")=0)) then do;se "n1cfPowerpacked c6file, additional decrunching commencing...";address command 'dld >NIL: "'dpat'"';tr "cdDonec6!";pp=0;signal IDENT2;end
if xp & index(id,"Xpk ")>0 & index(id,"cry")=0 then do;se "n1cfXpk-packed filec6, additional decrunching commencing...";address command 'XUP >NIL: "'dpat'"';tr "Done!";xp=0;signal IDENT2;end
select;when index(id,"Lhar")>0 | index(id,"Zip")>0 then signal NEW;when index(id,"n exe")>0 | index(id,"n li")>0 | index(id,"ce dr")>0 then call VRS;when lo & upper(right(dpat,4))=".ICN" then call RIP;when index(id,"wn dat")>0 then call TXT
when index(id,"Gui")>0 then do;if lo & guv~="" then address command guv' FILE "'dpat'" PUBSCREEN CNETSCREEN'po;else se "#4"gvr" FILE "dpat" LINES "ll"}f1";end
when lo & index(id,"ve 3")>0 | lo & index(id,"Imagine")>0 then call PIC(ovi" PUBSCREEN CNETSCREEN"po)
when lo & index(id,"module")>0 & index(id,"TFM")=0 & index(id,"pile")=0 then call MOD
when lo & index(id,"MPeg")>0 then call PIC(mvi);when index(id,"PEG")>0 then call PIC(jvi);when lo & index(id,"ico")>0 then call PIC(icv)
when lo & index(id,"d sam")>0 then call SND;when index(id,"IFF p")>0 then call PIC(ivi);when index(id,"on/a")>0 then call PIC(avi)
when index(id,"PCX")>0 then call PIC(pvi);when index(id,"GIF")>0 then call PIC(gvi);otherwise tr 'n1c6File ceIdentification c6for cb"ca'dfil'cb"cc: cb'id'n1';end;return
NEW:;x=setclip("FP"po,"YEP");x=setclip("FPFN"po,dfil);spawn path"FPAV" 1 wdir;exit
VRS:;tr 'n2ceVersion Info c6for cb"ca'dfil'cb"cc: c7(cd'id'c7)';address command 'version FILE >'ifil' "'dpat'" FULL'
if RC=0 then sendfile ifil;else tr "n1c9Sorryc6, this file has no ceVersion Stringc6! c7(c9Bad Coding!!c7)";return
RIP:;if ~q then do;pr 1 yesno 'n1cb"ca'dfil'cb" c6is a ceRIP-Iconc6, view it now? c7[caYesc7]cc: ca';ke=CHECK(result);if ke="NO" then return;end;se '#4ICNview "'dpat'"}';return
PIC:;se '#4GFXList "'dpat'"}';if ~lo then return;if ~q then do;pr 1 yesno 'n1cb"ca'dfil'cb" c6is a ce'id'c6, view it? c7[caYesc7]cc: ca'
ke=CHECK(result);if ke="NO" then return;end;address command arg(1)' "'dpat'"';return
SND:;if ~q then do;pr 1 yesno 'n1cb"ca'dfil'cb" c6is an ce'id'c6, play it? c7[caYesc7]cc: ca'
ke=CHECK(result);if ke="NO" then return;end;address command spl' "'dpat'"';return
MOD:;if ~q then do;pr 1 yesno 'n1cb"ca'dfil'cb" c6is a cd'id'c6, play it? c7[caYesc7]cc: ca';ke=CHECK(result);if ke="NO" then return;end
if ~show("P","DELITRACKER") then do;address command "RUN >NIL: "deli" CONFIG S:DELITRACKER.CONFIG CX_POPUP NO PUBSCREEN CNETSCREEN"po
do 1 while ~show("P","DELITRACKER");address command "waitforport DELITRACKER";end
if RC=5 then do;tr "n1b1c9Sorryc6, unable to load ceDelitrackerc6!";return;end;end
address 'DELITRACKER';'PUBSCREEN CNETSCREEN'po;'SHOWGUI';'PLAYMOD 'dpat;'STATUS m pnr';address
if result>0 then do;a=0;do a=a+1 until result=dfil | a>100;address 'DELITRACKER' 'STATUS m fil';end;end
else tr "n1c9Sorryc6, No player loaded for ceModuletypecc: ca"word(id,1)"c6!";return
TXT:;call open(pf,dpat,"R");a=readch(pf,maxsz);call close(pf);pc=length(compress(a,xrange("00"x,"08"x)xrange("0E"x,"1F"x)xrange("7F"x,"FF"x)"0B0C"x))*100%length(a)
if ~q & pc<98 then do;pr 1 noyes "n1c6This file is only cb"pc"% ceASCIIc6, View it anyways? c7[c9Noc7]cc: c9";ke=CHECK(result);if ke="NO" then return;end
if find(lamers,ag)>0 then do;call open(pf,dpat,"W");call writeln(pf,a" [BREAK]"||"0a0a"x||"      ******  Download the archive if you want to read more!!  ******"||"0a"x);call close(pf);end
if tvi="" then se "f1*3"dpat"}";else se "#4"tvi" FILE "dpat" LINES "ll"}f1";return
UPIC:;se '#4GFXList "'ar||fn'"}';if lo then address command arg(1)' "'ar||fn'"';return
INIT:;hi=0;ti=0;re=1;ud=0;la=1;call close(fp);address command alst'>'wfil' "'cdir||fn'"';call open(fp,wfil,'R');do until substr(la,2,3)="---" | EOF(fp);la=readln(fp);end;la=1;return
PARSE:;arg it,min,max;mo=upper(left(it,1));select;when mo="?" | mo="/" then do;mo=0;it=0;call HELP;end;when mo="D" & (sop | sy | find(dag,ag)>0) then do;mo=1;call QUICK;end
when mo="A" & (sy | sop) & (rmo | tlo) then do;mo=2;it=1;end;when mo="K" & (sy | sop) then do;mo=3;call QUICK;end;when mo="E" & tlo then do;mo=5;call QUICK;end;otherwise do;mo=0;call QUICK2;end;end
it.="";c=0;it=translate(it,"  ",".,");do a=1 to words(it);c=c+1;it.c=word(it,a);if index(it.c,"-")>0 then do
parse var it.c x"-"y;if y="" then y=max;if x="" then x=min;if x>y then do;d=x;x=y;y=d;end;if x<min | y>max | ~datatype(x,"W") | ~datatype(y,"W") then do
c=c-1;iterate;end;do b=x to y;it.c=b;c=c+1;end;c=c-1;end;else if it.c<min | it.c>max | ~datatype(it.c,"W") then do;c=c-1;iterate;end;end;return c
QUICK:;it=substr(it,2);QUICK2:;if right(it,1)="!" then do;q=1;it=left(it,length(it)-1);end;return
HELP:;tr "f1r1ca"center(p!", v"v!" by Dotoran of Frontiers BBS (716)/823-9892",78)"r0n1";tr "c9FPAV cbis a program to display textfiles or fileinfo on files within archives.n1"
tr "Input must be in the following formatcc:n1";tr "     ce#   c6any item number>lc7Examplecc: ce5n2   ce#-#   c6a RANGE of values>jc7Examplecc: ce6-11"
tr "n1 ce, c6or ce.  c6to separate multiple RANGES>9c7Examplecc: ce4,7,9-11n2cbAdditional commands/optionscc:n1";if sop | sy | find(dag,ag)>0 then tr "c7[ceDc7]ceownload c6file(s) from archive.>dc7Examplecc: ceD2,4-5"
if (sop | sy) & (rmo | tlo) then tr "c7[ceAc7]cedd c6file to archive.>nc7Examplecc: ceA";if tlo then tr "c7[ceEc7]cedit c6textfile(s) inside archive.           c7Examplecc: ceE2,5"
if (sy | sop) then tr "c7[ceKc7]ceill c6file(s) inside archive.>fc7Examplecc: ceK4-5";tr 'n1cfIf your input ends in a cb"ca'!'cb" c7(cdQuick-modec7)cf, then c9FPAV cfwill skip prompts!';return
SUBOP:;id1=x2c(d2x(arg(1),8));gu 1209388;su1=result*488+96;gu 2401068;so1=import(x2c(d2x(result+su1,8)),210);sup=0;do a=0 to 5;if id1=substr(so1,a*4+1,4) then sup=1;end;return sup
BBSLINE:;arg line;gu 1402022;ln=import(import(offset(x2c(d2x(result,8)),(line-1)*4),4),256);parse var ln ln"00"x .;return ln
CHECK:;arg ch;if ch~="###PANIC" then return ch;logentry "Lost Carrier in FPAV!";bufferflush;exit
SYNTAX:;IOERR:;ERROR:;e1=' Error: 'rc' ('errortext(rc)')';e2='  Line: 'left(sigl,4)'File:';gu 1311992;a=result;gu 1311960;b=result;c='"'a||b'"';e2=e2' 'c;tr e1;tr e2;logentry e1;logentry e2
e=sourceline(sigl);do while e~='';e3='Source: 'left(e,37);tr e3;logentry e3;e=substr(e,38);end;bufferflush;exit
/**************************************************************************\
\****************************************** Frontiers BBS (716)/823-9892 **/