{PICS2F1.INC Pascal Integrated Communications System} { 5/25/87 vers 1.6 Copyright 1987 by Les Archambault} overlay procedure rebuild_index; { Rebuild the user index file from the data file. In addition, this routine will recover the data file from certain types of damage. } var i, previous_rec, count_used, count_unused: integer; key: StrName; temp_user_rec: user_list; temp: file; begin writeln(USR, 'User Index File wird erneuert.'); writeln(USR, 'User Daten File in Reihenfolge der Eintraege:'); CloseIndex(IdxF); Assign(temp, user_drv + user_indx + ext); Erase(temp); InitIndex; MakeIndex(IdxF, user_drv + user_indx + ext, len_ln + len_fn, 0); previous_rec := -1; count_used := 0; count_unused := 0; with temp_user_rec do begin for i := 1 to pred(FileLen(DatF)) do begin GetRec(DatF, i, temp_user_rec); if used = 0 then begin key := pad(ln, len_ln) + pad(fn, len_fn); AddKey(IdxF, i, key); if OK then begin count_used := succ(count_used); writeln(USR, i:4, ' ', used:4, ' ', fn, ' ', ln) end else begin used := previous_rec; { Can't use DeleteRec since } previous_rec := i; { we're playing with pointers } PutRec(DatF, i, temp_user_rec); count_unused := succ(count_unused); writeln(USR, i:4, ' ', used:4, ' Doppeleintraege geloescht') end end else begin used := previous_rec; previous_rec := i; PutRec(DatF, i, temp_user_rec); count_unused := succ(count_unused); writeln(USR, i:4, ' ', used:4, ' Freie Datensaetze') end end end; GetRec(DatF, 0, temp_user_rec); DatF.FirstFree := previous_rec; DatF.NumberFree := count_unused; PutRec(DatF, 0, temp_user_rec); { Normally PICS only closes files between sessions to improve operational speed, but since essential data files have just been modified, they will be closed and reopened to ensure file integrity. } CloseFile(DatF); CloseIndex(IdxF); OpenFile(DatF, user_drv + user_data + ext, SizeOf(user_rec)); OpenIndex(IdxF, user_drv + user_indx + ext, len_ln + len_fn, 0); InitIndex; writeln(USR); writeln(USR, FileLen(DatF), ' Datensaetze, ', UsedRecs(DatF), ' Benutzer in Liste.') end; Overlay Procedure Make_Message; {makes a message entry from a disk file} var msg_status: record_status; abort:boolean; ch: char; start,last_line, to_loc,from_loc,x,to_area: integer; to_fn,from_fn: firstname; to_ln,from_ln: lastname; subj: subject; key: StrName; temp_user_rec: user_list; msg_line:message; mfile:text; mname:filename; t:tad_array; this:areaptr; area:str10; begin writeln(usr); ok:=true; mname:=prompt('Name der Datei fuer Brief ',12,'ESU'); if mname<>' ' then begin Abort:=false; Assign(mfile,mname); {$I-} Reset(mfile); {$I+} if ioresult<>0 then begin Writeln(usr); writeln(usr,'Kann Datei ',mname, ' nicht finden.'); writeln(usr); ok:=false; end; if ok then begin Writeln(USR); Write(USR, ' Von: ', user_rec.fn, ' ', user_rec.ln); if (not ask(' OK')) then begin repeat from_fn:=prompt('Von VORNAME ',len_fn,'ESNU'); if from_fn='QUIT' then abort:=true else from_ln:=prompt('Von ZUNAME ',len_ln,'ESNU'); if from_ln='QUIT' then abort:=true; if (not abort) then begin key := pad(from_ln, len_ln) + pad(from_fn, len_fn); FindKey(IdxF, from_loc, key); if not OK then begin Writeln(USR, from_fn, ' ', from_ln, ' ist in diesem System unbekannt.'); writeln(usr,'Mit Eingabe "QUIT" beenden.'); end; end; until ok or abort or (not online); end {get new FROM name} else from_loc:=user_loc; OK:=false; if (not abort) then begin repeat to_fn := prompt('An VORNAME [CR fuer ALLE] ', len_fn, 'ESNU'); if to_fn='QUIT' then abort:=true else if to_fn=' ' then begin to_loc:=0; msg_status:=public; ok:=true; end else if to_fn = 'SYSOP' then to_ln := '' else to_ln := prompt('ZUNAME ', len_ln, 'ESNU'); if to_ln='QUIT' then abort:=true; if (not OK) and (not abort) then begin key := pad(to_ln, len_ln) + pad(to_fn, len_fn); FindKey(IdxF, to_loc, key); if not OK then begin Writeln(USR, to_fn, ' ', to_ln, ' ist in diesem System unbekannt.'); writeln(usr,'Mit Eingabe "QUIT" beenden.'); end; end; until (not online) or OK or abort; if abort or (not online) then OK:=false; if OK then begin subj := prompt('Betrifft ', len_subj, 'EL'); if subj='' then subj:='ALLGEMEIN'; If to_fn<>' ' then begin if Ask('Soll dieser Brief oeffentlich sein') then msg_status:=public else msg_status:=private; end; repeat this:=areabase; area:=prompt('Briefkasten ',12,'ES?MU'); if (area=' ') or (area='?') then begin Writeln(usr,'Erreichbare Briefkaesten:'); writeln(usr); while this<>nil do begin writeln(usr,this^.areaname); this:=this^.next; end; end else begin this:=areabase; while (this<>nil) and (area<>this^.areaname) do this:=this^.next; end; until (area=this^.areaname) or (not online); to_area:=this^.area; start:=filesize(mesg_file); {record msg lines} seek(mesg_file,start); last_line:=0; while (not EOF(mfile)) do begin Readln(mfile,msg_line); write(mesg_file,msg_line); last_line:=succ(last_line); end; close(mfile); GetTAD(t); {make summary file record} seek(summ_file, 0); read(summ_file, summ_rec); with summ_rec do begin date := t; status := msg_status; area := to_area; num := succ(num); num_prev := 0; {used for prot. pub msgs} if user_rec.access>=250 then num_next:=255 else num_next := 0; { for file foward file listing} user_from := from_loc; user_to := to_loc; subject := subj; st_rec := start; size := last_line; end; seek(summ_file, 0); Write(summ_file, summ_rec); seek(summ_file, filesize(summ_file)); {add new record to end} Write(summ_file, summ_rec); mesg_insert(0); writeln(usr); writeln(usr,'Brief ist fertig.'); end; {OK second time} end; {not abort} end; {OK} end; {Name<>' '} end; {make message} { end of PICS2F1.inc }