{ PICS2I.INC - Pascal Integrated Communications System } { 6/12/87 vers 1.6 Copyright 1987 by Les Archambault} overlay procedure purge_files; { Purge various system files of extraneous records } var done: boolean; ch_sel: char; age, cur_date: real; t: tad_array; procedure purge_log; { Purge the log file of all records } begin Write(USR, 'LOG File wird gereinigt...'); Seek(logr_file, 0); Read(logr_file, logr_rec); Close(logr_file); Rewrite(logr_file); Write(logr_file, logr_rec); flush(logr_file); Writeln(USR); log(11,'Log File'); end; procedure purge_message; { Purge deleted messages } const col_width = 6; var i, col_count, col_limit,req_size: integer; size:real; nsum_file : file of summ_list; nmsg_file : file of mesg_list; begin size:=filesize(summ_file) * 80.0; req_size:=trunc(size/1024.0); if frac(size/1024.0)>0 then req_size:=req_size+2; size:=filesize(mesg_file) * 73.0; req_size:=req_size+trunc(size/1024.0); if frac(size/1024.0)>0 then req_size:=req_size+2; if diskfree(homdrv,homusr)>req_size then begin col_limit := max(1, user_rec.columns div col_width); Write(USR, 'MESSAGE Files werden gereinigt...'); Assign(nsum_file, summ_drv + summ_name + '.$$$'); Assign(nmsg_file, mesg_drv + mesg_name + '.$$$'); Rewrite(nsum_file); Rewrite(nmsg_file); Seek(summ_file, 0); Read(summ_file, summ_rec); { Copy message counter to new file } Write(nsum_file, summ_rec); col_count := 0; while not EOF(summ_file) do with summ_rec do begin Read(summ_file, summ_rec); age := cur_date - greg_to_jul(date[3], date[4], date[5]); if ((status = deleted) or (age > unr_days) or ((status = read) and (age > rea_days))) and (num_prev<>255) then begin {delete message} if (0 = col_count mod col_limit) then Writeln(USR); Write(USR, num:col_width); col_count := succ(col_count) end else begin {save message} Seek(mesg_file, st_rec); st_rec := filesize(nmsg_file); Write(nsum_file, summ_rec); for i := 1 to size do begin read(mesg_file, mesg_rec); Write(nmsg_file, mesg_rec) end end end; Close(summ_file); Close(mesg_file); Close(nsum_file); Close(nmsg_file); Erase(summ_file); Erase(mesg_file); Rename(nsum_file, summ_drv + summ_name + ext); Rename(nmsg_file, mesg_drv + mesg_name + ext); Reset(summ_file); Reset(mesg_file); Writeln(USR); Log(11,'Msg Files'); end else Writeln(usr,'Unzureichender Diskettenspeicher fuer Reinigung der MESSAGE Files.'); end; procedure purge_newin; { Purge deleted newin records } var new_nwin_file: file of nwin_list; req_size:integer; size:real; begin size:=filesize(nwin_file) * 120.0; req_size:=trunc(size/1024.0); if frac(size/1024.0)>0 then req_size:=req_size+2; if diskfree(homdrv,homusr)>req_size then begin Write(USR, 'NEWIN File wird gereinigt...'); Assign(new_nwin_file, nwin_drv + nwin_name + '.$$$'); Rewrite(new_nwin_file); Seek(nwin_file, 0); repeat {$I-} Read(nwin_file, nwin_rec) {$I+}; if IOresult = 0 then if nwin_rec.status <> deleted then Write(new_nwin_file, nwin_rec) until EOF(nwin_file); Close(nwin_file); Close(new_nwin_file); Erase(nwin_file); Rename(new_nwin_file, nwin_drv + nwin_name + ext); Reset(nwin_file); Writeln(USR); Log(11,'Newin File'); end else writeln(usr,'Unzureichender Diskettenspeicher fuer Reinigung des NEWIN File.'); end; procedure purge_user; { Purge outdated users } var i, temp_user_loc: integer; Tstr: StrTAD; key: StrName; temp_user_rec: user_list; begin Write(USR, 'USER File wird gereinigt...'); temp_user_loc := 1; while (not brk) and (temp_user_loc < FileLen(DatF)) do with temp_user_rec do begin GetRec(DatF, temp_user_loc, temp_user_rec); age := cur_date - greg_to_jul(laston[3], laston[4], laston[5]); if ((used = 0) and (not test_bit(temp_user_rec.flags,5)) and (((age > unv_days) and (access < val_acc)) or ((age > val_days) and (access >= val_acc)))) then begin {purge the guy} key := pad(ln, len_ln) + pad(fn, len_fn); DeleteKey(IdxF, temp_user_loc, key); if OK then begin DeleteRec(DatF, temp_user_loc); Tstr := FormTAD(laston); Writeln(USR); Write(USR, key, ' ', access, ' ', Tstr); for i := 1 to pred(FileSize(summ_file)) do { Delete messages pertaining to user } begin {$I-} seek(summ_file, i); {$I+} OK:=(ioresult=0); if OK then begin read(summ_file, summ_rec); if ((summ_rec.user_to = temp_user_loc) or (summ_rec.user_from = temp_user_loc)) then begin writeln(USR); summ_rec.status := deleted; if (summ_rec.user_to = temp_user_loc) then summ_rec.user_to := -1 else summ_rec.user_from := -1; seek(summ_file, pred(FilePos(summ_file))); write(summ_file, summ_rec); write(USR,'Brief #', summ_rec.num, ' geloescht.') end; end; end; {now clear newin file references} {$I-} seek(nwin_file,0); {$I+} OK:=(ioresult=0); while (not eof(nwin_file)) and OK do begin {$I-} read(nwin_file,nwin_rec); {$I+} OK:=(ioresult=0); If OK then begin if nwin_rec.user=temp_user_loc then begin nwin_rec.user:=0; write(nwin_file,nwin_rec); end; end; end; {now finally, the log file} {$I-} seek(logr_file,1); {$I+} while (not eof(logr_file)) and OK do begin {$I-} read(logr_file,logr_rec); {$I+} OK:=(ioresult=0); If OK then begin if logr_rec.user=temp_user_loc then begin logr_rec.user:=0; write(logr_file,logr_rec); end; end; end; end; end; temp_user_loc := succ(temp_user_loc) end; Writeln(USR); Log(11,'User Files'); end; begin {PURGE FILES} GetTAD(t); cur_date := greg_to_jul(t[3], t[4], t[5]); done := FALSE; OK:=false; repeat st:=prompt('Datei(en) reinigen ',80, 'ES?'); if length(st)=1 then ch_sel:=st[1] else ch_sel:='?'; case ch_sel of 'A': begin if (not macro_in_progress) then OK:=ask('Wirklich ALLE Files reinigen'); if macro_in_progress or OK then begin purge_log; purge_newin; purge_user; purge_message; done := TRUE end; end; 'L': if macro_in_progress then purge_log else if ask('Wirklich das LOG File reinigen') then purge_log; 'M': if macro_in_progress then purge_message else if ask('Wirklich die MESSAGE Files reinigen') then purge_message; 'N': if macro_in_progress then purge_newin else if ask('Wirklich das NEWIN File reinigen') then purge_newin; 'U': if macro_in_progress then purge_user else if ask('Wirklich das USER File reinigen') then purge_user; 'Q': done := TRUE else Writeln(USR, 'lle, og-File, essage-File, ewin-File, ser-File, uit'); end; until (done) or (not online); end; { end of PICS2I.inc }