home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 153.img / TELES.ZIP / INIT2.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-14  |  17KB  |  529 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.  
  9. Unit Unit2;
  10.  
  11. Interface
  12.  
  13. Uses
  14.   Crt,
  15.   Dos,
  16.   Common,
  17.   Unit0,
  18.   UnitX,
  19.   Unit1,
  20.   BoardEdt,
  21.   SysopUt,
  22.   FileSc,
  23.   MenuEdt;
  24.  
  25. procedure bulletins;
  26. procedure chuser;
  27. procedure pstat;
  28. procedure mailr;
  29. procedure init;
  30. procedure hangupphone;
  31. procedure zlog;
  32. PROCEDURE scan2(var cn:integer; iread:newtyp; var quit:boolean);
  33. procedure scan1;
  34. procedure getcaller;
  35. procedure qscan(var quit:boolean; tf:boolean);
  36. procedure nscan;
  37.  
  38. Implementation
  39.  
  40. procedure chuser;
  41. var n:integer;
  42. begin
  43.   if checkpw then begin
  44.     prt('Which user? ');
  45.     finduser(n);
  46.     if n>0 then begin
  47.       thisuser.sl:=realsl;
  48.       reset(uf);
  49.       seek(uf,usernum);
  50.       write(uf,thisuser);
  51.       seek(uf,n);
  52.       read(uf,thisuser);
  53.       close(uf);
  54.       realsl:=thisuser.sl;
  55.       usernum:=n;
  56.       if spd<>'KB' then sysoplog('#*#*#*# '+#3+#8+'Changed to '+nam);
  57.       topscr;
  58.     end;
  59.   end;
  60. end;
  61.  
  62. procedure pstat;
  63. var c:char;
  64. begin
  65.   outkey(chr(12));
  66.   with systat do begin
  67.     print('New User Pass   : '+boardpw);
  68.     prompt('Board is        : '); if closedsystem then print('Closed') else print('Open');
  69.     print('Number Users    : '+cstr(users));
  70.     print('Number calls    : '+cstr(callernum));
  71.     print('Date            : '+lastdate);
  72.     print('Time            : '+time);
  73.     print('Active today    : '+cstr(activetoday));
  74.     print('Calls today     : '+cstr(callstoday));
  75.     print('Messages today  : '+cstr(msgposttoday));
  76.     print('Email sent today: '+cstr(emailtoday));
  77.     print('Feed back today : '+cstr(fbacktoday));
  78.     print('Up today        : '+cstr(uptoday));
  79.     prompt('Sysop           : '); if sysop then begin sprompt(SYSTAT.SYSOPIN); end
  80.       else begin sprompt(SYSTAT.SYSOPOUT); nl; end;
  81.     print('Files waiting   : '+cstr(fw));
  82.     print('Disk free space : '+cstr(freek(0))+'k');
  83.     prompt('Sysop hours     : ');
  84.     if lowtime=hitime then
  85.       print('None')
  86.     else
  87.       print(tch(cstr(lowtime div 60))+':'+tch(cstr(lowtime mod 60))+' to '+
  88.                 tch(cstr(hitime div 60))+':'+tch(cstr(hitime mod 60)));
  89.  
  90.   end;
  91.   if not useron then begin
  92.     nl;nl;print('Hit any key');
  93.     getkey(c);
  94.   end;
  95. end;
  96.  
  97. procedure mailr;
  98. var ii:integer; mr:mailrec; abort,a:boolean; c:char; u:userrec; is:astr;
  99. begin
  100.   readingmail:=true;
  101.   {$I-} reset(mailfile); {$I+} c:=' ';
  102.   if ioresult=0 then begin
  103.     reset(uf);
  104.     ii:=filesize(mailfile)-1; c:=' ';
  105.     while (ii>=0) and (c<>'Q') and (not hangup) do begin
  106.       seek(mailfile,ii); read(mailfile,mr);
  107.       if mr.destin<>-1 then begin
  108.         repeat
  109.           seek(uf,mr.destin); read(uf,u); if systat.clearmsg then cls;
  110.           cl(1);prompt('  Title: ');cl(3);print(mr.title);
  111.           cl(1);prompt('     To: ');cl(9);print(u.name+' #'+cstr(mr.destin));
  112.           a:=true;
  113.           readmsg(mr.msg,a,next);
  114.           prt('Mail Read (R:e-read,D:elete,Q:uit,<space>,?) : ');
  115.           if next then c:=' ' else getkey(c); c:=upcase(c); print(c);
  116.           if c='D' then begin
  117.             close(uf); is:=rmail(ii); reset(uf);
  118.             if usernum=mr.destin then thisuser.waiting:=thisuser.waiting-1;
  119.           end;
  120.           nl;nl;
  121.         until (c<>'R') or hangup;
  122.       end;
  123.       ii:=ii-1;
  124.     end;
  125.     close(mailfile);
  126.     close(uf);
  127.   end;
  128.   readingmail:=false;
  129. end;
  130.  
  131. procedure init;
  132. var a,b,c:integer;
  133.     vdf:file of vdatar;
  134.     vd:vdatar;
  135.     fi:text;
  136.     i:astr;
  137.     f:file;
  138.     ch1:char;
  139. begin
  140.   if daynum(date)=0 then begin
  141.     clrscr;
  142.     writeln('Please set the date & time, it is required for operation.');
  143.     halt;
  144.   end;
  145.   initp1;
  146.   assign(vdf,systat.gfilepath+'voting.dat');
  147.   {$I-} reset(vdf); {$I+}
  148.   if ioresult=0 then begin
  149.     for a:=1 to 9 do begin
  150.       read(vdf,vd);
  151.       vqu[a]:=vd.numa<>0;
  152.     end;
  153.     close(vdf);
  154.   end else for a:=1 to 9 do vqu[a]:=false;
  155.   a:=freek(0);
  156.   {errorptr:=ofs(erhnd);}
  157. {!^ 62. Use the new ExitProc facility to replace ErrorPtr references.}
  158. end;
  159.  
  160. procedure hangupphone;
  161. var rl:real; try:integer;
  162.   procedure dely(r:real);
  163.   var r1:real;
  164.   begin
  165.     r1:=timer;
  166.     while abs(timer-r1)<r do;
  167.   end;
  168.  
  169. begin
  170.   try:=0;
  171.   term_ready(false);
  172.   while (try<2) and cdet do begin
  173.     dely(2.0);
  174.     pr1(#1#1#1);
  175.     rl:=timer;
  176.     while (cinkey<>'0') and (abs(timer-rl)<2.0) do;
  177.     dely(0.8);
  178.     pr(systat.hangup);
  179.     try:=try+1;
  180.     dely(0.3);
  181.   end;
  182. end;
  183.  
  184. procedure zlog;
  185. var d1:zlogt; n:integer; i:astr; zf:file of zlogt; abort,next:boolean;
  186.  
  187.   function f(x,n:integer):astr;
  188.   var i:astr;
  189.   begin
  190.     i:=cstr(x);
  191.     while length(i)<n do
  192.       i:=' '+i;
  193.     f:=i;
  194.   end;
  195.  
  196. begin
  197.   assign(zf,systat.gfilepath+'zlog.dat');
  198.   {$I-} reset(zf); {$I+}
  199.   if ioresult=0 then begin
  200.     abort:=false;
  201.     read(zf,d1);
  202.     cl(3);printacr(
  203.       '  Date     Calls  Active   Posts   Email   Fback     U/L    %Act   T/user',abort,next);
  204.     cl(2);printacr(
  205.       '--------   -----  ------   -----   -----   -----     ---    ----   ------',abort,next);
  206.     while (not abort) and (d1.date<>'') do begin
  207.       i:=d1.date+f(d1.calls,8)+f(d1.active,8)+f(d1.post,8)+f(d1.email,8)+
  208.          f(d1.fback,8)+f(d1.up,8)+f(trunc(100.0*d1.active/1440.0),8);
  209.       if d1.calls>0 then i:=i+f(d1.active div d1.calls,9);
  210.       printacr(i,abort,next);
  211.       if eof(zf) then
  212.         abort:=true
  213.       else
  214.         read(zf,d1);
  215.     end;
  216.   end;
  217.   close(zf);
  218. end;
  219.  
  220. PROCEDURE scan2(var cn:integer; iread:newtyp; var quit:boolean);
  221. var unvali,uv,pq,donescan,abort,next:boolean; i:astr; t:integer;
  222.  b:messagerec;
  223. begin
  224.   quit:=false;pq:=false; unvali:=false;
  225.   donescan:=false;
  226.   repeat
  227.     if iread=lt then begin cn:=cn+1; titles(cn); iread:=rp; end;
  228.     if iread=rp then begin
  229.       topscr;
  230.       rep:=false;
  231.       cl(5);prompt('['+(cstr(cn))+'] ');cl(3);
  232.       prompt('Read:(W,P,T,Q,B,D,A,M,1-'+cstr(tnum)+',<CR>) :');cl(5);
  233.       input(i,4); t:=value(i);
  234.       if (i='R') then begin t:=cn; i:=cstr(t); wantfilename:=false; end;
  235.       if (i='L') then begin t:=cn; i:=cstr(t); wantfilename:=true; end;
  236.       if (i<>'') and (t=0) then case i[1] of
  237.         'P':post;
  238.         'T':iread:=lt;
  239.         'Q':begin quit:=true; donescan:=true; end;
  240.         'B':donescan:=true;
  241.         'D':if lcs and (cn>0) and (cn<=tnum) then begin
  242.               deletem(cn); cn:=cn-1;
  243.             end;
  244.         'A':autoreply;
  245.         'M':if cs then movemsg(cn);
  246.         'W':begin rep:=true; irt:=irt+' (Msg #'+cstr(cn)+')'; post; end;
  247.         '?':begin
  248.               nl; cl(5);
  249.               print('- Message Commands -'); nl;
  250.               print('#:message to read   <CR>:next msg');
  251.               print('T:itles  Q:uit  P:ost  A:uto-reply');
  252.               print('R:e-read B:next board in N-scan');
  253.               print('W:rite reply to current message');nl;
  254.               if so then begin
  255.               cl(5);print('- Sysop Functions -');
  256.                 nl;
  257.                 print('L:ist message with filename');
  258.                 print('D:elete message');
  259.                 print('M:ove message to different base');nl;
  260.               end;
  261.             end;
  262.       end else begin
  263.         if (t>0) and (t<=tnum) then begin
  264.           cn:=t;
  265.           iread:=rm;
  266.         end else if i='' then begin
  267.           t:=cn+1;
  268.           if t<=tnum then begin
  269.             cn:=t;
  270.             iread:=rm;
  271.           end else begin donescan:=true; pq:=true; end;
  272.         end;
  273.       end;
  274.     end;
  275.     if (iread=rm) and (cn>0) and (cn<=tnum) then begin
  276.       readm(cn,next,uv); if uv then unvali:=true;
  277.       if next then cn:=cn+1 else iread:=rp;
  278.       mread:=mread+1; tleft;
  279.       if (mread>=extramsgs+seclev[thisuser.sl].mallowed)
  280.       and (thisuser.sl<>255) and (thisuser.ontoday<>1) then begin
  281.         print('You have read all your messages.');
  282.         hangup:=true;
  283.       end;
  284.       if (mread+5=extramsgs+seclev[thisuser.sl].mallowed) and (thisuser.ontoday<>1) then
  285.         print('5 messages left until forced logoff');
  286.     end else if iread=rm then iread:=rp;
  287.     if (iread=rm) and (cn=tnum+1) then begin donescan:=true; pq:=true; end;
  288.   until donescan or hangup;
  289.   if unvali and lcs then begin
  290.     ynq(chr(7)+'Validate messages here? ');
  291.     if yn then for t:=1 to tnum do
  292.       if mary[t].messagestat<>validated then
  293.         mary[t].messagestat:=validated;
  294.     bchanged:=true;
  295.   end;
  296.   if pq and (thisuser.sl>=boards[board].postsl) and not (rpost in thisuser.ac)
  297.         and ((ptoday<seclev[thisuser.sl].posts) or (thisuser.sl>55)) then begin
  298.     nl; ynq('Post on '+boards[board].name+'? ');
  299.     if yn then post;
  300.   end;
  301.   nl;
  302. end;
  303.  
  304. procedure scan1;
  305. var cn:integer; i:astr; quit:boolean;
  306. begin
  307.   iscan;
  308.   print(cstr(tnum)+' msgs on '+boards[board].name);
  309.   if tnum<>0 then begin
  310.     prt('Start listing at (Q=quit)? ');
  311.     input(i,4);
  312.     cn:=value(i); if cn<=0 then cn:=0 else if cn>tnum then cn:=tnum else cn:=cn-1;
  313.     end else i:='S';
  314.     if i='S' then scan2(cn,rp,quit) else
  315.       if (i<>'Q') then
  316.         if i='N' then begin
  317.           cn:=1;
  318.           while (not greater(mary[cn].message)) and (cn<tnum) do
  319.             cn:=cn+1;
  320.           cn:=cn-1;
  321.           if greater(mary[cn].message) then scan2(cn,lt,quit);
  322.         end else scan2(cn,lt,quit);
  323.   savebase;
  324. end;
  325.  
  326. procedure getcaller;
  327. var c:char; x:smr; chkcom:boolean; rl,rl1,rl2:real; i:astr; wfcm:boolean; duh,txt:integer;
  328.  
  329.   procedure init1;
  330.   begin
  331.     if (systat.init<>'') then begin
  332.       clrscr;textcolor(9);write('■ ');textcolor(11);rl2:=timer;
  333.       write('Initializing modem');
  334.       wfcm:=false;
  335.       set_baud(systat.maxbaud);
  336.       pr(systat.init);
  337.       dump;
  338.     end;
  339.   end;
  340.  
  341.   procedure i1;
  342.   begin
  343.     init1; c:=#0; rl:=timer;
  344.     repeat
  345.       c:=cinkey;if abs(timer-rl)>4.0 then begin init1; rl:=timer; end;
  346.     until c=#13; delay(50);
  347.   end;
  348.  
  349. begin
  350.   duh:=0;  txt:=0;
  351.   wfcm:=false; wantfilename:=false; windowon:=systat.bwindow; nopfile:=false;
  352.   buf:=''; enddayf:=false; delay(50); close(sysopf); append(sysopf); reading_a_msg:=false;
  353.   dump; mailread:=false; smread:=false; andwith:=255; checkit:=false;
  354.   curco:=7; sdc; window(1,1,80,25); beepend:=false;
  355.   outcom:=false; useron:=false; ll:=''; chatr:='';
  356.   hangup:=false; usernum:=0; chatcall:=false; hungup:=false;
  357.   term_ready(true); if answerbaud<2 then i1; clrscr;thisline:=''; okt:=false;
  358.   if systat.users>0 then
  359.     begin reset(uf); seek(uf,1); read(uf,thisuser); close(uf); usernum:=1; end
  360.   else with thisuser do begin
  361.     linelen:=80; pagelen:=25; defaults:=[]; option:=[];
  362.   end;
  363.   repeat
  364.   if (wfcm=false) and (lmsg=true) then lmsg:=false;
  365.   if not wfcm then begin wfcmenu;wfcm:=true; end;
  366.     if daynum(date)<>ldate then
  367.       if (daynum(date)-ldate)=1 then
  368.         ldate:=ldate+1
  369.       else begin
  370.         clrscr;
  371.         textcolor(9);write('■ ');textcolor(11);writeln('Date corrupted.');
  372.         halt(1);
  373.       end;
  374.     randomize; incom:=false; outcom:=false;
  375.     hangup:=false; hungup:=false; irt:=''; lastname:=''; macok:=true; cfo:=false;
  376.     spd:='KB'; c:=#0; chkcom:=false;chattime:=0.0; extratime:=0.0;
  377.     sdc; bread:=0; lil:=0; cursoroff; if systat.special then duh:=duh+1;
  378.     if duh=30 then begin
  379.       duh:=0; txt:=txt+1; if txt>13 then txt:=0; tc(txt);
  380.       tc(txt);gotoxy(1,1); write('   ─────────────────');
  381.       tc(txt);gotoxy(59,1); write(' ────────────────');
  382.       tc(txt+1);gotoxy(1,2); write('────────────────────');
  383.       tc(txt+1);gotoxy(59,2); write(' ────────────────────');
  384.       tc(txt+2);gotoxy(1,3); write('   ─────────────────');
  385.       tc(txt+2);gotoxy(59,3); write(' ────────────────');
  386.     end;
  387.     textcolor(11);
  388.     gotoxy(16,15);write(time);gotoxy(16,16);write(date);
  389.     if (time='04:00:00') and (nightly) then begin
  390.       sl1('[> Ran nightly events at '+time);
  391.       exec('\command.com','/c night.bat');
  392.       sl1('[> Returned from nightly events at '+time); iport;
  393.       i1;
  394.     end;
  395.     gotoxy(41,18);if sysop then write('Available') else write('Not here ');
  396.     textcolor(3);gotoxy(2,24);
  397.     if lmsg=true then begin lmain:=true; lmsg:=false; wfcm:=false; end;
  398.     if answerbaud>2 then c:='A';
  399.     if returna=true then begin returna:=false; c:='A'; end else
  400.     if answerbaud<2 then c:=inkey;
  401.     if c<>#0 then begin
  402.       cursoron;
  403.       c:=upcase(c);
  404.       wfcm:=false;cls;
  405.       CL(1);
  406.       case c of
  407.         '#':Menu_edit;
  408.         'U':if usernum=1 then dosj('U');
  409.         ' ':begin
  410.               write('Log on? '); rl2:=timer;
  411.               while (not keypressed) and (abs(timer-rl2)<60.0) do;
  412.               if keypressed then c:=readkey else c:='N'; c:=upcase(c); writeln(c);
  413.               if c='Y' then begin
  414.               c:=' '
  415.               END else c:='@';
  416.             end;
  417.         'Q':begin elevel:=0; hangup:=true; doneday:=true; end;
  418.         'L':begin close(sysopf); printfile(systat.gfilepath+'sysop.log');
  419.               pausescr; append(sysopf);
  420.             end;
  421.         'Y':begin printfile(systat.gfilepath+'ysysop.log'); pausescr; end;
  422.         'A':chkcom:=true;
  423.         'M':mailr;
  424.         'T':begin term; if returna=false then if answerbaud<>1 then i1; end;
  425.         'B':boardedit;
  426.         'I':initvotes;
  427.         'E':dosj('E');
  428.         '=':exec('\command.com','/c sysop.exe');
  429.         'P':changestuff;
  430.         'F':dlboardedit;
  431.         'R':if (systat.users>0) and (thisuser.waiting>0) then begin
  432.               writeln('Feedback: '); nl; nl;
  433.               macok:=true; readmail; macok:=false;
  434.               reset(uf); seek(uf,1); write(uf,thisuser); close(uf);
  435.             end;
  436.         'Z':begin zlog; pausescr; end;
  437.        'X':if answerbaud<>1 then i1;
  438.        'D':SysopShell;
  439.        '/':begin clrscr; printfile(systat.gfilepath+'user.log'); pausescr; end;
  440.        'V':begin voteprint; printfile(systat.gfilepath+'votes.txt'); end;
  441.       end;
  442.       curco:=7; sdc; window(1,1,80,25); clrscr; dump;
  443.     end;
  444.     if c<>' ' then c:=#0;
  445.     if (c<>#0) or commpressed or chkcom then begin
  446.       getcallera(c,chkcom);
  447.       if c='X' then Begin WfcM:=False; if answerbaud<2 then i1;
  448.         If QuitAfterDone then begin elevel:=0; hangup:=true; doneday:=true; end;
  449.       End;
  450.     end;
  451.   until incom or (c=' ') or doneday;
  452.   etoday:=0; ptoday:=0; ftoday:=0; if not doneday then begin
  453.       window(1,1,80,25);
  454.       writeln('Baud = '+spd);
  455.     end;
  456.   curco:=7; sdc;
  457.   if incom then begin
  458.     outcom:=true;
  459.     set_baud(value(spd));
  460.     delay(700);
  461.   end else begin term_ready(false); incom:=false; outcom:=false; end;
  462.   timeon:=timer; ftoday:=0;
  463.   dump;
  464.   if windowon then window(1,1,80,21) else window(1,1,80,24);
  465.   lil:=0; okt:=true;
  466.   thisuser.defaults:=thisuser.defaults-[ansi];
  467.   thisuser.cols:=dcols; curco:=$07;
  468.   andwith:=255; checkit:=true; beepend:=false;
  469. end;
  470.  
  471. procedure qscan(var quit:boolean; tf:boolean);
  472. var cn:integer; i:astr;
  473. begin
  474.   iscan;
  475.   i:='#'+cstr(board);
  476.   cn:=1; nl;
  477.   cl(3);
  478.   print('[:New-scan '+boards[board].name+' '+i+' - '+cstr(tnum)+' msgs:]');
  479.   if (tnum<>0) then begin
  480.     if not tf then tf:=boardacpw(board);
  481.     if tf then begin
  482.       while (not greater(mary[cn].message)) and (cn<tnum) do
  483.         cn:=cn+1;
  484.       if greater(mary[cn].message) then scan2(cn,rm,quit) else quit:=false;
  485.     end;
  486.   end;
  487.   cl(4); print('[:'+boards[board].name+' New-scan done:]');
  488.   savebase;
  489. end;
  490.  
  491. procedure bulletins;
  492. var filv:Text; i:astr;
  493. begin
  494.   nl;
  495.   assign(filv,systat.gfilepath+'bulletin.msg');
  496.   {$I-} reset(filv); {$I+}
  497.   if ioresult<>0 then print('There are no bulletins today.') else
  498.   begin
  499.   close(filv);
  500.   printf(systat.gfilepath+'bulletin');
  501.   repeat
  502.     prt('Enter Bulletin Selection (#,?,Q=Quit) : ');
  503.     input(i,3); if i='' then i:='Q';
  504.     if i='?' then printf(systat.gfilepath+'bulletin');
  505.     if (i<>'Q') and (i<>'?') then printf(systat.gfilepath+'bullet'+i);
  506.   until (i='Q') or (hangup);
  507.   end;
  508. end;
  509.  
  510. procedure nscan;
  511. var quit:boolean;
  512. begin
  513.   nl;
  514.   ynq('Global new-scan? ');
  515.   if yn then begin
  516.   nl; cl(5); print(')[ New-scan All ](');
  517.   board:=1; quit:=false;
  518.   while (board<=numboards) and (not quit) and (not hangup) do begin
  519.    if (thisuser.qscn[board]) and not (boards[board].key='%') then
  520.      if boardac(board) then qscan(quit,false);
  521.    board:=board+1;
  522.   end;
  523.   nl; cl(5); print(')[ Global New-scan Done ]('); nl;
  524.   board:=1;
  525.  end else qscan(next,true);
  526. end;
  527.  
  528. END.
  529.