{ TUTL.PAS - Turbo Bulletin Board System utility program }

program tutl;

{$C-}

{$I TBBSHDR.INC}
{$I ACCESS.BOX}
{$I GETKEY.BOX}
{$I ADDKEY.BOX}
{$I DELKEY.BOX}
{$I TBBSCOM.INC}

var
  prt: boolean;

procedure print(line: StdStr);
{ Print line on screen or printer }
begin
  if prt
    then writeln(LST, line)
    else writeln(line)
end;

procedure print_user;
{ Print the "user" file }
var
  i: integer;
  t: tad_array;
  st: StdStr;
begin
  if prt
    then
      begin
        GetTAD(t);
        st := systad(t);
        print(^L + 'User file as of: ' + st);
        print('')
      end
    else ClrScr;
  ClearKey(IdxF);
  repeat
    NextKey(IdxF, i, st);
    if OK
      then
        begin
          GetRec(DatF, i, user_rec);
          print(user_rec.user_firstname + ' ' + user_rec.user_lastname +
            ' from ' + user_rec.user_address + ' last on ' +
            systad(user_rec.user_laston))
        end
  until (not OK) or brk;
  if not prt
    then pause
end;

procedure print_unvalidated;
{ Print the unvalidated users }
var
  i: integer;
  t: tad_array;
  st: StdStr;
begin
  if prt
    then
      begin
        GetTAD(t);
        st := systad(t);
        print(^L + 'Unvalidated users as of: ' + st);
        print('')
      end
    else ClrScr;
  ClearKey(IdxF);
  repeat
    NextKey(IdxF, i, st);
    if OK
      then
        begin
          GetRec(DatF, i, user_rec);
          if user_rec.user_bbs_stat = 0
            then print(user_rec.user_firstname + ' ' + user_rec.user_lastname +
              ' from ' + user_rec.user_address + ' last on ' +
              systad(user_rec.user_laston))
        end
  until (not OK) or brk;
  if not prt
    then pause
end;

procedure print_caller;
{ Print the "caller" file }
var
  t: tad_array;
  st: StdStr;
  nclr_file: file of calr_list;
begin
  if prt
    then
      begin
        GetTAD(t);
        st := systad(t);
        print(^L + 'Caller file as of: ' + st);
        print('')
      end
    else ClrScr;
  seek(calr_file, 1);
  while (not EOF(calr_file)) and (not brk) do
    begin
      read(calr_file, calr_rec);
      GetRec(DatF, calr_rec.calr_num, user_rec);
      print(systad(calr_rec.calr_tad) + '  ' +
        user_rec.user_firstname + ' ' + user_rec.user_lastname);
    end;
  if ask('Do you want to reset the caller file')
    then
      begin
        writeln('Resetting ', calr_name, ext);
        assign(nclr_file, calr_name + '$$$');
        rewrite(nclr_file);
        seek(calr_file, 0);
        read(calr_file, calr_rec);
        write(nclr_file, calr_rec);
        close(calr_file);
        close(nclr_file);
        erase(calr_file);
        rename(nclr_file, calr_name + ext);
        reset(calr_file)
      end
end;

procedure print_messages;
{ Print the "message" file }
var
  i: integer;
  t: tad_array;
  st: StdStr;
  to_fn, fr_fn: firstname;
  to_ln, fr_ln: lastname;
begin
  if prt
    then
      begin
        GetTAD(t);
        st := systad(t);
        print(^L + 'Message file as of: ' + st);
        print('')
      end
    else ClrScr;
  seek(summ_file, 1);
  while (not EOF(summ_file)) and (not brk) do
    begin
      read(summ_file, summ_rec);
      with summ_rec do
        begin
          if summ_to_num = mesg_pub
            then
              begin
                to_fn := 'ALL';
                to_ln := ''
              end
          else if summ_to_num = mesg_era
            then
              begin
                to_fn := 'MESSAGE';
                to_ln := 'ERASED'
              end
            else
              begin
                GetRec(DatF, summ_to_num, user_rec);
                to_fn := user_rec.user_firstname;
                to_ln := user_rec.user_lastname
             end;
          GetRec(DatF, summ_from_num, user_rec);
          fr_fn := user_rec.user_firstname;
          fr_ln := user_rec.user_lastname;
          st := systad(summ_date);
          print('Message number ' + intstr(summ_num) + ' entered ' + st + '.');
          print('From: ' + fr_fn + ' ' + fr_ln);
          print('  To: ' + to_fn + ' ' + to_ln);
          print('  Re: ' + summ_subject);
          seek(mesg_file, summ_st_rec);
          for i := 1 to summ_size do
            begin
              read(mesg_file, mesg_rec);
              print(mesg_rec.mesg_text)
            end;
          if prt
            then print('')
            else
              begin
                pause;
                ClrScr
              end
        end
    end
