home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / bbs / pics16.ark / PICS2K.INC < prev    next >
Encoding:
Text File  |  1987-06-10  |  11.7 KB  |  348 lines
  1. { PICS2K.INC - Pascal Integrated Communications System Overlays}
  2. { 6/10/87  Version 1.6 Copyright 1987 by Les Archambault}
  3.  
  4. overlay procedure login;
  5.   var
  6.     continue,abort: boolean;
  7.     key: StrName;
  8.  
  9.   procedure get_new_user(var continue: boolean);
  10.     var
  11.       i: integer;
  12.     begin
  13.       continue := FALSE;
  14.       Writeln(USR);
  15.       Writeln(USR, 'Name not found.');
  16.       list('A');
  17.       Writeln(USR);
  18.       continue := ask('Are you a new user');
  19.       if continue
  20.         then with user_rec do
  21.           begin
  22.             get_case;
  23.             get_nulls;
  24.             st:=prompt('From what STATE [2 letter abbrev.] are you calling',len_st,'ES');
  25.             cy := prompt('What CITY', len_ad, 'EL');
  26.             ph:=prompt('Your phone number [###-###-####] ',len_ph,'EL');
  27.             ad:=prompt('What computer do you use',len_ad,'EL');
  28.             Writeln(USR);
  29.             Writeln(USR, 'You are ', fn, ' ', ln, ' from ', cy, ', ', st, '.');
  30.             writeln(usr, 'phone number ',ph);
  31.             writeln(usr,ad,' computer.');
  32.             Writeln(USR);
  33.             continue := ask('Is that correct');
  34.             if continue
  35.               then
  36.                 begin
  37.                   get_new_password;
  38.                   used := 0;
  39.                   if fn = 'SYSOP'
  40.                     then access := 255
  41.                     else access := uval_acc;
  42.                   limit := uval_time;
  43.                   if fn='SYSOP' then conf_flags:=254 else conf_flags := 0;
  44.                   columns := def_chars;
  45.                   lines := def_lines;
  46.                   for i := 0 to 5 do
  47.                     laston[i] := 0;
  48.                   time_today := 0;
  49.                   flags:=0;
  50.                   time_total := 0;
  51.                   lasthi := 0;
  52.                   upload := 0;
  53.                   download := 0;
  54.  
  55.                   key := pad(ln, len_ln) + pad(fn, len_fn);
  56.                   AddRec(DatF, user_loc, user_rec);
  57.                   AddKey(IdxF, user_loc, key);
  58.                   log(9, '');
  59.                   list('I');
  60.                   pause
  61.                 end
  62.           end
  63.     end;
  64.  
  65.   procedure init_user;
  66.     var
  67.       str: StrTAD;
  68.     begin
  69.       temp_hi_lmr:=0;
  70.       if local_online
  71.         then log(2, 'Local')
  72.         else log(2, intstr(rate, 3) + ' bps');
  73.       Seek(logr_file, 0);
  74.       Read(logr_file, logr_rec);
  75.       logr_rec.user := succ(logr_rec.user);  {caller number}
  76.       if logr_rec.user=maxint then logr_rec.user:=1; {reset }
  77.       Seek(logr_file, 0);
  78.       Write(logr_file, logr_rec);
  79.       GetTAD(login_t);
  80.       if (login_t[3] <> user_rec.laston[3]) or
  81.          (login_t[4] <> user_rec.laston[4]) or
  82.          (login_t[5] <> user_rec.laston[5]) then user_rec.time_today := 0;
  83.       if user_rec.access < 10               { Hang up on twit }
  84.         then remote_online := FALSE
  85.       else
  86.         show_user_stats;
  87.     end;
  88.  
  89.   begin { login }
  90.     abort:=false;
  91.     Writeln(USR, version);
  92.     Writeln(USR, ver_date);
  93.     repeat until (not BRK) or (not online);
  94.     if (not macro_in_progress) and (online) then list('W');
  95.     repeat
  96.       if macro_in_progress then
  97.         begin
  98.           user_rec.fn:='SYSOP'; user_rec.ln:='';
  99.         end
  100.       else
  101.         get_name(user_rec.fn, user_rec.ln,'C');
  102.       timeout := sleepy_time;                { increase input timeout }
  103.       key := pad(user_rec.ln, len_ln) + pad(user_rec.fn, len_fn);
  104.       FindKey(IdxF, user_loc, key);
  105.       if OK
  106.         then
  107.           begin
  108.             GetRec(DatF, user_loc, user_rec);
  109.             if macro_in_progress then
  110.               begin
  111.                 valid_pw:=true;
  112.                 mode:=sysop_mode;
  113.               end
  114.             else
  115.               begin
  116.                 Get_old_password('  Password',valid_pw);
  117.                 if not valid_pw then list('P');
  118.               end;
  119.             continue := TRUE;
  120.           end
  121.         else
  122.           begin
  123.             if diskfree(homdrv,homusr)>maxfree_logs then
  124.               begin
  125.                 get_new_user(continue);
  126.                 if continue then valid_pw:=true;
  127.               end
  128.             else
  129.               begin
  130.                valid_pw:=false;
  131.                writeln(usr);
  132.                writeln(usr,'Name not found. Not enough disk space for new callers.');
  133.                writeln(usr,'           Please call back soon.');
  134.                writeln(usr);
  135.                delay(5000);
  136.                continue:=false;
  137.                remote_online:=false;
  138.                mdhangup;
  139.                abort:=true;
  140.               end;
  141.           end;
  142.     until (not online) or continue or abort;
  143.     in_use := valid_pw;
  144.     connected := continue;
  145.     if online and in_use
  146.       then init_user;
  147.   end;
  148.  
  149. overlay procedure cold_start;
  150.   var
  151.     i,try,errcnt : integer;
  152.     SysmThis, SysmLast: SysmPtr;
  153.     sysm_text: text;
  154.     t:tad_array;
  155.  
  156. Procedure build_sysm;
  157.   { Build SYSMSG.BB# file }
  158.     var i:integer;
  159.         goof,error:boolean;
  160.         work:string[255];
  161.         dummy:char;
  162.     begin
  163.       goof:=false;
  164.       errcnt:=0;
  165.       {$I-} Close(sysm_file) {$I+};         { Shouldn't erase an open file }
  166.       i := IOresult;                        { Ignore any errors }
  167.       Rewrite(sysm_file);
  168.       Assign(sysm_text, sysm_name + '.TXT');
  169.       {$I-} Reset(sysm_text) {$I+};
  170.       if IOresult = 0
  171.         then
  172.           begin
  173.             Write('  Creating ', sysm_name, ext);
  174.             while (not eof(sysm_text)) and (errcnt<50) do
  175.               begin
  176.                 {$I-} readln(sysm_text,work); {$I+}
  177.                 error:=(ioresult<>0);
  178.                 if length(work)>79 then
  179.                   begin
  180.                     sysm_rec:=copy(work,1,79);
  181.                     writeln;
  182.                     writeln;
  183.                     writeln('Line too long, truncating.');
  184.                     writeln;
  185.                     goof:=true;
  186.                   end
  187.                 else sysm_rec:=work;
  188.                 if not error then write(sysm_file,sysm_rec);
  189.                 if error then
  190.                   begin
  191.                     writeln;
  192.                     writeln;
  193.                     writeln('Error reading text line. No CR,LF ? ');
  194.                     goof:=true;
  195.                     errcnt:=succ(errcnt);
  196.                   end;
  197.               end;             {while not eof text file}
  198.             Close(sysm_text);
  199.             Close(sysm_file);
  200.             Reset(sysm_file);
  201.             if goof or error then
  202.               begin
  203.                 writeln;
  204.                 writeln(sysm_name,'TXT problem may result in parts of SYSMSG.BB# not being complete.');
  205.                 writeln;
  206.                 writeln('   Lines in text file should not be longer than 79 characters');
  207.                 writeln('   or have high bits set (soft CRs) by the editor you use.');
  208.                 writeln;
  209.                 delay(10000);
  210.               end;
  211.           end        {ioresult=0}
  212.         else
  213.           begin
  214.             Writeln;
  215.             Write('System message text file  ', sysm_name,'TXT not found.');
  216.           end;
  217.       Writeln;
  218.     end;
  219.  
  220.   begin     {cold start}
  221.     debug:=false;
  222.     cold                := TRUE;
  223.     lps                 := (Mhz/4.0)*1250.0;       {adjust for machine speed}
  224.     for i:=0 to 5 do global_date[i]:=0;            { preset for no clock vers}
  225.     mult_cmds           :=false;                    {no multiple commands}
  226.     cmd_queue           :='';
  227.     chat_ok             := def_chat_ok;
  228.     clock               := true;                   {unless turned off}
  229.     hour_count          :=0.0;
  230.     macro_in_progress   := false;
  231.     gettad(t);
  232.     macro_done          := t[3];
  233.     val_acc             := def_val_acc;
  234.     uval_acc            := def_uval_acc;
  235.     val_time            := def_val_time;
  236.     uval_time           := def_uval_time;
  237.     chatstart           := def_chatstart;
  238.     chatend             := def_chatend;
  239.     unv_days            := def_unv_days;
  240.     val_days            := def_val_days;
  241.     unr_days            := def_unr_days;
  242.     rea_days            := def_rea_days;
  243.     max_tries           := def_max_tries;
  244.     restrict300         := def_restrict300;
  245.     start_restrict300   := def_start_restrict300;
  246.     end_restrict300     := def_end_restrict300;
  247.     auto_macro          := def_auto_macro;
  248.     auto_macro_start    := def_auto_macro_start;
  249.     max_msg_lines       := def_max_msg_lines;
  250.     restrict_public     := def_restrict_public;
  251.     limit_lines         :=def_limit_lines;
  252.     up_down_ratio       :=def_up_down_ratio;
  253.     sleepy_time         :=def_sleepy_time;
  254.     maxfree_uplds       :=def_maxfree_uplds;
  255.     maxfree_logs        :=def_maxfree_logs;
  256.     maxfree_mslimit     :=def_maxfree_mslimit;
  257.     maxfree_lines       :=def_maxfree_lines;
  258.     maxfree_abs         :=def_maxfree_abs;
  259.     extra_time_sw       :=def_extra_time;
  260.     extra_time_start    :=def_extra_time_start;
  261.     extra_time_stop     :=def_extra_time_stop;
  262.     extra_time_val      :=def_extra_time_val;
  263.     time_adjust         :=def_time_adjust;
  264.  
  265.     macro               := Deflt_macro;
  266.  
  267.     audit_on    := FALSE;
  268.     delay_down  := FALSE;
  269.     in_library  := FALSE;                   { Start in non-library mode }
  270.     in_arc      := FALSE;
  271.  
  272.     SysmBase    := nil;                     { Initialize pointers}
  273.     SectBase    := nil;
  274.     AreaBase    := nil;
  275.     MesgBase    := nil;
  276.     DirBase     := nil;
  277.     LibBase     := nil;
  278.     Artbase     := nil;
  279.     ArcBase     := nil;
  280.     UsrOutPtr   := addr(putchar);           { Initialize output driver }
  281.     HomDrv      := BDOS(getdrive);          { Assume system files are }
  282.     HomUsr      := BDOS(getseluser, $FF);   {   in the startup area }
  283.     AudDrv      := Homdrv;                  { default setting}
  284.     AudUsr      := HomUsr;
  285.     BDOS(13);                               { Reset disks}
  286.     setsect(homdrv,homusr);                 { Return to proper drive, user}
  287.     Assign(sysm_file, sysm_name + ext);
  288.     Assign(summ_file, summ_name + ext);
  289.     Assign(mesg_file, mesg_name + ext);
  290.     Assign(logr_file, logr_name + ext);
  291.     Assign(stat_file, stat_name + ext);
  292.     Assign(nwin_file, nwin_name + ext);
  293.     Try:=0;
  294.     {$I-} Reset(sysm_file) {$I+};           { Try to open system message file }
  295.     if IOresult <> 0
  296.       then
  297.         begin
  298.           Write('Cannot open ', sysm_name + ext, '.');
  299.           build_sysm;
  300.           try:=succ(try);
  301.         end;
  302.     {$I-} read(sysm_file, sysm_rec) {$I+};  { Try to read file }
  303.     if IOresult <> 0
  304.       then
  305.         begin
  306.           OK:=false;
  307.           if try=0 then
  308.             begin
  309.               write('Cannot read ',sysm_name +ext,'.');
  310.               build_sysm;
  311.               seek(sysm_file,0);
  312.               {$I-} read(sysm_file,sysm_rec); {$I+}
  313.               OK:=(IOresult=0);
  314.             end;
  315.           if not OK then
  316.             begin
  317.               Writeln;
  318.               Writeln('Cannot create ', sysm_name + ext, '.');
  319.               Writeln('Unable to continue.');
  320.               halt;
  321.             end;
  322.         end;
  323.     i := 0;
  324.     while not EOF(sysm_file) do
  325.       begin
  326.         if sysm_rec[1] = ':'
  327.           then
  328.             begin
  329.               new(SysmThis);
  330.               if SysmBase = nil
  331.                 then SysmBase := SysmThis
  332.                 else SysmLast^.next := SysmThis;
  333.               SysmLast := SysmThis;
  334.               SysmLast^.key := sysm_rec[2];
  335.               SysmLast^.loc := i;
  336.               SysmLast^.next := nil
  337.             end;
  338.         read(sysm_file, sysm_rec);
  339.         i := succ(i)
  340.       end;
  341.     RcvDrv := 0;                            { Default to A0: for uploads }
  342.     RcvUsr := 0;
  343.     Read_section_file;
  344.     if auto_macro and (t[2]<auto_macro_start) then macro_done:=t[3]-1;
  345.   end;
  346.  
  347.  {end of PICS2K.INC }
  348.