home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 153.img / TELES.ZIP / BBS.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-24  |  18KB  |  534 lines
  1. program bbs;
  2.  
  3. {$R-}                   {Range checking off}
  4. {$B+}                   {Boolean complete evaluation on}
  5. {$S+}                   {Stack checking on}
  6. {$I+}                   {I/O checking on}
  7. {$N-}                   {No numeric coprocessor}
  8. {$M 32150,0,0}          {Declared here suffices for all Units as well!}
  9. {$V-}
  10.  
  11. Uses
  12.   Crt,
  13.   Dos,
  14.   Turbo3,
  15.   Common,
  16.   Unit0,
  17.   UnitX,
  18.   Unit1,
  19.   Unit2,
  20.   FileSc,
  21.   BoardEdt,
  22.   SysopUt,
  23.   MenuEdt,
  24.   Qwik;
  25.  
  26. Var
  27.   Sdoor:String[255];
  28.   Last_Menu:Astr;
  29.   P:Astr;
  30.   Duh:Boolean;
  31.  
  32. Function TimeStr:Astr;
  33. Var I:Astr;
  34. Begin
  35.   Str(Nsl/60:7:2,i);
  36.   i:=copy(i,2,length(i));
  37.   i:=copy(i,1,pos('.',i)-1);
  38.   timestr:=i;
  39. end;
  40.  
  41. Procedure Tcenter(Z:Astr);
  42. Var Y,P:Integer;
  43. Begin
  44.   P:=40-(length(z) div 2);
  45.   y:=wherey;
  46.   gotoxy(p,y);
  47.   writeln(z);
  48. End;
  49.  
  50. Procedure ReadP;
  51. Var A:integer; D:astr; Filv:Text; Count:integer;
  52. Begin
  53.   answerbaud:=0; quitafterdone:=false; count:=paramcount; returna:=false;
  54.   nightly:=false;
  55.     If ParamCount<>0 then Begin
  56.       if ParamCount>5 then Writeln('Too many command specs');
  57.       if paramcount>5 then count:=5;
  58.       a:=0;
  59.       repeat
  60.         a:=a+1;
  61.         if copy(paramstr(a),1,2)='-b' then begin
  62.           d:=copy(paramstr(a),3,length(paramstr(a)));
  63.           answerbaud:=value(d);
  64.         end;
  65.         if  (paramstr(a))='-n' then nightly:=true;
  66.         if  (paramstr(a))='-k' then answerbaud:=1;
  67.         if  (paramstr(a))='-p' then quitafterdone:=true;
  68.       until (a=paramcount) or (a=5);
  69.     end;
  70.   ClrScr;
  71.   Textcolor(14); Textbackground(1); clreol; gotoxy(1,1);
  72.   Tcenter('Telegard Bulletin Board System Version '+ver);
  73.   Textbackground(0);
  74.   TextColor(1);
  75.   Writeln; Writeln; Writeln;
  76.   Textcolor(12);
  77.   Tcenter('Thank You For Downloading One Of The Most');
  78.   Tcenter('Powerful BBS Programs Today'); Writeln; Writeln; Writeln;
  79.   Textcolor(10); Tcenter('Telegard - Written By Carl Mueller'); Writeln;
  80.   Writeln;
  81.   Tcenter('Command Parameters Specified: ');
  82.   Textcolor(9);
  83.   Writeln;
  84.   If ParamCount=0 then tcenter('None');
  85.   if nightly then tcenter('Execute Nightly Event');
  86.   if answerbaud=1 then tcenter('Local I/O Only');
  87.   if answerbaud>2 then tcenter('Answer at '+cstr(answerbaud)+' Baud');
  88.   if quitafterdone then tcenter('Quit After User LogOn');
  89. End;
  90.  
  91. Procedure Process_Door(Z:Integer);
  92. Var I:Integer; Namm:Astr;
  93. Begin
  94.   Namm:=Copy(Nam,1,Pos('#',Nam)-1);
  95.   Sdoor:='';
  96.   For I:=1 to Length(OptStr[z]) do begin
  97.     If Copy(OptStr[z],i,1)='@' then Begin
  98.       If Copy(OptStr[z],i+1,1)='N' then Sdoor:=Sdoor+Thisuser.Name;
  99.       If Copy(OptStr[z],i+1,1)='F' then Sdoor:=Sdoor+(copy(nam,1,(pos(' ',nam)-1)));
  100.       If Copy(OptStr[z],i+1,1)='L' then Begin
  101.         if pos(' ',copy(namm,1,length(namm)-1))=0 then Sdoor:=Sdoor+(Copy(Nam,1,(Pos(' ',Nam)-1))) else
  102.         Sdoor:=Sdoor+(copy(namm,pos(' ',namm)+1,length(namm)-(pos(' ',namm))-1));
  103.       End;
  104.       If Copy(OptStr[z],i+1,1)='T' then Sdoor:=Sdoor+timestr;
  105.       If Copy(OptStr[z],i+1,1)='B' then if spd<>'KB' then Sdoor:=Sdoor+Spd else Sdoor:=Sdoor+'0';
  106.       If Copy(OptStr[z],i+1,1)='G' then If okansi then Sdoor:=Sdoor+'1' else Sdoor:=Sdoor+'0';
  107.       If Copy(OptStr[z],i+1,1)='R' then Sdoor:=Sdoor+(copy(nam,pos('#',nam)+1,length(nam)));
  108.       I:=i+1;
  109.     End else
  110.       Sdoor:=Sdoor+Copy(Optstr[z],i,1);
  111.   End;
  112. End;
  113.  
  114. Procedure Write_Dor;
  115. Var FilVar:Text; First,Last:Astr;  Dum:Astr;
  116. Begin
  117.   assign(filvar,'dorinfo1.def');
  118.   rewrite(filvar); writeln(filvar,systat.bbsname);
  119.   writeln(filvar,systat.sysopfirst); writeln(filvar,systat.sysoplast);
  120.   writeln(filvar,'COM'+cstr(systat.comport));
  121.   if spd='KB' then dum:='0' else dum:=spd;
  122.   writeln(filvar,dum+' BAUD,N,8,1');
  123.   writeln(filvar,'0');
  124.   first:=copy(thisuser.name,1,pos(' ',thisuser.name));
  125.   last:=copy(thisuser.name,length(first)+1,length(thisuser.name));
  126.   If first='' then first:='THE';
  127.   writeln(filvar,first);
  128.   writeln(filvar,last);
  129.   {if thisuser.citystate='' then thisuser.citystate:='Unkown, MI';}
  130.   writeln(filvar,thisuser.citystate);
  131.   writeln(filvar,'1');
  132.   writeln(filvar,thisuser.sl);
  133.   writeln(filvar,timestr);
  134.   close(filvar);
  135. End;
  136.  
  137. Procedure ChangeFileBoard(Int:Integer);
  138. begin
  139.   if (int>-1) and (int<=maxulb) then
  140.     if (thisuser.dsl>=uboards[int].dsl) and (thisuser.age>=uboards[int].agereq)
  141.     and (uboards[int].key=dumb2)
  142.     and (uboards[int].ar='@') or (uboards[int].ar in thisuser.ar)
  143.          then
  144.       if (uboards[int].password='') or dcs then begin
  145.          FILEBOARD:=int; thisuser.res[2]:=FILEBOARD; end else begin
  146.         prt('Password? '); input(i,10);
  147.         if i<>uboards[int].password then
  148.           print('Wrong.')
  149.         else
  150.           begin FILEBOARD:=int; thisuser.res[2]:=FILEBOARD; end;
  151.        end;
  152. end;
  153.  
  154. Procedure ChangeBoard(Nb:Integer);
  155. Var inte:integer;
  156. begin
  157.   if nb>0 then
  158.     if nb<=numboards then
  159.       if (boardacpw(nb)) and (boards[nb].key=dumb) then begin thisuser.res[1]:=nb;board:=nb;end
  160.       else
  161.     else
  162.   else begin
  163.     nb:=0;
  164. {   for inte:=1 to numboards do if boards[inte].key=i then nb:=inte;}
  165.     if (nb<>0) and (i<>' ') then if boardacpw(nb) then board:=nb;
  166.   end;
  167. end;
  168.  
  169. Procedure CheckAr(x:Integer);
  170. var o:char;
  171. Begin
  172.  p:=optstr[x];
  173.  if pos(',',optstr[x])<>0 then begin
  174.    O:=P[POS(',',OPTSTR[X])+1]; o:=upcase(o);
  175.    p:=copy(optstr[x],1,pos(',',optstr[x])-1);
  176.    if not (O in thisuser.ar) then begin
  177.      duh:=false;
  178.      print('You don''t possess the proper flags to enter this menu.');
  179.   end;
  180.   end;
  181. end;
  182.  
  183. procedure mainmenu;
  184. var nb,inte:integer; abort,next:boolean; ii:astr; rl:real; mr:mailrec;
  185.     filvar:text; x:integer; s:astr; zz:integer; menup:astr;
  186.     t:real; CmdExist,Cmdsl:Boolean; R,o:char;
  187. begin
  188.   dump;
  189.   tleft; nl; nl;
  190.   macok:=true;
  191.   if mmnu in thisuser.defaults then printf(systat.gfilepath+directive);
  192.   menup:=menuprompt;
  193.  
  194.   { Putting a '*' in front of MenuPrompt will NOT print time left. }
  195.  
  196.   if copy(menuprompt,1,1)='*' then menup:=copy(menuprompt,2,length(menuprompt));
  197.  
  198.   { Putting a '#' in front on MenuPrompt will print the menu When entered
  199.     regardless of xpert}
  200.  
  201.   if (copy(menuprompt,1,1)='#') or (copy(menuprompt,1,1)='!') then
  202.     begin
  203.       if not (mmnu in thisuser.defaults) then
  204.         printf(systat.gfilepath+directive);
  205.       menup:=copy(menuprompt,2,length(menuprompt));
  206.     end;
  207.  
  208.   if (copy(menuprompt,1,1)<>'*') and (copy(menuprompt,1,1)<>'!')
  209.     then print('[<Time Left - '+tlef+'>]');
  210.  
  211.   sprompt(menup);
  212.   if onekey in thisuser.defaults then mmkey(i) else input(i,20);
  213.   if length(i)>1 then if copy(i,1,2)='//' then i:=copy(i,3,length(i)-2);
  214.   CmdExist:=False; CmdSL:=False;
  215.   for x:=1 to noc do begin
  216.     if i=cmdl[x] then begin
  217.       CmdExist:=True;
  218.       if thisuser.sl>=msl[x] then begin
  219.         CmdSl:=True;
  220.         case cmdtype[x] of
  221.         0:begin nl; sprint(optstr[x]); end;
  222.         1:if pos('.',optstr[x])=0 then printf(systat.gfilepath+optstr[x]) else
  223.             printfile(systat.gfilepath+optstr[x]);
  224.         2:begin
  225.             nl;nl; if not chatcall then sprompt(optstr[x]); nl; reqchat(optdata[x]);
  226.           end;
  227.         3:begin
  228.             nl;nl; sprompt(optstr[x]);
  229.             if yn then begin
  230.               cls;
  231.               printf(systat.gfilepath+'logoff');
  232.               hangup:=true;
  233.               hungup:=false;
  234.             end;
  235.           end;
  236.         4:hangup:=true;
  237.         5:begin boardlist(optstr[x]); ynq('Change to which board? '); input(s,2);
  238.             changeboard(value(s));
  239.           end;
  240.         6:if mmnu in thisuser.defaults then
  241.           thisuser.defaults:=thisuser.defaults-[mmnu]
  242.         else
  243.           thisuser.defaults:=thisuser.defaults+[mmnu];
  244.         7:if (ramsg in thisuser.ac) then
  245.              print('You are restricted from writing automessages.')
  246.            else
  247.              wmsg;
  248.         8:readamsg;
  249.         9:begin
  250.              nl; assign(filvar,systat.gfilepath+'auto.msg');
  251.              {$I-} reset(filvar); {$I+}
  252.              irt:='Your auto-message';
  253.              if ioresult<>0 then
  254.                print('Nothing to reply to.')
  255.              else begin
  256.                readln(filvar,lastname);
  257.                close(filvar);
  258.                if lastname[1]='@' then
  259.                  if not (postn in seclev[thisuser.sl].anst) then
  260.                    lastname:='';
  261.                if (lastname[1]='!') and so then
  262.                  lastname:='';
  263.                 if lastname='' then
  264.                  print('You can''t reply')
  265.                else
  266.                  autoreply;
  267.              end;
  268.            end;
  269.        10:yourinfo;
  270.        11:begin pver; printfile(systat.gfilepath+'logon.msg');
  271.             printf(systat.gfilepath+'system'); end;
  272.        12:chpw;
  273.        13:begin
  274.           if not (ansi in thisuser.defaults) then begin
  275.             thisuser.defaults:=thisuser.defaults+[ansi];
  276.             print('ANSI active.'); end
  277.           else begin
  278.             thisuser.defaults:=thisuser.defaults-[ansi];
  279.             print('ANSI disabled.'); end;
  280.         end;
  281.        14:begin
  282.           if not (color in thisuser.defaults) then begin
  283.             thisuser.defaults:=thisuser.defaults+[color];
  284.             print('Color on.'); end
  285.           else begin
  286.             thisuser.defaults:=thisuser.defaults-[color];
  287.             print('Color off.'); end;
  288.         end;
  289.        15:docitystate;
  290.        16:dojob;
  291.        17:dostreet;
  292.        18:dozipcode;
  293.        19:doscreen;
  294.        20:dophone;
  295.        21:abbs;
  296.        22:removem;
  297.        23:ulist;
  298.        24:smail(false);
  299.        25:begin irt:='Feedback'; imail(optdata[x]); end;
  300.        26:nscan;
  301.        27:begin dumb:=boards[optdata[x]].key; changeboard(optdata[x]); end;
  302.        28:begin zz:=board; changeboard(optdata[x]);
  303.             qscan(next,true); changeboard(zz);
  304.           end;
  305.        29:qscan(next,true);
  306.        30:begin post; savebase; end;
  307.        31:readmail;
  308.        32:vote;
  309.        33:gfiles;
  310.        34:mmacro;
  311.        35:delmail;
  312.        36:prg(false);
  313.        37:prg(true);
  314.        38:bulletins;
  315.        39:chbds;
  316.        40:setdirs;
  317.        41:begin listboards(optstr[x]); ynq('Change to which board? ');
  318.             input(s,2); if s<>'' then changefileboard(value(s));
  319.           end;
  320.        42:iul;
  321.        43:idl;
  322.        44:listfiles;
  323.        45:search;
  324.        46:searchd;
  325.        47:pointdate;
  326.        48:nf;
  327.        49:remove;
  328.        50:move;
  329.        51:lfii;
  330.        52:dlbatch;
  331.        53:yourfileinfo;
  332.        54:dirf(true);
  333.        55:dirf(false);
  334.        56:begin
  335.             duh:=true;
  336.             Last_Menu:=N; checkar(x);
  337.             if duh then begin
  338.               n:=systat.menupath+p+'.mnu';
  339.               readin;
  340.             end;
  341.           end;
  342.        57:dosj('U');
  343.        58:dosj('E');
  344.        59:dosj('G');
  345.        60:dlboardedit;
  346.        61:boardedit;
  347.        62:changestuff;
  348.        63:begin
  349.             if not (onekey in thisuser.defaults) then begin
  350.               thisuser.defaults:=thisuser.defaults+[onekey];
  351.               print('One key input.'); end
  352.             else begin
  353.               thisuser.defaults:=thisuser.defaults-[onekey];
  354.               print('Full line input.'); end
  355.           end;
  356.        64:if pause in thisuser.defaults then
  357.             begin thisuser.defaults:=thisuser.defaults-[pause];
  358.             print('No pause on screen.'); end else
  359.             begin thisuser.defaults:=thisuser.defaults+[pause];
  360.             print('Pause on screen active.'); end;
  361.        65:if nomail in thisuser.option then begin
  362.            thisuser.option:=thisuser.option-[nomail];
  363.            print('Mailbox now open.');
  364.          end else
  365.            if thisuser.forusr<>0 then begin
  366.              thisuser.forusr:=0;
  367.              print('Mail no longer forwarded.');
  368.            end else begin
  369.              ynq('Do you want to close your mailbox? ');
  370.              if yn then begin
  371.                thisuser.option:=thisuser.option+[nomail];
  372.                print('Mailbox now closed.');
  373.                CL(5); print('You >CAN NOT< recieve mail now.');
  374.              end else begin
  375.                ynq('Do you want your mail forwarded? ');
  376.                if yn then forwardmail;
  377.              end;
  378.            end;
  379.        66:chcolors;
  380.        67:begin
  381.             if not (wordwrap in thisuser.defaults) then begin
  382.               thisuser.defaults:=thisuser.defaults+[wordwrap];
  383.               print('Wordwrap on.'); end
  384.             else begin
  385.               thisuser.defaults:=thisuser.defaults-[wordwrap];
  386.               print('Wordwrap off.'); end;
  387.           end;
  388.        68:scan1;
  389.        69:smail(true);
  390.        70:begin
  391.             duh:=true;
  392.             Last_Menu:=N; dumb:=boards[optdata[x]].key;
  393.             changeboard(optdata[x]); checkar(x);
  394.             if duh then begin
  395.               n:=systat.menupath+''+optstr[x]+'.mnu';
  396.               readin;
  397.             end;
  398.           end;
  399.        71:Begin
  400.             If Optdata[x]<>1 then begin cl(3); prompt('[> '); cl(0); print('Opening Door at '+time+' ...  Please wait.'); end;
  401.             Process_Door(X);
  402.             CommandLine('Writing to DORINFO1.DEF ...'); Write_Dor;
  403.             Commandline('Now Running '+sdoor);
  404.             SysopLog('[ Ran Door '+optstr[x]+' at '+time+' ]');
  405.             Exec('\Command.Com','/C '+sdoor); ChDir(Start_Dir);
  406.             SysopLog('[ Returned From Door at '+time+' ]');
  407.             if optdata[x]<>1 then clrscr;
  408.             GamePort; tim:=timer; dump; topscr;
  409.           End;
  410.        72:Chuser;
  411.        73:Begin
  412.            Ynq('Do you want to re-output to VOTES.TXT? ');
  413.            If Yn then VotePrint;
  414.            Ynq('Do you want to see VOTES.TXT? ');
  415.            If Yn then Printfile(Systat.GfilePath+'votes.txt');
  416.          End;
  417.        74:Begin
  418.             Last_Menu:=N; Menu_Edit; First_time:=true; N:=Last_Menu; ReadIn;
  419.           End;
  420.        75:Begin Dumb2:=Uboards[OptData[X]].key; ChangeFileBoard(OptData[X]); End;
  421.        76:Begin
  422.             Last_Menu:=N; Duh:=True; Dumb2:=Uboards[OptData[X]].key;
  423.             ChangeFileBoard(OptData[X]);
  424.             CheckAr(X);
  425.             If Duh then begin
  426.               N:=systat.menupath+''+optstr[x]+'.MNU';
  427.               ReadIn;
  428.             end;
  429.          End;
  430.        77:Begin
  431.             If (Not (MMNU in Thisuser.Defaults)) and
  432.             (Copy(MenuPrompt,1,1)<>'#') and (Copy(MenuPrompt,1,1)<>'!') then
  433.               printf(systat.gfilepath+directive);
  434.           End;
  435.        78:Editfiles;
  436.        79:Sort;
  437.        80:mailr;
  438.        81:Begin
  439.             nl; print('Enter file name to download (Drive:Path\FileName.Ext)');
  440.             prt(':');mpl(70);input(s,70); if s<>'' then Unlisted_download(s);
  441.           End;
  442.        82:Begin
  443.             Nl; Nl;
  444.             cl(3);
  445.             print('Statistics on "'+boards[board].name+'"'); nl;
  446.             Cl(0); Prompt('Board SL Requirement .... : '); cl(9); print(cstr(boards[board].sl));
  447.             Cl(0); Prompt('Board AR Requirement .... : '); cl(9);
  448.             If Boards[Board].Ar='@' then Print('None') else begin
  449.             for r:='A' to 'G' do if (r=boards[board].ar) then prompt(r); nl; end; nl;
  450.             Cl(0); Prompt('Maximum Messages ........ : '); cl(9); print(cstr(boards[board].maxmsgs));
  451.             Cl(0); Prompt('Post SL Requirement ..... : '); cl(9); print(cstr(boards[board].postsl)); Nl;
  452.           End;
  453.        83:Begin
  454.             Nl; Nl;
  455.             Cl(3);
  456.             Print('File Area: "'+uboards[fileboard].name+'"'); nl;
  457.             cl(0); Prompt('Board DSL Requirement ... : '); cl(9); print(cstr(uboards[fileboard].dsl));
  458.             Cl(0); Prompt('Board AR Requirement .... : '); cl(9);
  459.             If Uboards[Fileboard].Ar='@' then Print('None') else begin
  460.             For R:='A' to 'G' do if (r=uboards[fileboard].ar) then prompt(r); nl; end; Nl;
  461.             Cl(0); Prompt('Maximum Files Allowed ... : '); cl(9); print(cstr(uboards[fileboard].maxfiles));
  462.             Cl(0); Prompt('Minimum Age Required .... : '); cl(9); print(cstr(uboards[fileboard].agereq));
  463.             Cl(0); Prompt('File Points ............. : '); cl(9); print(cstr(thisuser.filepoints)); nl;
  464.       End;
  465.        84:Sysoplog(optstr[x]);
  466.        85:Newfiles(optdata[x],abort);
  467.        86:CommandLine(OptStr[X]);
  468.        87:if pos('.',optstr[x])=0 then printf(optstr[x]) else printfile(optstr[x]);
  469.        88:initvotes;
  470.        89:readq(systat.gfilepath+optstr[x]);
  471.       end;     {End of Case}
  472.     end;   {End SL Check}
  473.     if found=true then x:=noc;
  474.   end;   {End Cmd Search}
  475.  end; {End Loop}
  476.   If (CmdSl=False) and (CmdExist=False) then print('Invalid Command.');
  477.   If (CmdSl=False) and (CmdExist=True) then print('You don''t have enough access for this command.');
  478. end;
  479.  
  480.   begin  {Main Loop}
  481.    Ver:='1.6a';
  482.    ReadP;
  483.    CheckBreak:=false;  { Takes the place of $C-}
  484.    readingmail:=false;
  485.    getdir(0,Start_Dir);
  486.    Async_Init;
  487.    Init;
  488.    ClrScr;
  489.    Repeat
  490.      Write_msg:=false;
  491.      GetCaller;            {WFC MENU}
  492.      If not DoneDay then
  493.        Begin
  494.          If GetUser then
  495.             NewUser;
  496.          MacOk:=true;
  497.          If not HangUp then
  498.            if LogOn then
  499.              ReadMail;     {MAIL READ}
  500.          Bulletins;        {SYSTEM ANNOUCEMENTS}
  501. {         FILEBOARD:=1;
  502.          ldat:=thisuser.laston;
  503.          ymbtt:=0.0;
  504.          ymodemfiles:=0;
  505.          if thisuser.res[2]=0 then thisuser.res[2]:=1;}
  506.        End;
  507.      Flush(Sysopf);
  508.      FILEBOARD:=1;
  509.      ldat:=thisuser.laston;
  510.      ymbtt:=0.0;
  511.      ymodemfiles:=0;
  512.      ymodemfiles:=0;
  513.      if thisuser.res[2]=0 then thisuser.res[2]:=1;
  514.      Last_Menu:='Main.Mnu';
  515.      n:=systat.menupath+'Main.Mnu';
  516.      ReadIn;               {READ-IN MENU CMDS}
  517.      While not HangUp do
  518.        MainMenu;
  519.      if quitafterdone then begin elevel:=0; hangup:=true; doneday:=true; end;
  520.      Term_Ready(False); Delay(500);
  521.      If UserOn then
  522.        LogOff;
  523.      if cdet and (not doneday) then
  524.        hangupphone;
  525.      if enddayf then
  526.        endday;
  527.      enddayf:=false;
  528.    until doneday;
  529.    close(sysopf);
  530.    term_ready(true); delay(100); pr('ATZ');
  531.    remove_port;
  532.    halt(elevel);
  533.   end.                  {Main Loop}
  534.