end;

procedure pack_messages;
{ Pack the message files }
var
  i: integer;
  nsum_rec  :         summ_list;
  nsum_file : file of summ_list;
  nmsg_rec  :         mesg_list;
  nmsg_file : file of mesg_list;
begin
  write('Packing');
  assign(nsum_file, summ_name + '$$$');
  assign(nmsg_file, mesg_name + '$$$');
  rewrite(nsum_file);
  rewrite(nmsg_file);
  seek(summ_file, 0);
  read(summ_file, summ_rec);      { copy message counter to new file }
  write(nsum_file, summ_rec);
  while not EOF(summ_file) do
    begin
      read(summ_file, summ_rec);
      if summ_rec.summ_to_num <> mesg_era
        then
          begin
            seek(mesg_file, summ_rec.summ_st_rec);
            summ_rec.summ_st_rec := filesize(nmsg_file);
            write(nsum_file, summ_rec);
            for i := 1 to summ_rec.summ_size do
              begin
                read(mesg_file, mesg_rec);
                write(nmsg_file, mesg_rec)
              end
          end
    end;
  close(summ_file);
  close(mesg_file);
  close(nsum_file);
  close(nmsg_file);

  erase(summ_file);
  erase(mesg_file);
  rename(nsum_file, summ_name + ext);
  rename(nmsg_file, mesg_name + ext);

  reset(summ_file);
  reset(mesg_file)
end;

procedure display_user;
var
  st: StdStr;
begin
  ClrScr;
  with user_rec do
    begin
      writeln('Name     : ', user_firstname, ' ', user_lastname);
      writeln('Address  : ', user_address);
      writeln('Password : ', user_pw);
      writeln('Max drive: ', user_maxdrv);
      writeln('Max user : ', user_maxusr);
      writeln('Sys Stat : ', user_sys_stat);
      writeln('BBS Stat : ', user_bbs_stat);
      writeln('Nulls    : ', user_nulls);
      writeln('U/L case : ', user_case_sw);
      st := systad(user_laston);
      writeln('Last on  : ', st);
      writeln('On today : ', user_time_today);
      writeln('On total : ', user_time_total);
      writeln('Last hi  : ', user_lasthi);
      writeln('Uploads  : ', user_up);
      writeln('Downloads: ', user_down)
    end;
  gotoxy(1, 22)
end;

procedure change_user;

procedure accept(x, y: integer; var st: StdStr; len: integer; mode: StdStr);
begin
  GotoXY(x, y);
  getstring(st, len, 'E' + mode)
end;

begin { change_user }
  with user_rec do
    begin
      accept(12,  2, st, len_ad, '');
      if st <> ''
        then user_address := st;
      accept(12,  3, st, len_pw, 'S');
      if st <> ''
        then user_pw := st;
      accept(12,  4, st, 1, '');
      if st <> ''
        then user_maxdrv := strint(st);
      accept(12,  5, st, 1, '');
      if st <> ''
        then user_maxusr := strint(st);
      accept(12,  6, st, 1, '');
      if st <> ''
        then user_sys_stat := strint(st);
      accept(12,  7, st, 1, '');
      if st <> ''
        then user_bbs_stat := strint(st);
      accept(12,  8, st, 1, '');
      if st <> ''
        then user_nulls := strint(st);
      accept(12,  9, st, 2, '');
      if st <> ''
        then user_case_sw := strint(st);
      accept(12, 11, st, 2, '');
      if st <> ''
        then user_time_today := strint(st);
      accept(12, 12, st, 7, '');
      if st <> ''
        then user_time_total := strint(st);
      accept(12, 13, st, 7, '');
      if st <> ''
        then user_lasthi := strint(st);
      accept(12, 14, st, 3, '');
      if st <> ''
        then user_up := strint(st);
      accept(12, 15, st, 3, '');
      if st <> ''
        then user_down := strint(st)
    end
end;

procedure edit_user;
var
  st, key: StdStr;
begin
  writeln;
  fn := prompt('First name: ', len_fn, 'ES');
  ln := prompt(' Last name: ', len_ln, 'ES');
  key := pad(ln, len_ln) + pad(fn, len_fn);
  FindKey(IdxF, user_loc, key);
  if OK
    then
      begin
        GetRec(DatF, user_loc, user_rec);
        display_user;
        while ask('Edit this user') do
          begin
            change_user;
            display_user
          end;
        PutRec(DatF, user_loc, user_rec)
      end
    else
      begin
        writeln('User not found');
        delay(2000)
      end
