/*************************************************************\
    $VER: Compulist, v2.1  (15-Jan-99)  by Carlos A. Roldan
   (c)1996 - 1999  Carlos A. Roldan.  Aguadilla, Puerto Rico
\*************************************************************/

/* THIS AREXX SCRIPT MAY NOT BE MODIFIED IN ANY WAY! */

START:;vr="Compulist v2.1";options results;arg a;vr2=right(vr,3)
signal on SYNTAX;signal on ERROR;signal on IOERR
gu=getuser;gu 1311992;t1=result
if ~show('l','rexxsupport.library') then if ~addlib('rexxsupport.library',0,-30,0) then exit
bf=bufferflush;gt=getchar;tr=transmit;se=sendstring;fn=Filenote;sl=SYSOPLOG;cw=changewhere
ls=loadscratch;ss=savescratch;pu=putuser;so=setobject;sp=setprotocol;N="[0m"
dat1=t1"Config.dat";ak=addkeys;s=79;anim=t1"Wait.rexx"
SE1="f1n1z1cb # z0 z1?z0 z1BBS Name:              z0 z1Stz0 z1Phone Number: z0 z1Baud: z0 z1Comment:                z0"
call CONFIG;ads=t1"Ads";if ~exists(ads) then tr "$ makedir "ads"}"
t2=t1'BBSLIST';arc1=t2'.LHA';arc2=t2'.ZIP';arc3=t2'.LZX';p2=t1"List.dat";gu 40;acc=result;gu 17;maint=result
f1='T:BBLIST.TXT';f2="T:Compulist";dat=t1'Count.dat';gu 1;user=result;gu 1100460;term=result;gu 23;pt=result
gu 2307050;bbs=result;gu 2307128;ph=result;ph1=left(ph,3);ph2=substr(ph,5,3);ph3=substr(ph,9,4)
gu 2307076;sy=result;gu 47;local=result=-1;gu 12;cd=result;ln=COPIES("Э",s);ln2=COPIES("Э",31)
wa=N"[21;4f[KcfPlease wait...";gu 15;syso=result;if a="EVENT" then signal ARC
if term="0" then do;tr 'f1b1cfn9'center(ln2,s);tr 'c9'center("This program requires",s)
tr center("simple or full",s);tr center("ANSI support to run!",s);tr 'cf'center(ln2,s)
tr "n5"center("*- Hit Any Key -*",s)"g1";signal BYE;end;do forever
band="c9   "copies("_",69)"n1  ("copies("_",69)")n1";sl "cbPort #"pt "Used "vr"q1";cw vr;old=result;bf
ls user;getscratch 1100454;mor=result;so "0";pu 1100454;ss user
call SETUP;call READCFG
TOP:
tr "f1>6cb____   ____   ____     ____   ____   __      __   _____   ______n1>5/ __/\ /   /\ /    \   / _ /\ / / /\ / /\    / /\ /  __/\ /_  __/\"
tr ">4/ /\_\// / / // / / /\ / __/ // / / // /_/   / / //__  /\/ \/ /\_\/n1   /___7\ /___/ //_/_/_/ //_/\_\//___/ //____7\ /_/ //____/ /  /_/ /"
tr "   \___\/ \___\/ \_\_\_\/ \_\/   \___\/ \____\/ \_\/ \____\/   \_\/cf [4mv"vr2""N"c9n1"band
tr "[18;0f"band
call OPT
COM:;se "[21;4f[JcfWhat is your command v1}? [Enter o1Qo0 to Quit]: q1"
inp=ANS("ABDEKV?/QR*")
if inp="A" then signal ADD;if inp="D" then signal DNL;if inp="K" then do;call SEE;signal ASKDEL;end
if inp="V" then do;call SEE2;signal VAD;end;if inp="*" then signal PRT;if inp="E" then do;save=0;call see;signal EDIT;end
if inp="B" then do;call SEE;signal lp2;end;if inp="?"|inp="/" then signal INF;if inp="Q" then signal BYE
if inp="R" then do;tr "";end;signal TOP
ADD:;call clear;if count=999 then do;tr 'f1b1cfn9'center("Max Entries Has Already Been Reached!",s)
call PAS;signal TOP;end;tr wa;R="[1;33;41m";call clear;tr "[10;13f"N"BBS Name[10;39fState   Baud"
tr "[11;12f.-----------------------.  .--.  .------.[12;12f|"R""COPIES(" ",23)N"|  |"R"  "N"|  |"R"      "N"|"
tr "[13;12f`-----------------------'  `--'  `------'";tr "[14;13fCode     Number      Comment"
tr "[15;12f.-----.  .--------.  .------------------------."
tr "[16;12f|"R"(   )"N"|  |"R"   -    "N"|  |"R""COPIES(" ",24)N"|"
tr "[17;12f`-----'  `--------'  `------------------------'"
BBS:;tr "[21;0f[K"
se "[12;13f"R"I4624 23}";gu 70;name=result;call GRA;tr R"[12;13fcf"name
se "[12;40f"R"I20993 2}";gu 70;state=result;call GRA;tr R"[12;40fcf"state
se "[12;46f"R"I20993 6}";gu 70;baud=result;call GRA;tr R"[12;46fcf"baud
se "[16;14f"R"I20544 3}";gu 70;code=result;call GRA;tr R"[16;14fcf"code
se "[16;22f"R"I20544 3}";gu 70;pn1=result;call GRA;tr R"[16;22fcf"pn1
se "[16;26f"R"I20544 4}";gu 70;pn2=result;call GRA;tr R"[16;26fcf"pn2
CO11:;se "[16;34f"R"I4608 24}";gu 70;comment=result;call GRA;tr R"[16;34fcf"comment
se "[21;4f"N"c9[JIs The Above Info Correct cf(cbYescf/cbNocf/cbAbortcf)? q1"
inp=ANS("YNA");if inp="Y" then do
se "[21;0f[K[21;4fcfWould you like to upload a BBS ad for the above entry? q1";bbsad=0
inp=ANS("YN");if inp="N" then do;col="";call chekad;adss=ads"/"bbsad;tr "#5copy from "t1"NoAd to "adss"}";end
if inp="Y" then do;col="*";call chekad;tr"f1n1c9Upload ad for :cf "name"n2"
tr "    cbеЭИ   еЭИеЭЭЭЭЭЭИеЭЭЭЭЭЭИеЭЭЭЭИеЭИеЭЭЭИеЭЭЭЭИеЭИеЭЭЭЭЭЭИ"
tr "    Г Г   Г ГГ еЭЭИ ГГ еЭЭИ ГГ еИ ГГ ГдИ еОГ еИ ГГ ГГ еЭЭЭЭО"
tr "    Г ГеЭИГ ГГ дЭЭО ГГ дЭЭО ГГ ГГ ГГ Г Г Г Г ГГ ГГ ГГ Г еЭЭИ"
tr "c9.---cbГ ГГ ГГ ГГ еЭЭИ ГГ еЭИ еОГ ГГ ГГ Г Г Г Г ГГ ГГ ГГ Г дИ Гc9---."
tr "|   cbГ дО дО ГГ Г  Г ГГ Г Г дИГ ГГ дО ГеО дИГ ГГ дО ГГ дЭЭО Г   c9|"
tr "|   cbдЭЭЭЭЭЭЭОдЭО  дЭОдЭО дЭЭОдЭОдЭЭЭЭОдЭЭЭОдЭОдЭЭЭЭОдЭЭЭЭЭЭО   c9|"
tr "|--------------------------------------------------------------|"
tr "|cfYou have chosen the option to upload an ad for the BBS you arec9|"
tr "|cfadding to the complulist.  Please upload an  ad  that  is  notc9|"
tr "|cfbigger that 80x22.  If the ad you are about to upload does notc9|"
tr "|cfmeet this requirement, just hit [A]bort and the  BBS  will  bec9|"
tr "|cfadded without an ad.  Also, ads can  only  be  uploaded  usingc9|"
tr "|cfXMODEM protocol so the system can properly match the ad to thec9|"
tr "|cfdata for the BBS you entered.                       Thank You!c9|"
tr "`--------------------------------------------------------------'q1"
bf
adss=ads"/"bbsad;if local then do;se"n1c9Enter complete path/filename for ad: I0 }";gu 70;ad=result
tr "n1c9Transfering file...q1$ Copy from "ad" to "adss"}";end
else do;SETMINFREE 9000;sp "X";XUP adss;end;end;if ~exists(adss) then col=""
call WRI;sl "cfAdded: cc"name"q1";tr "[21;4f"N"c9[Js1Saving...q1"
SAVL:;call open(file,p2,"A");call writeln(file,name'|'state'|'code'|'pn1'|'pn2'|'baud'|'comment'|'col'|'acc'|'bbsad)
call close(file);call COUNT;ncount=count+1;call SAVECFG;call SETUP;signal TOP;end 
if inp="N" then do;tr wa;signal DEL;end;if inp="A" then signal RUT
SEE:
tr SE1;tr "c9"ln"[19;0f"ln;se "[11;0f[K[4;0f";do x=1 to bbsnum
se "cf"left(x,3)"o1c9 "left(col.x,1)"o0 ca"left(na.x,23) "cb"left(st.x,2) "cd("left(ph1.x,3)")" left(ph2.x,3)"-"left(ph3.x,4) "cc"left(ba.x,6) "ce"left(com.x,24)
if index(x/15,".")=0 then do;se "[20;0fcfContinue? (cbYcf/n):q1 ";gt
if upper(result)="N" | result="###PANIC" then do;leave x;end
tr "[20;0f[J";do line=4 to 18;tr "["line";0f[K";tr "[3;0f";end;end;end;return
SEE2:
tr SE1
tr "c9"ln"[19;0f"ln;se "[11;0f[K[4;0f";do x=1 to bbsnum;if col.x="*" then do
se "cf"left(x,3)"o1c9 "left(col.x,1)"o0 ca"left(na.x,23) "cb"left(st.x,2) "cd("left(ph1.x,3)")" left(ph2.x,3)"-"left(ph3.x,4) "cc"left(ba.x,6) "ce"left(com.x,24)
if index(x/15,".")=0 then do;se "[20;0fcfContinue? (cbYcf/n):q1 ";gt
if upper(result)="N" | result="###PANIC" then do;leave x;end
tr "[20;0f[J";do line=4 to 18;tr "["line";0f[K";tr "[3;0f";end;end;end;end;return
DNL:;tr wa;call clear
tr "[9;29fcf [4m D O W N L O A D "N"[11;30fc9[cb1c9]cb Lha version"
tr "[13;30fc9[cb2c9]cb Lzx version[15;30fc9[cb3c9]cb Zip version[17;30fc9[cbRc9]cbeturn To Previous Menuq1"
se "[21;4fcfWhich version v1}? ";inp=ANS("123R");if inp="R" then signal RUT
if inp="1" then file1=arc1;if inp="2" then file1=arc3;if inp="3" then file1=arc2
if ~exists(file1) then do;tr "f1n3c9 ("right(file1,11)") Has Not Been Created!n2 q1";signal lp2;end
else do;tr "f1b1";Selectfile file1
tr "n1c9Note: cf This list may contain previously selected files!n1& DS}";end;signal TOP
INF:;se wa;call clear
se '[9;0fcf'center(ln2,s)'[10;0fc9'center("Written In ARexx By:",s)
se '[11;0f'center("Carlos A. Roldan",s)'[12;0f'center("6975 Parkwood",s)
se '[13;0f'center("Detroit, Michigan 48210",s)'[14;0f'center("E-mail: croldan@visitus.net",s)
se '[15;0fcf'center(ln2,s)'[16;0fcd'center("Running On: "bbs,s)
se '[17;0f'center("System Operator: "sy,s)'[21;0f[K'
call PAS;signal RUT
PAS:se '[22;27f';if exists(anim) then do;se '#0'anim'}';end
else do;se '[22;27fq1k1ФФФФФФФФq1 cfHit Any Keyq1 k1ФФФФФФФФq1g1[22;27f[K';end;return
WRI:if ~exists(p2) then do;call open(file,p2,'w');call writeln(file,bbs"|"p.2"|"ph1"|"ph2"|"ph3"|"p.3"|"p.4"||1|0")
call close(file);tr "#5copy from "t1"NoAd to "ads"/0}";end;return
DEL:;tr "[12;13f"R""COPIES(" ",23)"[12;40f  [12;46f      "
tr "[16;14f   [16;22f   [16;26f    [16;34f"COPIES(" ",24)N;signal BBS
RUT:tr wa;call OPT;signal COM
GRA:;if result="" then do;tr "b1z0[21;4f[Ks1cfBlank input not allowed!w1q1";signal RUT;end;return
OPT:;call clear
tr "[10;19fc9[cbAc9]cbdd To List[10;43fc9[cbBc9]cbrowse List[12;19fc9[cbDc9]cbownload List[12;43fc9[cbEc9]cbdit An Entry"
tr "[14;19fc9[cbKc9]cbill An Entry"
tr "[14;43fc9[cbVc9]cbiew BBS Ad"
tr "[16;19fc9[cb*c9]cb Print List"
tr "[16;43fc9[cb?c9]cb About";return
ARC:;call SETUP;sl 'c9'vr' Event Started.';tr 'f1n5'center(vr" System Event",s);cw vr' Event'
tr '[10;0fcf'center("Sorting List...",s)'q1$ QSort from 'p2' to 'f1'}$ Copy from 'f1' to 'p2'}$ Delete 'f1'}'
if exists(arc1) then tr '$ Delete 't2'.#?}'
if exists(p2) then do;call open(f1,f1,"W");do x=1 to bbsnum
na.x=left(na.x,23);st.x=left(st.x,2);ph1.x=left(ph1.x,3);ph2.x=left(ph2.x,3);ph3.x=left(ph3.x,4);ba.x=left(ba.x,6);com.x=substr(com.x,1)
call writeln(f1,na.x st.x "("ph1.x")" ph2.x"-"ph3.x ba.x com.x);end x;call close(f1)
tr '$ Join 't1'Ban1 'f1 t1'Ban2 to 'f2'}'
call open(file,f2,"A");call writeln(file,vr' By: Carlos A. Roldan [caroldan@hotmail.com]');call writeln(file,'Number Of Systems Listed: 'bbsnum);call writeln(file,'Updated: 'cd);call close(file)
tr '$ 'fn f2' "Created by 'vr' - Updated: 'cd'"}'
tr '[10;0f[Kcf'center("Creating "arc1,s)'w5$ lha -r -e -x -2 -q a 'arc1 f2'}w5$ 'fn arc1' "Lha Version Of 'vr' - Updated: 'cd'"}'
tr '[10;0f[K'center("Creating "arc3,s)'$ lzx -m -x -a -3 -q a 'arc3 f2'}w5$ 'fn arc3' "Lzx Version Of 'vr' - Updated: 'cd'"}'
tr '[10;0f[K'center("Creating "arc2,s)'$ zip -q 'arc2 f2'}w5$ 'fn arc2' "Zip Version Of 'vr' - Updated: 'cd'"}'
tr '$ Delete 'f1 f2'}';end;sl 'c9'vr' Event Ended.';bf;exit
ASKDEL:
se "[20;0fcfNumber of Item to Delete: (0=Abort) I4160 3}q1";gu 70;ed=result
if ed=""|ed="0"|ed>bbsnum then signal TOP;if ed>0 & ed~>bbsnum then do;bb1=bbsad.ed;nbbs=na.ed
bb2=ads"/"bb1
if acc.ed ~=acc & maint ~=0 then signal ASKDEL2
if acc.ed ~=acc then do;tr "[20;0f[Kcfb1s1You may only kill your own entries!w2q1";signal askdel;end
ASKDEL2:
se "f1n1cfDeletecfc9 "nbbs" cf(cbyescf/cbNocf)?: q1";gt;an=upper(result)
if an~="Y" then do;tr "c2No!c3";signal TOP;end;tr "c2Deleting, please wait...c3"
call COUNT;ncount=count-1;call SAVECFG;call KILL
end;if exists(bb2) then tr "$ Delete "bb2"}";sl "cfDeleted: cc"nbbs"q1"
tr "f1n9cf"center("Item Deleted",s)"n1q1";signal lp2
VAD:
se "[20;0fcfView ad for which BBS? (0=Abort) I4160 3}q1";gu 70;del=result
if del=""|del="0"|del>bbsnum then signal TOP;if del>0 & del~>bbsnum then do;na=na.del;bb1=bbsad.del
tx="f1n9cfb1"center("Ad For",s)"n2c9"center(na,s)"cfn2"center("Not Available!",s);end
if bbsad.del="" then do;tr tx;signal lp2;end
bb2=ads"/"bbsad.del;if ~exists(bb2) then do;tr tx;signal lp2;end
tr "b1f1*4"bb2"}"
lp2:call PAS;signal TOP
BYE:;call MOR;bf;EXIT
MOR:ls user;so mor;pu 1100454;ss user;tr "q1";cw old;return
ANS:;arg PosAns;bf;do until pos(char,posans)~=0;gt;Char=upper(result);if Char='###PANIC' then exit;end;return Char
PRT:;if ~Local then do;se "[21;4f[KcfSorry, you have no access to that command.w2";signal com;end
dev="prt:";if p.1="Y" then ff=d2c(12);else ff=""
if exists(arc1) then do
tr '[21;0f[Kcf'center("Printing...",s)'q1#5copy 't1'Ban1 to prt:}';do x=1 to bbsnum
call open(f,dev)
call writeln(f,left(na.x,23) left(st.x,2) "("left(ph1.x,3)")" left(ph2.x,3)"-"left(ph3.x,4) left(ba.x,6) left(com.x,24))
end;call close(f);tr '#5copy 't1'ban2 to prt:}'
call open(f,dev)
call writeln(f,vr" By: Carlos A. Roldan [caroldan@hotmail.com]");call writeln(f,"Number Of Systems Listed: "bbsnum)
call writeln(f,"Printed At: "bbs "On: "cd);call writeln(f,ff);call close(f);end
else do;tr 'f1b1[10;20fc9'arc1' Not Found!';signal lp2;end;signal COM
SETUP:;call WRI
tr 'f1[8;0f[Kcf'center("Reading data file, please wait...",s)'q1'
call open(bbsl,p2,'R');do x=1 until EOF(bbsl);h.x=readln(bbsl)
parse var h.x na.x'|'st.x'|'ph1.x'|'ph2.x'|'ph3.x'|'ba.x'|'com.x'|'col.x'|'acc.x'|'bbsad.x
se 'c9.';end x;tr 'q1';call close(bbsl);bbsnum=x-1;return
SAVECFG:;call open(f1,dat,'w');call writeln(f1,ncount);call close(f1)
CONFIG:;call open(f1,dat1,'R');do x=1 to 4;p.x=readln(f1);end;call close(f1);return
READCFG:;if ~exists(dat) then do
call open(f1,dat,'w');call writeln(f1,bbsnum);call close(f1);signal READCFG;end
COUNT:;call open(f1,dat,'R');a=readln(f1);Count=word(a,1);call close(f1);return
EDIT:
se "[20;0fcfNumber Of Item To Edit: (0=Abort) I4160 3}q1";gu 70;ed=result
if ed=""|ed="0"|ed>bbsnum then signal TOP;if ed>0 & ed~>bbsnum then nbbs=na.ed
if acc.ed ~=acc & maint ~=0 then signal EDIT2
if acc.ed ~=acc then do;tr "[20;0f[Kcfb1s1You may only edit your own entries!w2q1";signal edit;end
EDIT2:tr 'z0f1z1cb  Edit BBS Entry  z0n1'
tr 'c9[cb1c9]cf B B S    N A M E c9: z1cb'left(na.ed,23)'z0';name=na.ed
tr 'c9[cb2c9]cf    S T A T E     c9: z1cb'left(st.ed,2)'z0';state=st.ed
tr 'c9[cb3c9]cf    P H O N E     c9: cf(z1cb'left(ph1.ed,3)'z0cf) z1cb'left(ph2.ed,3)'z0cf-z1cb'left(ph3.ed,4)'z0'
code=ph1.ed;pn1=ph2.ed;pn2=ph3.ed
tr 'c9[cb4c9]cf B A U D  R A T E c9: z1cb'left(ba.ed,6)'z0';baud=ba.ed
tr 'c9[cb5c9]cf  C O M M E N T   c9: z1cb'left(com.ed,24)'z0';comment=com.ed
bbsad=bbsad.ed;col=col.ed;tr 'n1c9[cbQc9] cdEntry Is  Correctn1';save=0
EDD:;se 'z0[12;1fc6Selectionc9: cf[K';gt;a=index('12345Q',result)
if a=0 then a=6;signal ('ED'a)
ED1:tr 'BBS Name';ak (name);se '[3;24fz1cfi4112 23}';gu 70;a=result
if a~='' then do;name=a;save=1;end;tr '[3;24f'name;signal EDD
ED2:tr 'State';ak (state);se '[4;24fz1cfi20481 2}';gu 70;a=result
if a~='' then do;state=a;save=1;end;tr '[4;24f'state;signal EDD
ED3:oldphone=pn1""pn2;oldad=ads"/"oldphone
tr 'Phone Number';ak (code);se '[5;25fz1cfi20544 3}';gu 70;a=result
if a~='' then do;code=a;save=1;end;tr '[5;25f'code
ak (pn1);se '[5;30fz1cfi20544 3}';gu 70;a=result
if a~='' then do;pn1=a;end;tr '[5;30f'pn1;
ak (pn2);se '[5;34fz1cfi20544 4}';gu 70;a=result
if a~='' then do;pn2=a;end;tr '[5;34f'pn2;
newphone=pn1""pn2;newad=ads"/"newphone
if exists(oldad) then tr "$ rename "oldad" "newad"}";signal EDD
ED4:tr 'Baud Rate';ak (baud);se '[6;24fz1cfi20481 6}';gu 70;a=result
if a~='' then do;baud=a;save=1;end;tr '[6;24f'baud;signal EDD
ED5:tr 'Comment';ak (comment);se '[7;24fz1cfi4096 24}';gu 70;a=result
if a~='' then do;comment=a;save=1;end;tr '[7;24f'comment;signal EDD
ED6:;if save=0 then signal TOP;tr "f1[8;0f"center("Please wait...",s)
call COUNT;ncount=count-1;call SAVECFG;call KILL;signal SAVL
KILL:;do x=ed to bbsnum-1;x2=x+1;na.x=na.x2;st.x=st.x2;ph1.x=ph1.x2;ph2.x=ph2.x2
ph3.x=ph3.x2;ba.x=ba.x2;com.x=com.x2;col.x=col.x2;acc.x=acc.x2;bbsad.x=bbsad.x2;end;bbsnum=bbsnum-1
call open(bbsl,p2,'W');do x=1 to bbsnum
call writeln(bbsl,na.x'|'st.x'|'ph1.x'|'ph2.x'|'ph3.x'|'ba.x'|'com.x'|'col.x'|'acc.x'|'bbsad.x);se 'c9.';end
call close(bbsl);return
CLEAR:;
tr "[20;0f[K";do line=8 to 17;tr "["line";0f[K";end;return
CHEKAD:
adss=ads"/"bbsad
if exists(adss) then do;signal addit;end;return
if ~exists(adss) then do;bbsad=bbsad;end;return
ADDIT:bbsad=bbsad+1;signal chekad

ERROR:;call MOR;logentry "Compulist ERROR Line: "||SIGL
Tr "Program Error - Error in Line" SIGL;tr "Sysop Informed";exit

IOERR:;call MOR;logentry "Compulist IOERR Line: "||SIGL
Tr "IO Error - Error in Line" SIGL;tr "Sysop Informed";exit

SYNTAX:;call MOR;logentry "Compulist ERROR Line: "||SIGL||" Code: "||RC
Tr "Syntax Error - Error in Line" SIGL'  error code: ' RC;tr "Sysop Informed";exit