{$I-}

{ External Protocol Editor for ViSiON BBS Software}
{ Written originally by The SlaveLord }

Program proteditor;

uses dos,crt,scrninpt,scrnunit,gentypes,prompts,gensubs;

const normal=$1f;
      barcolor=127-14;

var w,w1:window;
    k:char;
    posi:integer;
    dlpro,ulpro:array[1..30] of protorec;
    tp:protorec;
    f:file of protorec;
    totaldown,totalup:integer;

 function exist(fs:string):boolean;
  var ft:file;
 begin
  assign(ft,fs);
  reset(ft);
  if ioresult<>0 then exist:=false else exist:=true;
  close(ft);
 end;

 procedure quitprog;
 var ct:integer;
 begin
   assign(f,'D_Prot.Dat');
   rewrite(f);
   if totaldown<>0 then
     for ct:=1 to totaldown do write(f,dlpro[ct]);
   close(f);
   assign(f,'U_Prot.Dat');
   rewrite(f);
   if totalup<>0 then for ct:=1 to totalup do write(f,ulpro[ct]);
   close(f);
   setcurwindow(w);
   closewindow;
   setcurwindow(w1);
   closewindow;
   textmode(co80);
   setcolor(15);
   gotoxy(23,17);
   writeln('ViSiON External Protocol Editor 1.00');
   gotoxy(1,20);
   halt;
 end;

 procedure setit;
 begin
   setcurwindow(w1);
   closewindow;
   openwindow(w1,1,1,54,24,0,0);
   setcurwindow(w1);
   gotoxy(1,1);
   setcolor(15);
 end;

 procedure listdlprot;
 var ct:integer;
 begin
   setit;
   setcolor(15);
   if totaldown=0 then begin
      writeln('Sorry, there are no Download Protocols defined!');
      writeln;
      writeln('Press a key');
      repeat until bioskey<>#0;
      exit;
   end;
   for ct:=1 to totaldown do begin
     writeln('D/L Protocol #',ct);
     writeln('Key         :',dlpro[ct].key);
     writeln('Description :',dlpro[ct].desc);
     writeln('Command Line:',dlpro[ct].cline);
     writeln('EXE Name    :',dlpro[ct].exename);
     writeln('Press a key');
     writeln;
     repeat until bioskey<>#0;
   end;
 end;

 procedure listulprot;
 var ct:integer;
 begin
   setit;
   setcolor(15);
   if totalup=0 then begin
     writeln('Sorry, there are no Upload Protocols Defined.');
     writeln;
     writeln('Press any key');
     repeat until bioskey<>#0;
     exit;
   end;
   for ct:=1 to totalup do begin
     writeln('Upload Protocol #',ct);
     writeln('Key         :',ulpro[ct].key);
     writeln('Description :',ulpro[ct].desc);
     writeln('Command Line:',ulpro[ct].cline);
     writeln('EXE Name    :',ulpro[ct].exename);
     writeln('Press any key');
     repeat until bioskey<>#0;
     writeln;
   end;
 end;

 procedure readprotos;
 begin
   totaldown:=0;
   assign(f,'D_Prot.Dat');
   reset(f);
   if ioresult<>0 then rewrite (f);
   while not eof(f) do begin
     read(f,tp);
     inc(totaldown);
     dlpro[totaldown]:=tp;
   end;
   close(f);
   totalup:=0;
   assign(f,'U_Prot.Dat');
   reset(f);
   if ioresult<>0 then rewrite (f);
   while not eof(f) do begin
     read(f,tp);
     inc(totalup);
     ulpro[totalup]:=tp;
   end;
   close(f);
 end;

 procedure adddlprot;
 var c,k:char;
     po:integer;
     t1,t2,t3:string;
     keys:string;
     ct:integer;
 begin
  setit;
  if totaldown=30 then begin
    writeln('Sorry, you may only have 30 protocols!');
    repeat until bioskey<>#0;
    exit;
  end;
  keys:='';
  if totaldown<>0 then for ct:=1 to totaldown do keys:=keys+dlpro[ct].key;
  setcolor(15);
  gotoxy(1,1);
  writeln('Add a D/L Protocol');
  repeat
  gotoxy(1,3);
  write('Enter the Key to use:');
  k:=readkey;
  ct:=ord(k);
  if ct>96 then ct:=ct-32;
  c:=chr(ct);
  po:=pos(c,keys);
  if po>0 then begin
   gotoxy(1,10);
   writeln(#7,#7,#7,#7,'That Key is in use!');
   end;
  until (ct>=ord('A')) and (ct<=ord('Z')) and (pos(c,keys)=0);
  tp.key:=c;
  writeln(c);
  write('Enter the Description for the Protocol:');
  readln(t1);
  if t1='' then exit;
  tp.desc:=t1;
  writeln;
  writeln('Enter the command line for the protocol:');
  writeln('%1=Com Port,%2=Comm Lock Rate,%3=Connect Rate');
  write('%4=DSZ Log:');
  readln(t2);
  writeln;
  if t2='' then exit;
  if t2[1]<>' ' then tp.cline:=' '+t2 else tp.cline:=t2;
  write('Enter the EXE Name:');
  readln(t3);
  tp.exename:=t3;
  writeln;
  writeln('Adding...');
  inc(totaldown);
  dlpro[totaldown]:=tp;
  end;

 procedure addulprot;
 var c,k:char;
     po:integer;
     t1,t2,t3:string;
     keys:string;
     ct:integer;
 begin
  setit;
  if totalup=30 then begin
    writeln('Sorry, you may not have more then 30 protocols!');
    repeat until bioskey<>#0;
    exit;
  end;
  keys:='';
  if totalup<>0 then for ct:=1 to totalup do keys:=keys+ulpro[ct].key;
  setcolor(15);
  gotoxy(1,1);
  writeln('Add a U/L Protocol');
  repeat
  gotoxy(1,3);
  write('Enter the Key to use:');
  k:=readkey;
  ct:=ord(k);
  if ct>96 then ct:=ct-32;
  c:=chr(ct);
  po:=pos(c,keys);
  if po>0 then begin
   gotoxy(1,10);
   writeln(#7,#7,#7,#7,'That Key is in use!');
   end;
  until (ct>=ord('A')) and (ct<=ord('Z')) and (pos(c,keys)=0);
  tp.key:=c;
  writeln(c);
  write('Enter the Description for the Protocol:');
  readln(t1);
  if t1='' then exit;
  writeln;
  tp.desc:=t1;
  writeln('Enter the command line for the protocol:');
  writeln('%1=Com Port,%2=Comm Lock Rate,%3=Connect Rate');
  write('%4=DSZ Log:');
  readln(t2);
  writeln;
  if t2='' then exit;
  if t2[1]<>' ' then tp.cline:=' '+t2 else tp.cline:=t2;
  write('Enter the EXE Name:');
  readln(t3);
  tp.exename:=t3;
  writeln;
  writeln('Adding...');
  inc(totalup);
  ulpro[totalup]:=tp;
  end;


 procedure setbar;
 begin
   setcurwindow(w);
   setcolor(normal);
   if posi=1 then setcolor(barcolor);
   gotoxy(2,4);
   write(' Add a D/L Protocol ');
   setcolor(normal);
   if posi=2 then setcolor(barcolor);
   gotoxy(2,5);
   write(' Add a U/L Protocol ');
   setcolor(normal);
   if posi=3 then setcolor(barcolor);
   gotoxy(2,6);
   write(' Edit D/L Protocols ');
   setcolor(normal);
   if posi=4 then setcolor(barcolor);
   gotoxy(2,7);
   write(' Edit U/L Protocols ');
   setcolor(normal);
   if posi=5 then setcolor(barcolor);
   gotoxy(2,8);
   write(' Del a D/L Protocol ');
   setcolor(normal);
   if posi=6 then setcolor(barcolor);
   gotoxy(2,9);
   write(' Del a U/L Protocol ');
   setcolor(normal);
   if posi=7 then setcolor(barcolor);
   gotoxy(2,10);
   write(' List D/L Protocols ');
   setcolor(normal);
   if posi=8 then setcolor(barcolor);
   gotoxy(2,11);
   write(' List U/L Protocols ');
   setcolor(normal);
   if posi=9 then setcolor(barcolor);
   gotoxy(2,12);
   write(' Quit Proto Editor  ');
 end;

 procedure editdlprot;
 var ct,tt:integer;
     keys,t1:string;
     c,k:char;
 begin
   setit;
   setcolor(15);
   gotoxy(1,1);
   if totaldown=0 then begin
     writeln('Sorry, there are no protocols to edit.');
     repeat until bioskey<>#0;
   exit;
   end;
   writeln('Edit D/L Protocol');
   keys:='';
   if totaldown<>0 then for ct:=1 to totaldown do keys:=keys+dlpro[ct].key;
   writeln('There are ',totaldown,' protocol(s)');
   write('Edit [1-',totaldown,']:');
   readln(t1);
   if t1='' then exit;
   tt:=valu(t1);
   if (tt<1) or (tt>totaldown) then exit;
   writeln;
   writeln;
   ct:=tt;
   repeat;
     gotoxy(1,5);
     write('Key for Protocol: [CR=',dlpro[ct].key,']:');
     k:=readkey;
     tt:=ord(k);
     if tt>96 then tt:=tt-32;
     c:=chr(tt);
     if pos(c,keys)>0 then begin
       gotoxy(1,10);
       writeln(#7,#7,#7,#7,'That key is in use!');
     end;
   until (tt=13) or (tt>=ord('A')) and (tt<=ord('Z')) and (pos(c,keys)=0);
   if tt=13 then c:=dlpro[ct].key;
   tp.key:=c;
   writeln(c);
   write('Protocol Description: [CR=',dlpro[ct].desc,']:');
   readln(t1);
   if t1='' then t1:=dlpro[ct].desc;
   writeln;
   tp.desc:=t1;
   writeln('Protocol Command Line: %1 for Comm Port');
   writeln('%2=Comm Lock In baud, %3=Connect Baud Rate');
   writeln('%4=DSZ Log, [CR=',dlpro[ct].cline,']');
   write('Command Line:');
   readln(t1);
   if t1='' then t1:=dlpro[ct].cline;
   if t1[1]<>' ' then tp.cline:=' '+t1 else
   tp.cline:=t1;
   writeln;
   write('EXE Name: [CR=',dlpro[ct].exename,']:');
   readln(t1);
   if t1='' then t1:=dlpro[ct].exename;
   writeln;
   tp.exename:=t1;
   dlpro[ct]:=tp;
   writeln;
   writeln('Complete, hit any key to continue.');
   repeat until bioskey<>#0;
 end;

  procedure editulprot;
 var ct,tt:integer;
     keys,t1:string;
     c,k:char;
 begin
   setit;
   setcolor(15);
   gotoxy(1,1);
   if totalup=0 then begin
     writeln('Sorry, there are no protocols to edit.');
     repeat until bioskey<>#0;
   exit;
   end;
   writeln('Edit U/L Protocol');
   keys:='';
   if totalup<>0 then for ct:=1 to totalup do keys:=keys+ulpro[ct].key;
   writeln('There are ',totalup,' protocol(s)');
   write('Edit [1-',totalup,']:');
   readln(t1);
   if t1='' then exit;
   tt:=valu(t1);
   if (tt<1) or (tt>totalup) then exit;
   writeln;
   writeln;
   ct:=tt;
   repeat;
     gotoxy(1,5);
     write('Key for Protocol: [CR=',ulpro[ct].key,']:');
     k:=readkey;
     tt:=ord(k);
     if tt>96 then tt:=tt-32;
     c:=chr(tt);
     if pos(c,keys)>0 then begin
       gotoxy(1,10);
       writeln(#7,#7,#7,#7,'That key is in use!');
     end;
   until (tt=13) or (tt>=ord('A')) and (tt<=ord('Z')) and (pos(c,keys)=0);
   if tt=13 then c:=ulpro[ct].key;
   tp.key:=c;
   writeln(c);
   write('Protocol Description: [CR=',ulpro[ct].desc,']:');
   readln(t1);
   if t1='' then t1:=ulpro[ct].desc;
   writeln;
   tp.desc:=t1;
   writeln('Protocol Command Line: %1 for Comm Port');
   writeln('%2=Comm Lock In baud, %3=Connect Baud Rate');
   writeln('%4=DSZ Log, [CR=',ulpro[ct].cline,']');
   write('Command Line:');
   readln(t1);
   if t1='' then t1:=ulpro[ct].cline;
   if t1[1]<>' ' then tp.cline:=' '+t1 else
   tp.cline:=t1;
   writeln;
   write('EXE Name: [CR=',ulpro[ct].exename,']:');
   readln(t1);
   if t1='' then t1:=ulpro[ct].exename;
   writeln;
   tp.exename:=t1;
   ulpro[ct]:=tp;
   writeln;
   writeln('Complete, hit any key to continue.');
   repeat until bioskey<>#0;
 end;

 procedure deldlprot;
 var ct,tt:integer;
     s1:string;
 begin
   setit;
   setcolor(15);
   if totaldown=0 then begin
     writeln('Sorry, there are no protocols to delete.');
     repeat until bioskey<>#0;
     exit;
   end;
   writeln('Delete a D/L Protocol');
   writeln;
   writeln('There are ',totaldown,' protocols.');
   writeln;
   write('Which Protocol to delete: [1-',totaldown,']:');
   readln(s1);
   if s1='' then exit;
   tt:=valu(s1);
   if (tt<1) or (tt>totaldown) then exit;
   if tt=totaldown then begin
     dec(totaldown);
     writeln;
     writeln('Protocol ',tt,' is deleted.');
     exit;
   end;
   for ct:=tt to totaldown-1 do dlpro[ct]:=dlpro[ct+1];
   dec(totaldown);
   writeln;
   writeln('Protocol ',tt,' is deleted.');
 end;

  procedure delulprot;
 var ct,tt:integer;
     s1:string;
 begin
   setit;
   setcolor(15);
   if totalup=0 then begin
     writeln('Sorry, there are no protocols to delete.');
     repeat until bioskey<>#0;
     exit;
   end;
   writeln('Delete a U/L Protocol');
   writeln;
   writeln('There are ',totalup,' protocols.');
   writeln;
   write('Which Protocol to delete: [1-',totalup,']:');
   readln(s1);
   if s1='' then exit;
   tt:=valu(s1);
   if (tt<1) or (tt>totalup) then exit;
   if tt=totalup then begin
     dec(totalup);
     writeln;
     writeln('Protocol ',tt,' is deleted.');
     exit;
   end;
   for ct:=tt to totalup-1 do ulpro[ct]:=ulpro[ct+1];
   dec(totalup);
   writeln;
   writeln('Protocol ',tt,' is deleted.');
 end;


 procedure openit;
 begin
  openwindow(w,55,1,79,14,$1f,$1f-1);
  setcurwindow(w);
  gotoxy(2,2);
  setcolor($1f);
  writeln('ViSiON ProtoEdit 1.00');
 end;

begin
  readprotos;
  clrscr;
  openwindow(w1,1,1,54,24,0,0);
  {openwindow(w,55,1,79,14,$1f,$1f-1);
  setcurwindow(w);
  gotoxy(2,2);
  setcolor($1f);
  writeln('ViSiON ProtoEdit 1.00'); }
  openit;
  posi:=1;
  setbar;
   repeat
     k:=bioskey;
       case k of
         #200:begin
              posi:=posi-1;
              if posi=0 then posi:=9;
              setbar;
              end;
         #208:begin
              posi:=posi+1;
              if posi=10 then posi:=1;
              setbar;
              end;
         #13:begin
              setcurwindow(w);
              closewindow;
              case posi of
              1:adddlprot; {add d/l protocol}
              2:addulprot; {add u/l protocol}
              3:editdlprot; {edit d/l protocol}
              4:editulprot; {edit u/l protocol}
              5:deldlprot; {del a d/l protocol}
              6:delulprot; {del a u/l protocol}
              7:listdlprot;
              8:listulprot;
              9:quitprog;
            end;
            openit;
            setbar;
         end;
         end;
     until k=#27;
     quitprog;
end.