end;

procedure delete_user;
var
  key: StdStr;
begin
  writeln;
  fn := prompt('First name: ', len_fn, 'ES');
  ln := prompt(' Last name: ', len_ln, 'ES');
  if ask('Delete')
    then
      begin
        key := pad(ln, len_ln) + pad(fn, len_fn);
        DeleteKey(IdxF, user_loc, key);
        if OK
          then DeleteRec(DatF, user_loc)
          else
            begin
              writeln('User not found');
              delay(2000)
            end
      end
end;

procedure purge_user;
var
  age, mon: integer;
  t: tad_array;
  st: StdStr;
begin
  writeln;
  GetTAD(t);
  age := strint(prompt('Allowable age [months]: ', 10, 'E'));
  user_loc := 1;
  while user_loc < FileLen(DatF) do
    begin
      GetRec(DatF, user_loc, user_rec);
      mon := t[4] - user_rec.user_laston[4];
      if t[5] > user_rec.user_laston[5]
        then mon := mon + 12;
      if (user_rec.user_used = 0) and ((mon > age) or ((mon = age)
        and (t[3] > user_rec.user_laston[3])))
        then
          begin
            writeln('Deleting ', user_rec.user_firstname, ' ',
              user_rec.user_lastname);
            st := pad(user_rec.user_lastname, len_ln) +
              pad(user_rec.user_firstname, len_fn);
            DeleteKey(IdxF, user_loc, st);
            DeleteRec(DatF, user_loc)
          end;
      user_loc := user_loc + 1
    end;
  pause
end;

begin { main }
  writeln(version);
  bel := FALSE;
  prt := FALSE;
  fini := FALSE;

  InitIndex;
  OpenFile(DatF, user_data + ext, SizeOf(user_rec));
  if OK
    then OpenIndex(IdxF, user_indx + ext, len_ln + len_fn, 0);
  if not OK
    then
      begin
        write(^G, 'User files missing.  Creating ', user_data, ext);
        MakeFile(DatF, user_data + ext, SizeOf(user_rec));
        writeln(', ', user_indx, ext);
        MakeIndex(IdxF, user_indx + ext, len_ln + len_fn, 0)
      end;

  assign(calr_file, calr_name + ext);
  {$I-} reset(calr_file) {$I+};
  OK := (IOresult = 0);
  if not OK
    then
      begin
        writeln(^G, 'Caller file missing.  Creating ', calr_name, ext);
        rewrite(calr_file);
        calr_rec.calr_num := 0;
        write(calr_file, calr_rec)
      end;

  assign(summ_file, summ_name + ext);
  assign(mesg_file, mesg_name + ext);
  {$I-} reset(summ_file) {$I+};
  OK := (IOresult = 0);
  if OK
    then
      begin
        {$I-} reset(mesg_file) {$I+};
        OK := (IOresult = 0)
      end;
  if not OK
    then
      begin
        write(^G, 'Message files missing.  Creating ', summ_name, ext);
        rewrite(summ_file);
        summ_rec.summ_num := 0;
        write(summ_file, summ_rec);
        writeln(', ', mesg_name, ext);
        rewrite(mesg_file)
      end;

  repeat
    ClrScr;
    writeln('Turbo Bulletin Board System Utilities');
    writeln;
    write  ('  P: Printer (o');
    if prt
      then writeln('n)')
      else writeln('ff)');
    writeln;
    writeln('  U: User list');
    writeln('  N: uNvalidated user list');
    writeln('  C: Caller list');
    writeln('  M: Message list');
    writeln;
    writeln('  E: Edit user');
    writeln('  D: Delete user');
    writeln('  G: Purge users');
    writeln;
    writeln('  R: Repack messages');
    writeln;
    writeln('  Q: Quit');
    writeln;
    writeln(FileLen(DatF), ' records, ', UsedRecs(DatF), ' users in file.');
    writeln;
    st := prompt('Function: ', 1, 'AES');
    case st[1] of
      'P': prt := not prt;
      'U': print_user;
      'N': print_unvalidated;
      'C': print_caller;
      'M': print_messages;
      'E': edit_user;
      'D': delete_user;
      'G': purge_user;
      'R': pack_messages;
      'Q': fini := TRUE;
      else
    end
  until fini;
  CloseFile(DatF);
  CloseIndex(IdxF);
  close(summ_file);
  close(mesg_file);
  close(calr_file)
end.