Category : Pascal Source Code
Archive   : PPC50S.ZIP
Filename : PPCMAIN.INC
{ PICSPC Pascal Integrated Communications System module}
{ 5/31/87 IBM PC VERS 5.0 Copyright 1987 by Les Archambault }
Procedure Set_Initial_areas;
begin
if not macro_in_progress then
begin
pause;
list('B');
pause;
repeat until (not BRK) or (not online);
end;
if user_rec.access >= 250 then
begin
mesg_area_change('SYSTEM');
file_area_change('NEWIN');
end
else
begin
mesg_area_change('POST');
file_area_change('LOGIN')
end;
end;
Procedure Check_time;
{checks time on system and time left}
begin
timer(time_on, time_left);
if time_left <= 0 then
begin
writeln(USR, 'Access time expired. Please call back tomorrow.', BEL, BEL, BEL);
remote_online := FALSE
end
else if time_left <= 5 then
writeln(USR, 'Less than 5 minutes of access time left. Please finish up.', BEL);
end;
Procedure Make_Prompt;
begin
st := intstr(time_left, 1) + '-' + pr_msg[mode];
case mode of
message_mode: st := st + ' ' + AreaReq;
files_mode : begin
st := st + ' ' + SectReq;
if in_library then st := st + ' [' + LibReq + ']';
if in_arc then st := st + ' [' + ArcReq + ']';
if new_dir then directory;
if up_down_display then
begin
writeln(usr);
writeln(USR, user_rec.upload, ' uploads, ',
user_rec.download, ' downloads to date.');
up_down_display := FALSE;
end;
end;
end;
if (user_rec.access>=250) and Audit_on then st:=st+' (Audit ON) ';
end;
Procedure Process_messages;
begin
case ch of
'A': Articles;
'C': mesg_area_change('');
'E': begin
mesg_enter(' ');
mesg_build_index(areaset);
end;
'F': mode := files_mode;
'G': in_use := FALSE;
'Q': mesg_quick_scan;
'R': mesg_read;
'S': mesg_summary;
'U': mode := utility_mode;
'X': if (user_rec.access >= 250) or (not remote_copy)
then mode := sysop_mode;
'B', 'I': list(ch);
'O': List_file('OTHERSYS.LST',homName)
else
begin
list('M');
if (not macro_in_progress) then
begin
mult_cmds:=false;
cmd_queue:='';
clear_inbuf;
end;
end;
end;
end;
Procedure Process_files;
begin
if ((st[1]='S') or (st[1]='K')) and (user_rec.access
if st='REN' then rename_file
else
if st='DEL' then delete_file
else
if st='COPY' then copy_file
else
if st='STAT' then file_status
else
if st='SK' then SendXmodem('K')
else
If st='SB' then SendXmodem('B')
else
IF st='RB' then
begin
if in_library then library;
if in_arc then arc;
RecvXmodem('B');
end
else
If st='RK' then
begin
if in_library then library;
if in_arc then arc;
RecvXmodem('K');
end
else
If st='DIR' then directory
else
if st='FIND' then
begin
if in_library then library;
if in_arc then arc;
find_files;
end
else
if st='TYPE'then SendText
else
if st='ARC' then
begin
if in_library then library;
arc;
end
else
case ch of
'A': begin
if in_library then library;
Arc;
end;
'C': begin
if in_arc then Arc;
if in_library then library;
file_area_change('')
end;
'D': directory;
'F': begin
if in_library then library;
if in_arc then arc;
find_files;
end;
'G': in_use := FALSE;
'L': begin
if in_arc then Arc;
library;
end;
'M': mode := message_mode;
'N': begin
if in_library then library;
if in_arc then arc;
newin_list;
end;
'R': begin
if in_library then library;
if in_arc then arc;
RecvXmodem(' ');
end;
'S': SendXmodem('X'); { 128 byte protocol}
'T': SendText;
'U': mode := utility_mode;
'X': if (user_rec.access >= 250) or (not remote_copy)
then mode := sysop_mode;
'Z': toggle_st_switch
else
begin
list('F');
if user_rec.access>=250 then list('Z');
if (not macro_in_progress) then
begin
mult_cmds:=false;
cmd_queue:='';
clear_inbuf;
end;
end;
end;
end;
Procedure process_utility;
Begin
case ch of
'A': alter_user_params;
'C': if chat then mesg_enter('S');
'F': mode := files_mode;
'G': in_use := FALSE;
'M': mode := message_mode;
'S': display_stats;
'T': display_time;
'U': display_users;
'Y': show_user_stats;
'X': begin
if (user_rec.access >= 250) or (not remote_copy)
then mode := sysop_mode;
end
else
begin
list('U');
if (not macro_in_progress) then
begin
mult_cmds:=false;
cmd_queue:='';
clear_inbuf;
end;
end;
end;
end;
Procedure process_sysop;
Begin
case ch of
'A': toggle_audit;
'B': Make_message;
'C': config_sys;
'D': delete_user;
'E': edit_user('','');
'F': mode := files_mode;
'G': in_use := FALSE;
'I': rebuild_index;
'L': print_log;
'M': mode := message_mode;
'N': process_newin;
'O': process_macro;
'P': purge_files;
'Q': in_use:=false;
'R': print_messages;
'S': sys_dir;
'T': toggle_printer;
'U': mode := utility_mode;
'V': validate_user
else
begin
list('X');
if (not macro_in_progress) then
begin
mult_cmds:=false;
cmd_queue:='';
clear_inbuf;
end;
end;
end;
end;
Procedure check_300_restrict;
var t:tad_array;
begin
gettad(t);
if (rate=300) and (restrict300)
and (t[2]>start_restrict300) and (t[2]
writeln(usr);
writeln(usr,'300 Baud Callers are restricted from ',
start_restrict300,':00 - ',end_restrict300,':00 hours.');
writeln(usr,'Please call back outside of these times.');
remote_online:=false;
mdhangup;
end;
end;
begin { PICSPC }
system_init;
cold_start;
setup;
wait_for_user;
check_300_restrict;
while not fini do
begin
login;
if online and in_use then Set_Initial_areas;
while online and in_use do
begin
writeln(usr);
if op_chat
then op_chat := chat;
check_time;
make_prompt;
write_status_line;
writeln(usr);
st:=prompt(st,50,'ES?M');
if length(st)>=1 then ch := st[1]
else ch:=' ';
if (not op_chat) then
begin
case mode of
message_mode: process_messages;
files_mode: process_files;
utility_mode: process_utility;
sysop_mode: process_sysop;
end;
end;
end; {online and in use}
if in_library then library;
if in_arc then arc;
if audit_on then toggle_audit;
if (user_rec.fn <> 'SYSOP') and online then
begin
if not valid_pw then mesg_enter('S')
else if ask('Do you have a message for the sysop')
then mesg_enter('S');
end;
wrapup;
setup;
wait_for_user;
check_300_restrict;
end;
system_de_init
end.
{End of PPCmain.inc}
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/