home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / vi_si_on / protedit.pas < prev    next >
Pascal/Delphi Source File  |  1991-03-16  |  13KB  |  535 lines
  1. {$I-}
  2.  
  3. { External Protocol Editor for ViSiON BBS Software}
  4. { Written originally by The SlaveLord }
  5.  
  6. Program proteditor;
  7.  
  8. uses dos,crt,scrninpt,scrnunit,gentypes,prompts,gensubs;
  9.  
  10. const normal=$1f;
  11.       barcolor=127-14;
  12.  
  13. var w,w1:window;
  14.     k:char;
  15.     posi:integer;
  16.     dlpro,ulpro:array[1..30] of protorec;
  17.     tp:protorec;
  18.     f:file of protorec;
  19.     totaldown,totalup:integer;
  20.  
  21.  function exist(fs:string):boolean;
  22.   var ft:file;
  23.  begin
  24.   assign(ft,fs);
  25.   reset(ft);
  26.   if ioresult<>0 then exist:=false else exist:=true;
  27.   close(ft);
  28.  end;
  29.  
  30.  procedure quitprog;
  31.  var ct:integer;
  32.  begin
  33.    assign(f,'D_Prot.Dat');
  34.    rewrite(f);
  35.    if totaldown<>0 then
  36.      for ct:=1 to totaldown do write(f,dlpro[ct]);
  37.    close(f);
  38.    assign(f,'U_Prot.Dat');
  39.    rewrite(f);
  40.    if totalup<>0 then for ct:=1 to totalup do write(f,ulpro[ct]);
  41.    close(f);
  42.    setcurwindow(w);
  43.    closewindow;
  44.    setcurwindow(w1);
  45.    closewindow;
  46.    textmode(co80);
  47.    setcolor(15);
  48.    gotoxy(23,17);
  49.    writeln('ViSiON External Protocol Editor 1.00');
  50.    gotoxy(1,20);
  51.    halt;
  52.  end;
  53.  
  54.  procedure setit;
  55.  begin
  56.    setcurwindow(w1);
  57.    closewindow;
  58.    openwindow(w1,1,1,54,24,0,0);
  59.    setcurwindow(w1);
  60.    gotoxy(1,1);
  61.    setcolor(15);
  62.  end;
  63.  
  64.  procedure listdlprot;
  65.  var ct:integer;
  66.  begin
  67.    setit;
  68.    setcolor(15);
  69.    if totaldown=0 then begin
  70.       writeln('Sorry, there are no Download Protocols defined!');
  71.       writeln;
  72.       writeln('Press a key');
  73.       repeat until bioskey<>#0;
  74.       exit;
  75.    end;
  76.    for ct:=1 to totaldown do begin
  77.      writeln('D/L Protocol #',ct);
  78.      writeln('Key         :',dlpro[ct].key);
  79.      writeln('Description :',dlpro[ct].desc);
  80.      writeln('Command Line:',dlpro[ct].cline);
  81.      writeln('EXE Name    :',dlpro[ct].exename);
  82.      writeln('Press a key');
  83.      writeln;
  84.      repeat until bioskey<>#0;
  85.    end;
  86.  end;
  87.  
  88.  procedure listulprot;
  89.  var ct:integer;
  90.  begin
  91.    setit;
  92.    setcolor(15);
  93.    if totalup=0 then begin
  94.      writeln('Sorry, there are no Upload Protocols Defined.');
  95.      writeln;
  96.      writeln('Press any key');
  97.      repeat until bioskey<>#0;
  98.      exit;
  99.    end;
  100.    for ct:=1 to totalup do begin
  101.      writeln('Upload Protocol #',ct);
  102.      writeln('Key         :',ulpro[ct].key);
  103.      writeln('Description :',ulpro[ct].desc);
  104.      writeln('Command Line:',ulpro[ct].cline);
  105.      writeln('EXE Name    :',ulpro[ct].exename);
  106.      writeln('Press any key');
  107.      repeat until bioskey<>#0;
  108.      writeln;
  109.    end;
  110.  end;
  111.  
  112.  procedure readprotos;
  113.  begin
  114.    totaldown:=0;
  115.    assign(f,'D_Prot.Dat');
  116.    reset(f);
  117.    if ioresult<>0 then rewrite (f);
  118.    while not eof(f) do begin
  119.      read(f,tp);
  120.      inc(totaldown);
  121.      dlpro[totaldown]:=tp;
  122.    end;
  123.    close(f);
  124.    totalup:=0;
  125.    assign(f,'U_Prot.Dat');
  126.    reset(f);
  127.    if ioresult<>0 then rewrite (f);
  128.    while not eof(f) do begin
  129.      read(f,tp);
  130.      inc(totalup);
  131.      ulpro[totalup]:=tp;
  132.    end;
  133.    close(f);
  134.  end;
  135.  
  136.  procedure adddlprot;
  137.  var c,k:char;
  138.      po:integer;
  139.      t1,t2,t3:string;
  140.      keys:string;
  141.      ct:integer;
  142.  begin
  143.   setit;
  144.   if totaldown=30 then begin
  145.     writeln('Sorry, you may only have 30 protocols!');
  146.     repeat until bioskey<>#0;
  147.     exit;
  148.   end;
  149.   keys:='';
  150.   if totaldown<>0 then for ct:=1 to totaldown do keys:=keys+dlpro[ct].key;
  151.   setcolor(15);
  152.   gotoxy(1,1);
  153.   writeln('Add a D/L Protocol');
  154.   repeat
  155.   gotoxy(1,3);
  156.   write('Enter the Key to use:');
  157.   k:=readkey;
  158.   ct:=ord(k);
  159.   if ct>96 then ct:=ct-32;
  160.   c:=chr(ct);
  161.   po:=pos(c,keys);
  162.   if po>0 then begin
  163.    gotoxy(1,10);
  164.    writeln(#7,#7,#7,#7,'That Key is in use!');
  165.    end;
  166.   until (ct>=ord('A')) and (ct<=ord('Z')) and (pos(c,keys)=0);
  167.   tp.key:=c;
  168.   writeln(c);
  169.   write('Enter the Description for the Protocol:');
  170.   readln(t1);
  171.   if t1='' then exit;
  172.   tp.desc:=t1;
  173.   writeln;
  174.   writeln('Enter the command line for the protocol:');
  175.   writeln('%1=Com Port,%2=Comm Lock Rate,%3=Connect Rate');
  176.   write('%4=DSZ Log:');
  177.   readln(t2);
  178.   writeln;
  179.   if t2='' then exit;
  180.   if t2[1]<>' ' then tp.cline:=' '+t2 else tp.cline:=t2;
  181.   write('Enter the EXE Name:');
  182.   readln(t3);
  183.   tp.exename:=t3;
  184.   writeln;
  185.   writeln('Adding...');
  186.   inc(totaldown);
  187.   dlpro[totaldown]:=tp;
  188.   end;
  189.  
  190.  procedure addulprot;
  191.  var c,k:char;
  192.      po:integer;
  193.      t1,t2,t3:string;
  194.      keys:string;
  195.      ct:integer;
  196.  begin
  197.   setit;
  198.   if totalup=30 then begin
  199.     writeln('Sorry, you may not have more then 30 protocols!');
  200.     repeat until bioskey<>#0;
  201.     exit;
  202.   end;
  203.   keys:='';
  204.   if totalup<>0 then for ct:=1 to totalup do keys:=keys+ulpro[ct].key;
  205.   setcolor(15);
  206.   gotoxy(1,1);
  207.   writeln('Add a U/L Protocol');
  208.   repeat
  209.   gotoxy(1,3);
  210.   write('Enter the Key to use:');
  211.   k:=readkey;
  212.   ct:=ord(k);
  213.   if ct>96 then ct:=ct-32;
  214.   c:=chr(ct);
  215.   po:=pos(c,keys);
  216.   if po>0 then begin
  217.    gotoxy(1,10);
  218.    writeln(#7,#7,#7,#7,'That Key is in use!');
  219.    end;
  220.   until (ct>=ord('A')) and (ct<=ord('Z')) and (pos(c,keys)=0);
  221.   tp.key:=c;
  222.   writeln(c);
  223.   write('Enter the Description for the Protocol:');
  224.   readln(t1);
  225.   if t1='' then exit;
  226.   writeln;
  227.   tp.desc:=t1;
  228.   writeln('Enter the command line for the protocol:');
  229.   writeln('%1=Com Port,%2=Comm Lock Rate,%3=Connect Rate');
  230.   write('%4=DSZ Log:');
  231.   readln(t2);
  232.   writeln;
  233.   if t2='' then exit;
  234.   if t2[1]<>' ' then tp.cline:=' '+t2 else tp.cline:=t2;
  235.   write('Enter the EXE Name:');
  236.   readln(t3);
  237.   tp.exename:=t3;
  238.   writeln;
  239.   writeln('Adding...');
  240.   inc(totalup);
  241.   ulpro[totalup]:=tp;
  242.   end;
  243.  
  244.  
  245.  procedure setbar;
  246.  begin
  247.    setcurwindow(w);
  248.    setcolor(normal);
  249.    if posi=1 then setcolor(barcolor);
  250.    gotoxy(2,4);
  251.    write(' Add a D/L Protocol ');
  252.    setcolor(normal);
  253.    if posi=2 then setcolor(barcolor);
  254.    gotoxy(2,5);
  255.    write(' Add a U/L Protocol ');
  256.    setcolor(normal);
  257.    if posi=3 then setcolor(barcolor);
  258.    gotoxy(2,6);
  259.    write(' Edit D/L Protocols ');
  260.    setcolor(normal);
  261.    if posi=4 then setcolor(barcolor);
  262.    gotoxy(2,7);
  263.    write(' Edit U/L Protocols ');
  264.    setcolor(normal);
  265.    if posi=5 then setcolor(barcolor);
  266.    gotoxy(2,8);
  267.    write(' Del a D/L Protocol ');
  268.    setcolor(normal);
  269.    if posi=6 then setcolor(barcolor);
  270.    gotoxy(2,9);
  271.    write(' Del a U/L Protocol ');
  272.    setcolor(normal);
  273.    if posi=7 then setcolor(barcolor);
  274.    gotoxy(2,10);
  275.    write(' List D/L Protocols ');
  276.    setcolor(normal);
  277.    if posi=8 then setcolor(barcolor);
  278.    gotoxy(2,11);
  279.    write(' List U/L Protocols ');
  280.    setcolor(normal);
  281.    if posi=9 then setcolor(barcolor);
  282.    gotoxy(2,12);
  283.    write(' Quit Proto Editor  ');
  284.  end;
  285.  
  286.  procedure editdlprot;
  287.  var ct,tt:integer;
  288.      keys,t1:string;
  289.      c,k:char;
  290.  begin
  291.    setit;
  292.    setcolor(15);
  293.    gotoxy(1,1);
  294.    if totaldown=0 then begin
  295.      writeln('Sorry, there are no protocols to edit.');
  296.      repeat until bioskey<>#0;
  297.    exit;
  298.    end;
  299.    writeln('Edit D/L Protocol');
  300.    keys:='';
  301.    if totaldown<>0 then for ct:=1 to totaldown do keys:=keys+dlpro[ct].key;
  302.    writeln('There are ',totaldown,' protocol(s)');
  303.    write('Edit [1-',totaldown,']:');
  304.    readln(t1);
  305.    if t1='' then exit;
  306.    tt:=valu(t1);
  307.    if (tt<1) or (tt>totaldown) then exit;
  308.    writeln;
  309.    writeln;
  310.    ct:=tt;
  311.    repeat;
  312.      gotoxy(1,5);
  313.      write('Key for Protocol: [CR=',dlpro[ct].key,']:');
  314.      k:=readkey;
  315.      tt:=ord(k);
  316.      if tt>96 then tt:=tt-32;
  317.      c:=chr(tt);
  318.      if pos(c,keys)>0 then begin
  319.        gotoxy(1,10);
  320.        writeln(#7,#7,#7,#7,'That key is in use!');
  321.      end;
  322.    until (tt=13) or (tt>=ord('A')) and (tt<=ord('Z')) and (pos(c,keys)=0);
  323.    if tt=13 then c:=dlpro[ct].key;
  324.    tp.key:=c;
  325.    writeln(c);
  326.    write('Protocol Description: [CR=',dlpro[ct].desc,']:');
  327.    readln(t1);
  328.    if t1='' then t1:=dlpro[ct].desc;
  329.    writeln;
  330.    tp.desc:=t1;
  331.    writeln('Protocol Command Line: %1 for Comm Port');
  332.    writeln('%2=Comm Lock In baud, %3=Connect Baud Rate');
  333.    writeln('%4=DSZ Log, [CR=',dlpro[ct].cline,']');
  334.    write('Command Line:');
  335.    readln(t1);
  336.    if t1='' then t1:=dlpro[ct].cline;
  337.    if t1[1]<>' ' then tp.cline:=' '+t1 else
  338.    tp.cline:=t1;
  339.    writeln;
  340.    write('EXE Name: [CR=',dlpro[ct].exename,']:');
  341.    readln(t1);
  342.    if t1='' then t1:=dlpro[ct].exename;
  343.    writeln;
  344.    tp.exename:=t1;
  345.    dlpro[ct]:=tp;
  346.    writeln;
  347.    writeln('Complete, hit any key to continue.');
  348.    repeat until bioskey<>#0;
  349.  end;
  350.  
  351.   procedure editulprot;
  352.  var ct,tt:integer;
  353.      keys,t1:string;
  354.      c,k:char;
  355.  begin
  356.    setit;
  357.    setcolor(15);
  358.    gotoxy(1,1);
  359.    if totalup=0 then begin
  360.      writeln('Sorry, there are no protocols to edit.');
  361.      repeat until bioskey<>#0;
  362.    exit;
  363.    end;
  364.    writeln('Edit U/L Protocol');
  365.    keys:='';
  366.    if totalup<>0 then for ct:=1 to totalup do keys:=keys+ulpro[ct].key;
  367.    writeln('There are ',totalup,' protocol(s)');
  368.    write('Edit [1-',totalup,']:');
  369.    readln(t1);
  370.    if t1='' then exit;
  371.    tt:=valu(t1);
  372.    if (tt<1) or (tt>totalup) then exit;
  373.    writeln;
  374.    writeln;
  375.    ct:=tt;
  376.    repeat;
  377.      gotoxy(1,5);
  378.      write('Key for Protocol: [CR=',ulpro[ct].key,']:');
  379.      k:=readkey;
  380.      tt:=ord(k);
  381.      if tt>96 then tt:=tt-32;
  382.      c:=chr(tt);
  383.      if pos(c,keys)>0 then begin
  384.        gotoxy(1,10);
  385.        writeln(#7,#7,#7,#7,'That key is in use!');
  386.      end;
  387.    until (tt=13) or (tt>=ord('A')) and (tt<=ord('Z')) and (pos(c,keys)=0);
  388.    if tt=13 then c:=ulpro[ct].key;
  389.    tp.key:=c;
  390.    writeln(c);
  391.    write('Protocol Description: [CR=',ulpro[ct].desc,']:');
  392.    readln(t1);
  393.    if t1='' then t1:=ulpro[ct].desc;
  394.    writeln;
  395.    tp.desc:=t1;
  396.    writeln('Protocol Command Line: %1 for Comm Port');
  397.    writeln('%2=Comm Lock In baud, %3=Connect Baud Rate');
  398.    writeln('%4=DSZ Log, [CR=',ulpro[ct].cline,']');
  399.    write('Command Line:');
  400.    readln(t1);
  401.    if t1='' then t1:=ulpro[ct].cline;
  402.    if t1[1]<>' ' then tp.cline:=' '+t1 else
  403.    tp.cline:=t1;
  404.    writeln;
  405.    write('EXE Name: [CR=',ulpro[ct].exename,']:');
  406.    readln(t1);
  407.    if t1='' then t1:=ulpro[ct].exename;
  408.    writeln;
  409.    tp.exename:=t1;
  410.    ulpro[ct]:=tp;
  411.    writeln;
  412.    writeln('Complete, hit any key to continue.');
  413.    repeat until bioskey<>#0;
  414.  end;
  415.  
  416.  procedure deldlprot;
  417.  var ct,tt:integer;
  418.      s1:string;
  419.  begin
  420.    setit;
  421.    setcolor(15);
  422.    if totaldown=0 then begin
  423.      writeln('Sorry, there are no protocols to delete.');
  424.      repeat until bioskey<>#0;
  425.      exit;
  426.    end;
  427.    writeln('Delete a D/L Protocol');
  428.    writeln;
  429.    writeln('There are ',totaldown,' protocols.');
  430.    writeln;
  431.    write('Which Protocol to delete: [1-',totaldown,']:');
  432.    readln(s1);
  433.    if s1='' then exit;
  434.    tt:=valu(s1);
  435.    if (tt<1) or (tt>totaldown) then exit;
  436.    if tt=totaldown then begin
  437.      dec(totaldown);
  438.      writeln;
  439.      writeln('Protocol ',tt,' is deleted.');
  440.      exit;
  441.    end;
  442.    for ct:=tt to totaldown-1 do dlpro[ct]:=dlpro[ct+1];
  443.    dec(totaldown);
  444.    writeln;
  445.    writeln('Protocol ',tt,' is deleted.');
  446.  end;
  447.  
  448.   procedure delulprot;
  449.  var ct,tt:integer;
  450.      s1:string;
  451.  begin
  452.    setit;
  453.    setcolor(15);
  454.    if totalup=0 then begin
  455.      writeln('Sorry, there are no protocols to delete.');
  456.      repeat until bioskey<>#0;
  457.      exit;
  458.    end;
  459.    writeln('Delete a U/L Protocol');
  460.    writeln;
  461.    writeln('There are ',totalup,' protocols.');
  462.    writeln;
  463.    write('Which Protocol to delete: [1-',totalup,']:');
  464.    readln(s1);
  465.    if s1='' then exit;
  466.    tt:=valu(s1);
  467.    if (tt<1) or (tt>totalup) then exit;
  468.    if tt=totalup then begin
  469.      dec(totalup);
  470.      writeln;
  471.      writeln('Protocol ',tt,' is deleted.');
  472.      exit;
  473.    end;
  474.    for ct:=tt to totalup-1 do ulpro[ct]:=ulpro[ct+1];
  475.    dec(totalup);
  476.    writeln;
  477.    writeln('Protocol ',tt,' is deleted.');
  478.  end;
  479.  
  480.  
  481.  procedure openit;
  482.  begin
  483.   openwindow(w,55,1,79,14,$1f,$1f-1);
  484.   setcurwindow(w);
  485.   gotoxy(2,2);
  486.   setcolor($1f);
  487.   writeln('ViSiON ProtoEdit 1.00');
  488.  end;
  489.  
  490. begin
  491.   readprotos;
  492.   clrscr;
  493.   openwindow(w1,1,1,54,24,0,0);
  494.   {openwindow(w,55,1,79,14,$1f,$1f-1);
  495.   setcurwindow(w);
  496.   gotoxy(2,2);
  497.   setcolor($1f);
  498.   writeln('ViSiON ProtoEdit 1.00'); }
  499.   openit;
  500.   posi:=1;
  501.   setbar;
  502.    repeat
  503.      k:=bioskey;
  504.        case k of
  505.          #200:begin
  506.               posi:=posi-1;
  507.               if posi=0 then posi:=9;
  508.               setbar;
  509.               end;
  510.          #208:begin
  511.               posi:=posi+1;
  512.               if posi=10 then posi:=1;
  513.               setbar;
  514.               end;
  515.          #13:begin
  516.               setcurwindow(w);
  517.               closewindow;
  518.               case posi of
  519.               1:adddlprot; {add d/l protocol}
  520.               2:addulprot; {add u/l protocol}
  521.               3:editdlprot; {edit d/l protocol}
  522.               4:editulprot; {edit u/l protocol}
  523.               5:deldlprot; {del a d/l protocol}
  524.               6:delulprot; {del a u/l protocol}
  525.               7:listdlprot;
  526.               8:listulprot;
  527.               9:quitprog;
  528.             end;
  529.             openit;
  530.             setbar;
  531.          end;
  532.          end;
  533.      until k=#27;
  534.      quitprog;
  535. end.