home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 153.img / TELES.ZIP / SYSOPUT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-23  |  6KB  |  223 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6. {$V-}
  7.  
  8. Unit SysopUt;
  9.  
  10. Interface
  11.  
  12. Uses
  13.   Crt,
  14.   Dos,
  15.   Turbo3,
  16.   Common;
  17.  
  18. {function mln(i:astr; l:integer):astr;
  19. function mn(i,l:integer):astr;
  20. function okfile(fn:astr):boolean;
  21. function align(fn:astr):astr;
  22. function vdir(var d:astr):boolean;
  23. procedure fix(var fn:astr);
  24. procedure uedit(usern:integer);}
  25. procedure voteprint;
  26. {procedure tedit;
  27. procedure copyfile(srcname,destname:astr);}
  28. procedure dosj(cmd:char);
  29.  
  30. Implementation
  31.  
  32. var topheap:^byte;
  33. {    i1:astr;
  34.     ix:array[1..9] of string[79];
  35.     found,donedos,dld,d1,d2,done,abort:boolean;
  36.     c1,c2,c3:integer;
  37.     f,f1:file of byte;
  38.     x:byte;
  39.     cd:astr;
  40.     filenamef,s1,s2,s3:astr;
  41.     all:boolean;
  42.     chksum:byte;
  43.     crc:integer;
  44.     dta:string[44];
  45.     ft:byte;}
  46.     lastvar:byte;
  47.  
  48. function mln(i:astr; l:integer):astr;
  49. begin
  50.   while length(i)<l do i:=i+' ';
  51.   mln:=i;
  52. end;
  53.  
  54. function mn(i,l:integer):astr;
  55. begin
  56.   mn:=mln(cstr(i),l);
  57. end;
  58.  
  59. function okfile(fn:astr):boolean;
  60. begin
  61.   okfile:=(pos('.LST',FN)=0) and (pos('.DAT',fn)=0) and (pos('.BRD',fn)=0)
  62.           and (pos('.DIR',fn)=0) and (pos('.LOG',fn)=0);
  63.   if (not so) and (pos('.TXT',fn)=0) and (pos('.MSG',fn)=0)and (pos('.???',FN)=0)
  64.     then okfile:=false;
  65. end;
  66.  
  67. function align(fn:astr):astr;
  68. var f,e,t:astr; c,c1:integer;
  69. begin
  70.   c:=pos('.',fn);
  71.   if c=0 then begin
  72.     f:=fn; e:='   ';
  73.   end else begin
  74.     f:=copy(fn,1,c-1); e:=copy(fn,c+1,3);
  75.   end;
  76.   while length(f)<8 do f:=f+' ';
  77.   while length(e)<3 do e:=e+' ';
  78.   c:=pos('*',f); if c<>0 then for c1:=c to 8 do f[c1]:='?';
  79.   c:=pos('*',e); if c<>0 then for c1:=c to 3 do e[c1]:='?';
  80.   align:=f+'.'+e;
  81. end;
  82.  
  83. function vdir(var d:astr):boolean;
  84. var x:boolean;
  85. begin
  86.   if d[length(d)]='\' then d:=copy(d,1,length(d)-1);
  87. (*  if (d='DLOADS') or (d='GFILES') then x:=true else x:=false;
  88.   if so AND (D='.') then x:=true; *)
  89.   x:=true;
  90.   vdir:=x;
  91. end;
  92.  
  93. procedure fix(var fn:astr);
  94. var i,i1:astr; c1,c2:integer; ok:boolean;
  95. begin
  96.   cd:=systat.gfilepath+'';
  97. (*  c1:=pos('\',fn); ok:=true;
  98.   if c1<>0 then begin
  99.     i:=copy(fn,1,c1-1);
  100.     fn:=copy(fn,c1+1,15);
  101.     if not vdir(i) then ok:=false;
  102.   end else i:='';*)
  103.   if i='' then i:=cd;
  104.   if fn='' then fn:='*.*';
  105.   fn:=i+align(fn);
  106.   if (pos('.MSG',fn)=0) and (pos('.TXT',fn)=0) and (pos('?',fn)=0) and (not so) then ok:=false;
  107.   if not ok then fn:='';
  108.   if not okfile(fn) then fn:='';
  109. end;
  110.  
  111. {$I DOSP1.PAS}
  112.  
  113. {
  114. procedure eed;
  115. var i1,i2,ii:integer; c:char; ij:astr; s:astr;
  116. begin
  117.   prt('Protocal number to delete? '); input(s,1); ii:=value(s);
  118.   if (ii>0) and (ii<=numprotocals) then begin
  119.     prompt(protocals[ii].descr+'   Delete it? ');
  120.     if yn then begin
  121.       numprotocals:=numprotocals-1; for i1:=ii to numprotocals do
  122.         protocals[i1]:=protocals[i1+1];
  123.       rewrite(xp); for i1:=1 to numprotocals do write(xp,protocals[i1]);
  124.       close(xp);
  125.       end;
  126.     end;
  127. end;
  128.  
  129. procedure eem;
  130. var i1,i2,ii:integer; c:char; ij:astr; s:astr;
  131. begin
  132.   prt('Protocal number to edit? '); input(s,1); ii:=value(s);
  133.   if (ii>0) and (ii<=numprotocals) then begin with protocals[ii] do
  134.   repeat
  135.     cls;
  136.     print('   Protocal   : '+cstr(ii));
  137.     print('1. Description: '+descr);
  138.     print('2. Send out   : '+scmd);
  139.     print('3. Recieve in : '+rcmd);
  140.     print('4. Xfer Ok    : '+cstr(xferok));
  141.     print('Q. Quit');
  142.     nl; prt('Which? '); onek(c,'Q1234');
  143.     case c of
  144.       '1':begin prt('New description? '); mpl(30); inputl(descr,30); end;
  145.       '2':begin
  146.             nl;
  147.             print('@1=Baud @2=Port @3=Filename');
  148.             prt('New send out command line? '); mpl(40);
  149.             input(scmd,40);
  150.           end;
  151.       '3':begin
  152.             nl;
  153.             print('@1=Baud @2=Port @3=Filename');
  154.             prt('New recieve command line? '); mpl(40);
  155.             input(rcmd,40);
  156.           end;
  157.       '4':begin prt('Xfer Ok Value? '); input(s,1); xferok:=value(s); end;
  158.     end;
  159.   until (c='Q') or hangup;
  160.   reset(xp); seek(xp,ii-1); write(xp,protocals[ii]); close(xp); c:=' ';
  161.  end;
  162. end;
  163.  
  164. procedure eei;
  165. var i1,i2,ii:integer; c:char; ij,s:astr;
  166. begin
  167.   prt('Protocal number to insert before? '); input(s,1); ii:=value(s);
  168.   if (ii>5) and (ii<=numprotocals+1) and (numprotocals<19) then begin
  169.     numprotocals:=numprotocals+1; for i1:=numprotocals downto ii do
  170.       protocals[i1]:=protocals[i1-1];
  171.     with protocals[ii] do begin
  172.       descr:='NEW Protocal';
  173.       xferok:=-1;
  174.     end;
  175.     rewrite(xp); for i1:=1 to numprotocals do write(xp,protocals[i1]);
  176.     close(xp);
  177.   end;
  178. end;
  179.  
  180. procedure Exproedit;
  181. var i1,i2,ii:integer; c:char; ij:astr; abort,next:boolean; st:astr;
  182. begin
  183.  if checkpw then
  184.  repeat
  185.   cls; abort:=false;
  186.   cl(0);printacr('NN Description of Protocal        Xfer Ok Code',abort,next);
  187.   cl(9);printacr('-- ------------------------------ ============',abort,next);
  188.   ii:=1;
  189.   while (ii<=numprotocals) and (not abort) do
  190.     with protocals[ii] do begin
  191.       st:=mn(ii+5,2)+' '+mln(descr,30)+'    '+mn(xferok,6);
  192.       printacr(st,abort,next);
  193.       ii:=ii+1;
  194.     end;
  195.   nl; prt('D)elete, I)nsert, M)odify, Q)uit  :'); onek(c,'QDIM');
  196.   case c of
  197.     'D':eed;
  198.     'M':eem;
  199.     'I':eei;
  200.   end;
  201.  until (c='Q') or hangup;
  202. end;
  203. }
  204.  
  205. procedure dosj(cmd:char);
  206. begin
  207.   cd:='GFILES';
  208.   topheap:=ptr(seg(lastvar),ofs(lastvar));
  209.   release(topheap);
  210.   case upcase(cmd) of
  211.     'U':uedit(usernum);
  212.     'E':begin
  213.           prompt('Filename: ');
  214.           mpl(12);
  215.           input(ix[2],12);
  216.           tedit;
  217.         end;
  218.   end;
  219. end;
  220.  
  221. END.
  222.  
  223.