renegade2k/mail7.pas at master · devshane/renegade2k · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}

unit mail7;

interface

uses crt, dos, overlay, common, timefunc;

procedure mbaselist(ShowScan:boolean);
procedure mbasechange(var done:boolean; var mstr:astr);

implementation

uses mail0, Mail1, Email;

procedure mbaselist(ShowScan:boolean);
var s:astr;
    b,onlin,nd:integer;
    oldboard:word;

begin
  abort:=FALSE;
  onlin:=0; b:=1; nd:=0;
  oldboard:=board;
  cls;
  printacr('7ÚÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
  printacr('7³8 Num 7³9 Name                           7³8 Num 7³9 Name                          7³');
  printacr('7ÀÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  reset(MBasesFile);
  AllowContinue := TRUE;  AllowAbort := TRUE;
  while ((b <= MaxMBases) and (not abort)) do begin
    if ShowScan then
      initboard(b)
    else
      loadboard(b);

    if (aacs(memboard.acs)) or (mbunhidden in memboard.mbstat) then begin
      s:=';'+cstr(cmbase(b));
      s:=mrn(s,5);
      if (ShowScan and NewScanMBase) then
        s := s + ': þ '
      else
        s := s + '   ';
      s:=s+'<'+memboard.name;
      inc(onlin);
      inc(nd);
      if (onlin = 1) then
        prompt(mln(s,39))
      else
        begin
          if (lennmci(s) > 39) then
            print(mln(s,39))
          else
            print(s);
          onlin:=0;
        end;
      wkey;
    end;
    inc(b);
  end;
  AllowContinue := FALSE;
  close(MBasesFile);
  if (onlin=1) then nl;
  nl;
  if (nd=0) and (not abort) then prompt(^M^J'^7No message bases.');
  board := oldboard;
  {initboard(board);}
end;

procedure mbasechange(var done:boolean; var mstr:astr);
var s:astr;
    i:integer;
begin
  if (mstr <> '') then
    case upcase(mstr[1]) of
      '+':begin
            i:=board;
            if (board>=MaxMBases) then i:=0 else
              repeat
                inc(i);
                changeboard(i);
              until (board=i) or (i>MaxMBases);
            if (board<>i) then print(^M^J'Highest accessible message base.')
              else lastcommandovr:=TRUE;
            exit;
          end;
      '-':begin
            i:=board;
            if board<=0 then i:=MaxMBases else
              repeat
                dec(i);
                changeboard(i);
              until (board=i) or (i<=0);
            if (board<>i) then print(^M^J'Lowest accessible message base.')
              else lastcommandovr:=TRUE;
            exit;
          end;
      'L':begin
            mbaselist(FALSE);
            if (novice in thisuser.flags) then pausescr(FALSE);
            exit;
          end;
    else
      if (value(mstr) > 0) then
        begin
          i:=value(mstr);
          changeboard(i);
          if pos(';',mstr)>0 then begin
            s:=copy(mstr,pos(';',mstr)+1,length(mstr));
            curmenu:=general.menupath+s+'.mnu';
            newmenutoload:=TRUE;
            done:=TRUE;
          end;
          lastcommandovr:=TRUE;
          exit;
        end;
    end;
  if not (upcase(mstr[1]) = 'N') then
    mbaselist(FALSE)
  else
    nl;
  repeat
    prompt('^1Change message base (^5?^1=^5List^1) : ^3');
    scaninput(s,'Q?'^M);
    i:=ambase(value(s));
    if s='?' then
      mbaselist(FALSE)
    else
      if (i>=1) and (i<=MaxMBases) and (i<>board) then
        changeboard(i);
  until (s<>'?') or (hangup);
  lastcommandovr:=TRUE;
end;

end.