{ PICS0A.INC - Pascal Integrated Communications System Overlays} { 5/25/87 VER. 1.6 Copyright 1987 by les archambault } overlay function correct_fn(str: FileName): FileName; { Correct possible errors in file name } var i, j: integer; begin i := 1; { Remove blanks and invalid characters } while i <= length(str) do if str[i] in [' ', '*', ',', ':', ';', '=', '?', '_'] then delete(str, i, 1) else i := succ(i); while (str <> '') and (str[1] = '.') do { Remove leading '.' } delete(str, 1, 1); i := pos('.', str); { Remove redundant '.' } j := 1; while j <= length(str) do if (str[j] = '.') and (j > i) then delete(str, j, 1) else j := succ(j); i := pos('.', str); if i = 0 { Ensure name has '.' } then begin str := copy(str, 1, 8); { Ensure file name <= 8 characters } if length(str) > 0 then str := str + '.' end else str := copy(str, 1, min(8, pred(i))) + '.' + copy(str, succ(i), min(3, length(str) - i)); correct_fn := str end; overlay function compress_fn(name: FileName): FileName; { Strip hi bits and remove all blanks from file name } var i: integer; begin for i := 1 to length(name) do name[i] := chr($7F and ord(name[i])); i := pos(' ', name); while i > 0 do begin delete(name, i, 1); i := pos(' ', name) end; compress_fn := name end; overlay procedure get_old_password(pr: StrPr; var valid: boolean); { Accept and validate old password. Only 'Max_Tries' will be allowed. } var tries: integer; begin tries := 0; repeat valid := (user_rec.pw = prompt(pr, len_pw, 'S')); tries := succ(tries) until (not online) or valid or (tries > Max_Tries); if not valid then writeln(USR, 'Only ', Max_Tries, ' tries allowed.') end; overlay procedure get_new_password; { Accept and validate new password. } var i,x: integer; trial_pw: password; begin writeln(USR); writeln(USR, 'Please select and enter a password of 4-', len_pw, ' characters'); writeln(USR, 'to ensure that no one else uses your name on the system.'); writeln(USR); repeat repeat trial_pw := prompt('Password (will NOT display as you type)', len_pw, 'SL'); i := length(trial_pw); if (i < 4) or (i > len_pw) then writeln(USR, 'Length must be 4-', len_pw, ' characters.') else begin for x:=1 to length(trial_pw) do if (not(ord(trial_pw[x]) in [48..57])) and (not(ord(trial_pw[x]) in [65..90])) then i:=0; if i=0 then writeln(usr,'Only characters A-Z and numbers 0-9 allowed.'); end; until (not online) or ((4 <= i) and (i <= len_pw)); user_rec.pw := prompt(' Please enter it again for verification', len_pw, 'SL'); if user_rec.pw <> trial_pw then writeln(USR, 'No match. Try again.') until (not online) or (user_rec.pw = trial_pw); writeln(USR); writeln(USR, 'Please remember your password.'); writeln(USR, 'It will be required for all future calls.') end; overlay procedure get_case; { Get case switch from user } begin user_rec.shift_lock := not ask('Can your terminal display lower case') end; overlay procedure get_nulls; { Get nulls from user } begin if online then user_rec.nulls := strint(prompt('How many nulls do you need [0-9]?', 1, 'ES')) end; overlay function mesg_start(pr: StrPr): integer; { Get starting message number from user } var i,last: integer; begin repeat writeln(usr); last:=user_rec.lasthi; i:= strint(prompt(pr +' (last mesg you read is '+intstr(last,1)+') '+ ' [' + intstr(msg_lo, 1) + '-' + intstr(msg_hi, 1) + ']?',5,'E')); if (i msg_hi) then Writeln(usr,'Invalid message number, try again.'); until ((i>=msg_lo) and (i<=msg_hi)) or (not online); mesg_start := i end; Overlay procedure mesg_header_list(loc:integer; var first_line, last_line:integer; var Fr_fn:firstname; var Fr_ln:lastname); { Display message header } var to_fn: firstname; to_ln: lastname; str: StrTAD; temp_user_rec: user_list; this: areaptr; begin seek(summ_file, loc); read(summ_file, summ_rec); with summ_rec do begin if user_to = 0 then begin to_fn := 'ALL'; to_ln := '' end else if user_to = user_loc then begin to_fn := user_rec.fn; to_ln := user_rec.ln end else begin if user_to<>-1 then begin GetRec(DatF, user_to, temp_user_rec); to_fn := temp_user_rec.fn; to_ln := temp_user_rec.ln; end else begin to_fn:='Deleted User'; to_ln:=''; end; end; if user_from = user_loc then begin fr_fn := user_rec.fn; fr_ln := user_rec.ln end else begin if user_from<>-1 then begin GetRec(DatF, user_from, temp_user_rec); fr_fn := temp_user_rec.fn; fr_ln := temp_user_rec.ln; end else begin fr_fn:='Deleted User'; fr_ln:=''; end; end; str := FormTAD(date); this:=areabase; while (this<>nil) and (this^.area<>area) do this:=this^.next; writeln(USR); if num_prev=255 then write(usr,'

'); case status of deleted: write(USR, 'Deleted'); read: write(USR, 'Read'); private: write(USR, 'Private'); public: write(USR, 'Public'); restricted: write(usr,'Restricted'); end; writeln(USR,' message # ',num,' ',this^.areaname, ' AREA ',' Entered ',str); writeln(USR, 'From: ', fr_fn, ' ', fr_ln); writeln(USR, ' To: ', to_fn, ' ', to_ln); writeln(USR, ' Re: ', subject); if audit_on then begin setsect(AudDrv,AudUsr); writeln(AuditFile); if num_prev=255 then write(auditfile,'

'); case status of deleted: write(AuditFile, 'Deleted'); read: write(AuditFile, 'Read'); private: write(AuditFile, 'Private'); public: write(AuditFile, 'Public'); restricted: write(Auditfile,'Restricted'); end; writeln(AuditFile, ' message # ', num, ' entered ', str); writeln(AuditFile, 'From: ', fr_fn, ' ', fr_ln); writeln(AuditFile, ' To: ', to_fn, ' ', to_ln); writeln(AuditFile, ' Re: ', subject); setsect(homdrv,homusr); end; first_line := st_rec; last_line := size end end; {message header list} overlay procedure mesg_delete; { Delete the current message } var this: MesgPtr; begin summ_rec.status := deleted; seek(summ_file, pred(FilePos(summ_file))); write(summ_file, summ_rec); this := MesgCurr; if MesgCurr = MesgBase then begin MesgCurr := MesgBase^.next; MesgBase := MesgBase^.next; dispose(this) end else if MesgCurr <> nil then begin MesgCurr := MesgBase; { Find previous record } while MesgCurr^.next <> this do MesgCurr := MesgCurr^.next; MesgCurr^.next := this^.next; { Make it point to next record } if MesgLast = this then MesgLast := MesgCurr; MesgCurr := MesgCurr^.next; dispose(this) end; writeln(USR, 'Message #', summ_rec.num, ' deleted.') end; {mesg_delete} overlay procedure mesg_build_index(mesg_area: byte); { Scan summary file and build message index list. Messages are tied to the current message area. All messages are accessible in mesg_area #0 (SYSTEM). } var this: MesgPtr; begin while MesgBase <> nil do { Delete old messages } begin this := MesgBase; MesgBase := MesgBase^.next; { Go to next on list } dispose(this) { Reclaim space } end; msg_all := 0; msg_ind := 0; msg_aut := 0; msg_sys := 0; msg_hi:=0; msg_lo:=30000; seek(summ_file, 1); while not EOF(summ_file) do with summ_rec do begin read(summ_file, summ_rec); if ((status<>deleted) and (status<>restricted) and (area=mesg_area)) or (mesg_area=0) then begin if msg_lo>num then msg_lo:=num; if num>msg_hi then msg_hi:=num; end; if (status=public) and ((area=mesg_area) or (mesg_area=0)) {Public message} then If user_loc=user_to then begin msg_ind:=succ(msg_ind); msg_all:=succ(msg_all); {add to public count too} mesg_insert(1); end else If user_loc=user_from then begin msg_aut:=succ(msg_aut); msg_all:=succ(msg_all); mesg_insert(2); end else begin msg_all := succ(msg_all); mesg_insert(0) end else if (status <> deleted) and (user_loc = user_to) and ((area=mesg_area) or (mesg_area=0)) then begin { Private message } msg_ind := succ(msg_ind); mesg_insert(1) end else if (status <> deleted) and (user_loc = user_from) and ((area=mesg_area) or (mesg_area=0)) then begin { Author of message } msg_aut := succ(msg_aut); mesg_insert(2) end else if mesg_area = 0 then begin { Sysop can view all messages } msg_sys := succ(msg_sys); mesg_insert(3) end end; if msg_lo>=29999 then msg_lo:=0; summ_rec.user_from := 0 end; overlay procedure mesg_directory; { Display directory of messages } var col_width, col_count, col_limit,conf_num: integer; this:areaptr; temstr:string[160]; found:boolean; begin {msg_directory} col_width:=6; col_limit := max(1, user_rec.columns div col_width); writeln(USR, 'Message numbers, this area : ',msg_lo,'-',msg_hi); writeln(USR, 'Public messages, this area : ', msg_all); writeln(USR); if msg_ind = 0 then writeln(USR, user_rec.fn, ', no messages for you in this area.') else begin writeln(USR, user_rec.fn, ', the following messages are addressed to you:'); col_count := 0; MesgCurr := MesgBase; while (not brk) and (MesgCurr <> nil) do begin if MesgCurr^.TypMsg = 1 then begin write(USR, MesgCurr^.MesgNo:col_width); col_count := succ(col_count); if (0 = col_count mod col_limit) then writeln(USR) end; MesgCurr := MesgCurr^.next end; writeln(USR) end; if msg_aut > 0 then begin writeln(USR, user_rec.fn, ', the following messages were sent by you:'); col_count := 0; MesgCurr := MesgBase; while (not brk) and (MesgCurr <> nil) do begin if MesgCurr^.TypMsg = 2 then begin write(USR, MesgCurr^.MesgNo:col_width); col_count := succ(col_count); if (0 = col_count mod col_limit) then writeln(USR) end; MesgCurr := MesgCurr^.next end; writeln(USR); end; Seek(summ_file,1); {look for msgs in other areas} col_count:=0; col_width:=12; temstr:=''; Writeln(usr); col_limit:=max(1,user_rec.columns div col_width); found:=false; While not EOF(summ_file) do with summ_rec do begin read(summ_file,summ_rec); if (status<>deleted) and (area<>areaset) and (user_loc=user_to) then begin this:=areabase; while (this<>nil) and (this^.area<>area) do this:=this^.next; conf_num:=this^.Areaconf; if (pos(this^.areaname,temstr)=0) and (this<>nil) and ((user_rec.access>=this^.areaaccs) or (test_bit(user_rec.conf_flags,conf_num))) then begin found:=true; Write(usr,this^.areaname:col_width); col_count:=succ(col_count); temstr:=temstr+this^.areaname; if (0=col_count mod col_limit) then writeln(usr); end; end; end; {reading summary file} writeln(usr); if found then Writeln(usr,user_rec.fn,', Above are other Areas with messages for you.'); writeln(usr); end; {END OF PICS0A.INC }