{ PICS2F.INC - Pascal Integrated Communications System } { 6/19/87 vers 1.6 Copyright 1987 by Les Archambault} overlay procedure validate_user; { Change user access time and level to 'validated' status } var temp_user_loc: integer; ed_fn: firstname; ed_ln: lastname; key: StrName; temp_user_rec: user_list; begin if ((not remote_copy) and remote_online) then begin if (user_rec.access < val_acc) then if ask(user_rec.fn+' '+user_rec.ln+' eintragen') then begin user_rec.access := val_acc; user_rec.limit := val_time; WriteLn(USR, user_rec.fn, ' ', user_rec.ln, ' ist jetzt eingetragen.') end; end else begin OK:=true; ed_fn:=trim(prompt('Vorname ',len_fn,'ESNU')); if ed_fn<>'' then ed_ln:=trim(prompt('Zuname ',len_ln,'ESNU')); if (ed_fn='') or (ed_ln='') then OK:=false; if Ok then begin key := pad(ed_ln, len_ln) + pad(ed_fn, len_fn); FindKey(IdxF, temp_user_loc, key); end; if (not OK) then writeln(USR, 'Name nicht gefunden.') else GetRec(DatF, temp_user_loc, temp_user_rec); if OK and (temp_user_rec.access < val_acc) then if ask(temp_user_rec.fn+' '+temp_user_rec.ln + ' eintragen') then begin temp_user_rec.access := val_acc; temp_user_rec.limit := val_time; PutRec(DatF, temp_user_loc, temp_user_rec); writeln(USR, temp_user_rec.fn, ' ', temp_user_rec.ln, ' ist jetzt eingetragen.') end end end; overlay procedure delete_user; { Delete user from file } var i, temp_user_loc: integer; del_fn: firstname; del_ln: lastname; key: StrName; temp_user_rec: user_list; err:boolean; begin err:=false; OK:=true; SetSect(HomDrv,HomUsr); del_fn:=trim(prompt('Vorname ',len_fn,'ESNU')); if del_fn<>'' then del_ln:=trim(prompt('Zuname ',len_ln,'ESNU')); if (del_fn='') or (del_ln='') then OK:=false; writeln(usr); if ok then begin key := pad(del_ln, len_ln) + pad(del_fn, len_fn); SearchKey(IdxF, temp_user_loc, key); end; if OK and (temp_user_loc<=filelen(DatF)) then begin GetRec(DatF, temp_user_loc, temp_user_rec); Writeln(usr,'Gefunden: ',temp_user_rec.fn,' ',temp_user_rec.ln); writeln(usr); if temp_user_rec.access < user_rec.access then if ask('Loeschen') then begin DeleteKey(IdxF, temp_user_loc, key); if OK then begin DeleteRec(DatF, temp_user_loc); writeln(usr); writeln(USR, 'Revidiere Message Summary File.'); for i := 1 to pred(FileSize(summ_file)) do begin { Delete messages pertaining to user } {$I-} seek(summ_file, i); {$I+} err:=(ioresult<>0); {$I-} read(summ_file, summ_rec); {$I+} err:=(ioresult<>0); if (((summ_rec.user_to = temp_user_loc) or (summ_rec.user_from = temp_user_loc))) and (not err) then begin if summ_rec.user_to=temp_user_loc then summ_rec.user_to:=-1; if summ_rec.user_from=temp_user_loc then summ_rec.user_from:=-1; summ_rec.status:=deleted; seek(summ_file,pred(filepos(summ_file))); write(summ_file,summ_rec); end; end; if err then begin log(10,'Del User'); log(10,'Msg File'); end; {now clear newin file references} Writeln(usr,'Revidiere Newin File.'); {$I-} seek(nwin_file,0); {$I+} err:=(ioresult<>0); while (not eof(nwin_file)) and (not err) do begin {$I-} read(nwin_file,nwin_rec); {$I+} err:=(ioresult<>0); If (not err) then begin if nwin_rec.user=temp_user_loc then begin nwin_rec.user:=0; write(nwin_file,nwin_rec); end; end; end; if err then begin log(10,'Del User'); log(10,'Newin File'); end; {now finally, the log file} writeln(usr,'Revidiere Log File.'); {$I-} seek(logr_file,1); {$I+} err:=(ioresult<>0); while (not eof(logr_file)) and (not err) do begin {$I-} read(logr_file,logr_rec); {$I+} err:=(ioresult<>0); If (not err) then begin if logr_rec.user=temp_user_loc then begin logr_rec.user:=0; write(logr_file,logr_rec); end; end; end; if err then begin log(10,'Del User'); log(10,'Log File'); end; if (not err) and OK then writeln(USR, key, ' geloescht.'); writeln(usr); end; {OK - revising files} end; { wants to delete} end {key found} else if temp_user_loc>filelen(DatF) then begin writeln(usr,'Falsche User Nummer - unbrauchbar.'); log(10,'delete user'); log(10,'User Nummer'); end; end; {delete user} {end of PICS2f.inc }