{PICSKMS2.INC  Pascal Integrated Communications System }
{ 5/25/87  vers 1.6 Copyright 1987 by Les Archambault }

Overlay function diskfree(drive,user:integer): integer;
  type
    param =
      record
        spt: integer;
        bsh, blm, exm: byte;
        dsm, drm, al, cks, off: integer
      end;
  var
    allocptr, reserved, blocksize, disksize, i: integer;
    dpbptr: ^param;
  begin
    setsect(drive,user);
    allocptr := BDOSHL(getallocvec, 0);
    dpbptr   := ptr(BDOSHL(getdiskparm, 0));
    with dpbptr^ do
      begin
        reserved := 0;
        for i := 0 to 15 do
          reserved := reserved + (al shr i) and 1;
        disksize := succ(dsm) - reserved;
        for i := reserved to dsm do
          disksize := disksize - (((mem[allocptr + i shr 3] shl (i mod 8)) and $80) shr 7);
        blocksize := 1 shl (bsh - 3)
      end;
    setsect(homdrv,homusr);
    diskfree := disksize * blocksize
  end;

overlay procedure get_name(var fn: firstname; var ln: lastname;mode:char);
{ Get user name }
  var try,try_name,i:integer;
      tln:lastname;
      tfn:firstname;
      work:strstd;
      ch:char;
      test_names,found:boolean;
      namesfile:text;
  begin
    writeln(USR);  try:=0; try_name:=0; test_names:=true;  found:=false;
    if mode='C' then
      begin
        Assign(namesfile,'BADNAMES.LST');
        {$I-} Reset(namesfile); {$I+}
        if ioresult<>0 then test_names:=false;   {file doesn't exist}
      end
    else
     test_names:=false;
    Repeat
        repeat
          fn := trim(prompt('FIRST name',80, 'ESN'));
          try:=succ(try);
        until (not online) or (fn <> '') or (try>max_tries);
        if try>max_tries then
          begin
            remote_online:=false;
            mdhangup;
          end;
        if fn = 'SYSOP' then ln := ''
          else
           begin
             try:=0;
             repeat
               ln := trim(prompt(' LAST name', len_ln, 'ESN'));
               try:=succ(try);
             until (not online) or (ln <> '') or (try>max_tries);
             if try>max_tries then
               begin
                 remote_online:=false;
                 mdhangup;
               end;
           end;
        if (try<max_tries) and (mode='C') and (online) and (test_names)then
          begin
            reset(namesfile);
            tfn:='';
            for i:=1 to length(fn) do
              if fn[i] in ['A'..'Z'] then tfn:=tfn+fn[i];
            tln:='';
            for i:=1 to length(ln) do
                if ln[i] in ['A'..'Z'] then tln:=tln+ln[i];
            while (not eof(namesfile)) and (online) and (test_names) and (not found) do
              begin
                readln(namesfile,work);
                if (pos(tfn,work)<>0) or (pos(tln,work)<>0) then found:=true;
              end;
            if found then
              begin
                Writeln(usr,'That name is reserved...try again');
                try_name:=succ(try_name);
                found:=false;
              end
            else
              test_names:=false;
          end;
        if try_name>max_tries then
          begin
            remote_online:=false;
            mdhangup;
          end;
    until (not online) or (try>max_tries) or (try_name>max_tries) or (not test_names);
  end;

overlay  procedure change_user_params_A(num:integer; var temp_user_rec:user_list);
    var
      temp,i: integer;
      str: StrStd;

    procedure set_bit(var target; bit_num:integer);
      var  subject:integer absolute target;
           mask:integer;
      begin
        mask:=1 shl bit_num;
        subject:=subject or mask;
      end;

    procedure clear_bit(var target;bit_num:integer);
      var subject:integer absolute target;
          mask:integer;
      begin
        mask:=not(1 shl bit_num);
        subject:=subject and mask;
      end;

    begin   {change user params A}
      with temp_user_rec do
        begin
          Case Num of
          1 : begin
                str:=prompt('Computer ', len_ad, 'EL');
                if str <> '' then ad := str;
              end;
          2 : begin
                str:=prompt('City ', len_cy, 'EL');
                if str <> '' then cy:=str;
              end;
          3 : begin
                str:=prompt('State (2 ltrs.) ', len_st, 'ESL');
                if str <> '' then st:=str;
              end;
          4 : begin
                str:=prompt('Phone number ', len_ph, 'EL');
                if str <> '' then ph:=str;
              end;
          5 : begin
                str:=prompt('Password ', len_pw, 'ESL');
                if str <> '' then pw:=str;
              end;
          6 : begin
                str:=prompt('Access Level ', 3, 'EL');
                if str <> '' then
                   begin
                     temp := strint(str);
                     if (temp <= user_rec.access) or (not remote_copy)
                      then access := temp
                    end;
              end;
          7 : begin
                str:=prompt('Time Limit (min.) ', 3, 'EL');
                if str <> '' then limit := strint(str);
              end;
          8 : begin
                str:=prompt('Nulls ', 1, 'EL');
                if str <> '' then nulls := strint(str);
              end;
          9 : begin
                str:=prompt('Case (U/L) ', 1, 'ESL');
                if str <> '' then shift_lock := (str = 'U');
              end;
          10 : begin
                 str:=prompt('Noisy (Y/N) ', 1, 'ESL');
                 if str <> '' then noisy := (str = 'N');
               end;
          11 : begin
                 str:=prompt('Conferences 1-7 [enter consecutive #s: 0=none] ', 7, 'ESL');
                 if str <> '' then
                   begin
                     clear_bit(conf_flags,0); {don't use this bit}
                     for i:=1 to 7 do
                     if pos(chr(i+48),str)>0 then set_bit(conf_flags,i)
                     else clear_bit(conf_flags,i);
                     if str='0' then conf_flags:=0;
                   end;
               end;
          12 : begin
                 str:=prompt('Width (columns) ', 2, 'ESL');
                 if str <> '' then columns := strint(str);
               end;
          end; {case}
        end;
    end;

overlay  procedure change_user_params_B(num:integer; var temp_user_rec:user_list);
    var
      temp,i: integer;
      str: StrStd;

    procedure set_bit(var target; bit_num:integer);
      var  subject:integer absolute target;
           mask:integer;
      begin
        mask:=1 shl bit_num;
        subject:=subject or mask;
      end;

    procedure clear_bit(var target;bit_num:integer);
      var subject:integer absolute target;
          mask:integer;
      begin
        mask:=not(1 shl bit_num);
        subject:=subject and mask;
      end;

    begin   {change user params B}
      with temp_user_rec do
        begin
          Case Num of
          13 : begin
                 str:=prompt('Lines per screen ', 2, 'ESL');
                 if str <> '' then lines := strint(str);
               end;
          14 : begin
                 str:=prompt('On Today ', 5, 'EL');
                 if str <> '' then time_today := strint(str);
               end;
          15 : begin
                 str:=prompt('On Total ', 5, 'EL');
                 if str <> '' then time_total := strint(str);
               end;
          16 : begin
                 str:=prompt('Last Hi Msg. ', 5, 'EL');
                 if str <> '' then lasthi := strint(str);
               end;
          17 : begin
                 str:=prompt('Uploads ', 5, 'EL');
                 if str <> '' then upload := strint(str);
               end;
          18 : begin
                 str:=prompt('Downloads ', 5, 'EL');
                 if str <> '' then download := strint(str)
               end;
          19 : if test_bit(flags,1) then clear_bit(flags,1)
               else set_bit(flags,1);
          20 : if test_bit(flags,2) then clear_bit(flags,2)
               else set_bit(flags,2);
          21 : if test_bit(flags,3) then clear_bit(flags,3)
               else set_bit(flags,3);
          22 : if test_bit(flags,4) then clear_bit(flags,4)
               else set_bit(flags,4);
          23 : if test_bit(flags,5) then clear_bit(flags,5)
               else set_bit(flags,5);
          end;       {case}
        end;
    end;

{End Picskms2.inc}