{ TBBS.PAS - Turbo Bulletin Board System } program tbbs; {$C-} {$I TBBSHDR.INC} {$I ACCESS.BOX} {$I GETKEY.BOX} {$I ADDKEY.BOX} {$I TBBSCOM.INC} {$I TBBSMSG.INC} procedure list(st: char); { List a portion of the system message file } var line: StdStr; begin writeln; Reset(sysm_file); repeat readln(sysm_file, line) until (EOF(sysm_file)) or ((line[1] = ':') and (line[2] = st)); repeat readln(sysm_file, line); if line[1] <> ':' then writeln(line) until (EOF(sysm_file)) or (line[1] = ':') or (brk); Close(sysm_file) end; procedure get_name; { Get user name } const st: StdStr = 'Name must have at least two characters.'; begin repeat fn := trim(prompt('FIRST name: ', len_fn, 'ES')); if length(fn) < 2 then writeln(st) until length(fn) >= 2; if (fn = 'SYSOP') then ln := '' else repeat ln := trim(prompt(' LAST name: ', len_ln, 'ES')); if length(ln) < 2 then writeln(st) until length(ln) >= 2 end; procedure get_password(var valid: boolean); { Accept and validate password. Everyone gets 'max_tries' to get their password right. If it is still wrong they will be logged out. } var tries: integer; temp: StdStr; begin tries := 1; repeat temp := prompt(' Password: ', Max_Str, 'S'); tries := tries + 1 until (temp = pw) or (tries > Max_Tries); if temp = pw then valid := TRUE { valid password } else begin writeln('Only ', Max_Tries, ' tries allowed.'); list('F'); valid := FALSE { forgetful user } end end; procedure get_nulls_and_case; { Get nulls and case switch from user } var st: StdStr; begin repeat st := prompt('How many nulls do you need [0-9]? ', 1, 'AE'); nulls := strint(st[1]) until (nulls >= 0) and (nulls <= 9); if ask('Can your terminal display lower case') then case_sw := 0 else case_sw := 32; if bye then begin mem[bye_base + 3] := nulls; mem[bye_base + 4] := case_sw end end; procedure get_new_user(var continue: boolean); { Get new user information } var i: integer; temp: StdStr; begin continue := FALSE; list('P'); writeln; if ask('Are you a new user') then begin get_nulls_and_case; ad := prompt('From what CITY and STATE are you calling: ', len_ad, 'E'); writeln; writeln('You are ', fn, ' ', ln, ' from ', ad); writeln; if ask('Is that correct') then begin writeln; writeln('Please select and enter a password of 4-', len_pw, ' characters'); writeln('to ensure that no one else uses your name on the system.'); writeln; repeat repeat temp := prompt('Password (will NOT display as you type): ', Max_Str, 'S'); i := length(temp); if (i < 4) or (i > len_pw) then writeln('Length must be 4-', len_pw, ' characters.'); until (4 <= i) and (i <= len_pw); pw := prompt(' Please enter it again to verify: ', Max_Str, 'S'); if pw <> temp then writeln('No match. Try again.'); until pw = temp; writeln; writeln('Your password will be required for all future calls.'); writeln('Please remember it.'); used := 0; bbs_stat := def_sta; maxdrv := def_drv; maxusr := def_usr; status := def_sta; for i := 0 to 5 do laston[i] := 0; time_today := 0; time_total := 0; lasthi := 0; upload := 0; download := 0; continue := TRUE; list('I'); pause; list('D'); pause end end end; procedure init_user; var i, caller, mon, hon, old_lasthi: integer; t: tad_array; this_st, last_st: StdStr; begin GetTAD(t); if (t[3] <> laston[3]) or (t[4] <> laston[4]) or (t[5] <> laston[5]) then time_today := 0; mon := t[1] - (time_today mod 60); { effective login time := actual - time_today } hon := t[2] - (time_today div 60); if mon < 0 then begin mon := mon + 60; hon := hon - 1; if hon < 0 then hon := hon + 24 end; this_st := systad(t); last_st := systad(laston); laston := t; mem[bye_base + 0] := maxusr; mem[bye_base + 1] := maxdrv; mem[bye_base + 3] := nulls; mem[bye_base + 4] := case_sw; mem[$3D] := maxdrv; mem[$3F] := maxusr; mem[$50] := hon; mem[$51] := mon; mem[$53] := status; mem[$54] := 0; mem[$55] := 0; if fn = 'SYSOP' then begin mem[$3E] := $FF; for i := 0 to 6 do mem[$48 + i] := path[i] end; list('B'); { Give 'em something to read while we update the disk } reset(calr_file); read(calr_file, calr_rec); seek(calr_file, 0); calr_rec.calr_num := calr_rec.calr_num + 1; caller := calr_rec.calr_num; calr_rec.calr_tad := t; write(calr_file, calr_rec); seek(calr_file, filesize(calr_file)); calr_rec.calr_num := user_loc; write(calr_file, calr_rec); Close(calr_file); rewrite(lclr_file); writeln(lclr_file, fn, ',', ln); Close(lclr_file); mesg_build_index; old_lasthi := lasthi; if MesgBase = nil then lasthi := 0 else lasthi := MesgLast^.MesgNo; put_user; writeln; writeln('Caller number : ', caller); writeln('Last on system : ', last_st); writeln('High message (then/now) : ', old_lasthi, '/', lasthi); writeln('Msgs waiting (public/private): ', msg_all, '/', msg_ind); { writeln('Access time (today/total) : ', time_today, '/', time_total); writeln('File (upload/download) : ', upload, '/', download); } writeln; writeln('Login at ', this_st) end; procedure login(var fini: boolean); { Log user into system } var valid, continue: boolean; begin list('W'); writeln; repeat get_name; user_loc := find_user(fn, ln); if user_loc = -1 then begin valid := TRUE; get_new_user(continue); if continue then add_user end else begin continue := TRUE; get_user; get_password(valid) end until continue; if valid then init_user; fini := not valid end; procedure restart(var fini: boolean); { Restart previous user } var i: integer; st: StdStr; begin reset(lclr_file); readln(lclr_file, st); Close(lclr_file); i := pos(',', st); fn := copy(st, 1, i - 1); ln := copy(st, i + 1, length(st) - i); user_loc := find_user(fn, ln); get_user; mesg_build_index; writeln('Welcome back, ', fn, '.'); fini := FALSE end; procedure alter_nulls_and_case; { Alter nulls and case } begin get_nulls_and_case; put_user end; procedure display_users; { Display "user" file } var i: integer; user_rec: user_list; begin writeln; ClearKey(IdxF); repeat NextKey(IdxF, i, st); if OK then begin GetRec(DatF, i, user_rec); if (user_rec.user_firstname <> 'SYSOP') and (user_rec.user_bbs_stat > 0) then writeln(user_rec.user_firstname, ' ', user_rec.user_lastname) end until (not OK) or brk end; procedure exit_to_system(var fini: boolean); { Exit to system } var t: tad_array; begin if (maxusr > 0) and (bbs_stat > 0) then begin list('E'); mem[0] := $C3; { Clear trap } fini := TRUE end else list('D') end; procedure goodbye(var fini: boolean); { Update statistics and log user off system } var t: tad_array; hon, mon: integer; begin if ask('Would you like to leave a comment to the sysop') then mesg_enter(TRUE); GetTAD(t); hon := t[2] - mem[$50]; if hon < 0 then hon := hon + 24; mon := 60 * hon + t[1] - mem[$51]; if mon < 0 then mon := mon + 60; laston := t; time_total := time_total + mon - time_today; time_today := mon; upload := upload + mem[$54]; download := download + mem[$55]; {$I-} erase(lclr_file) {$I+}; OK := (IOresult = 0); put_user; list('L'); fini := TRUE end; begin { main } { Table of accessible parameters in BYE |mxusr|mxdrv|toval|nulls|ulcsw|lfeeds|wrtloc|hardon|lostflg|covect| 'BYE'| |1 byt|1 byt|1 byt|1 byt|1 byt|1 byte|1 byte|1 byte|1 byte |2 byte|3 byte| | +0 | +1 | +2 | +3 | +4 | +5 | +6 | +7 | +8 | +9 | +11 | } bye_base := 256 * mem[2] + mem[1] - 2; { Cold boot address } bye_base := 256 * mem[bye_base + 1] + mem[bye_base] + 6; { Table address } bye := 'BYE' = chr(mem[bye_base + 11]) + chr(mem[bye_base + 12]) + chr(mem[bye_base + 13]); bye_start := mem[$5D] = 0; { Look to see how we got started } bel := FALSE; { Prompt bell initially off } writeln(version); if bye { Running under BYE? } then begin mem[0] := $CD; { Set disconnect trap } BDOS(14, 0); { Set drive and user } BDOS(32, 0); end; InitIndex; { Get files ready for use } OpenFile(DatF, user_data + ext, SizeOf(user_rec)); if OK then OpenIndex(IdxF, user_indx + ext, len_ln + len_fn, 0); assign(summ_file, summ_name + ext); reset(summ_file); assign(mesg_file, mesg_name + ext); reset(mesg_file); assign(calr_file, calr_name + ext); assign(lclr_file, lclr_name + ext); assign(sysm_file, sysm_name + ext); if bye and (not bye_start) then restart(fini) else login(fini); if fini then goodbye(fini) else repeat { Main command acceptor/dispatcher } st := '?'; writeln; st := prompt('Function (? for MENU): ', 1, 'AES'); case st[1] of 'A': alter_nulls_and_case; 'B': list('B'); 'C': exit_to_system(fini); 'E': mesg_enter(FALSE); 'G': goodbye(fini); 'H': list('H'); 'I': list('I'); 'K': mesg_read; 'N': list('N'); 'O': list('O'); 'P': bel := not bel; 'Q': mesg_quick_scan; 'R': mesg_read; 'S': mesg_summary; 'U': display_users; 'W': list('W') else list('M') end; until fini; CloseFile(DatF); CloseIndex(IdxF); Close(summ_file); Close(mesg_file) end.