{ PICS2G.INC - Pascal Integrated Communications System Overlays} { 5/25/87 Ver 1.6 Copyright 1987 by Les Archambault} overlay procedure toggle_printer; { Turn printer on and off } begin if printer_copy then printer_copy := FALSE else printer_copy := ask('Turn on printer'); write(USR, 'Printer o'); if printer_copy then writeln(USR, 'n.') else writeln(USR, 'ff.') end; overlay procedure process_newin; { Process and update newin file (add, delete, edit, hide, and release) } var ch, ch_sel: char; i,x,TmpDrv, TmpUsr,rec: integer; str: StrTAD; ed_descr,line: StrStd; temp_user_rec: user_list; fname,work:filename; found,none_found:boolean; begin fname:=''; none_found:=true; found:=false; rec:=0; line:=' |---------- File Description -----------------------------------------------|'; FindSect('NEWIN', TmpDrv, TmpUsr, OK); if OK then rec := pred(FileSize(nwin_file)) else writeln(USR, 'NEWIN section not found.'); writeln(usr); If (OK) and (rec<0) then if (ask('File Empty: Add first Record')) then with Nwin_rec do begin name := correct_fn(prompt('File name', 12, 'ES')); if name <> '' then begin while (length(name) - pos('.', name)) < 2 do name := name + '-'; writeln(USR, line); descr := prompt('', 75, 'EL'); GetTAD(date); user := user_loc; sectn:=get_section_name('D'); rec := FileSize(nwin_file); status := public; dnloads:=0; for x:=0 to 5 do last_dnload[x]:=0; rec:=0; seek(nwin_file,rec); write(nwin_file,nwin_rec); writeln(usr); writeln(usr,'First Record recorded.'); writeln(usr); end; end; if ok and (rec>=0) and ask('Search for File') then fname:=Prompt('Enter filename (wildcards ok) ',12,'ES'); if (fname<>' ') and (fname<>'') then fname:=expand_filename(fname); while Online and OK and (rec >= 0) and (not BRK) do with nwin_rec do begin if (fname='') or (fname<>' ') then begin seek(nwin_file, rec); read(nwin_file, nwin_rec); end else begin found:=false; while OK and (rec>=0) and (not found) and (not BRK) and online do begin seek(nwin_file,rec); read(nwin_file,nwin_rec); work:=expand_filename(name); if equal_names(fname,work) then begin found:=true; none_found:=false; end else rec:=pred(rec); end; if (not found) and (rec<0) then begin OK:=false; writeln(usr); if none_found then writeln(usr,'File not found in Newin listings.'); end; end; If ok then begin if (user>0) and (user<=FileLen(DatF)) then begin GetRec(DatF, user, temp_user_rec); if temp_user_rec.used<>0 then begin temp_user_rec.fn:='Purged'; temp_user_rec.ln:='User'; end; end else begin temp_user_rec.fn:='Unknown'; temp_user_rec.ln:='Sender'; end; writeln(USR); case status of private: write(USR, 'Hidden '); public: write(USR, 'Released '); deleted: write(USR, 'Deleted ') end; str := intstr(date[4],2)+'/'+intstr(date[3],2)+'/'+intstr(date[5],2); write(usr,pad(name,15),' Section: ',sectn,' ',str,' '); writeln(usr,temp_user_rec.fn, ' ', temp_user_rec.ln); str := intstr(last_dnload[4],2)+'/'+intstr(last_dnload[3],2)+'/'+intstr(last_dnload[5],2); writeln(usr,'Number downloads ',dnloads,' Last download ',str); writeln(usr,descr); repeat writeln(USR); st:=prompt('Newin command

',80, 'ES?'); if st=' ' then ch_sel:='S' else if length(st)=1 then ch_sel:=st[1] else ch_sel:='?'; case ch_sel of 'A': begin name := correct_fn(prompt('File name', 12, 'ES')); if name <> '' then begin while (length(name) - pos('.', name)) < 2 do name := name + '-'; writeln(USR, line); descr := prompt('', 75, 'EL'); GetTAD(date); user := user_loc; sectn:=get_section_name('L'); rec := FileSize(nwin_file); status := public; dnloads:=0; for x:=0 to 5 do last_dnload[x]:=0; end end; 'D': status := deleted; 'E': begin writeln(USR); if ask('Change File name') then name:=correct_fn(prompt('New File Name',12,'ES')); writeln(USR, line); write(usr,' '); ed_descr := descr; GetStr(ed_descr, ch, 75, 'E'); descr := ed_descr; writeln(usr); writeln(usr,'present Section ',sectn); if ask('change it') then sectn:=get_section_name('L'); writeln(USR); end; 'H': status := private; 'R': status := public; 'P': begin if (fname<>'') and (fname<>' ') then begin found:=false; if recdd, elete, dit, ide,

revious, elease, kip, uit') end; until (ch_sel in ['A','D','E','H','P','R','S','Q']) or (not online); if ch_sel in ['H', 'R'] then begin SetSect(homDrv, homUsr); {set up for loading overlay} hide_release(name, status,tmpdrv,tmpusr); SetSect(HomDrv, HomUsr); {re-set after using overlay} end; if ch_sel in ['A', 'D', 'E', 'H', 'R'] then begin seek(nwin_file, rec); write(nwin_file, nwin_rec); write(usr,'Newin Entry '); case ch_sel of 'A' : Writeln(usr,'Added.'); 'D' : Writeln(usr,'Deleted.'); 'E' : Writeln(usr,'Recorded.'); 'H' : Writeln(usr,'Marked Hidden.'); 'R' : Writeln(usr,'Marked Released.'); end; end; if (ch_sel<>'P') and (ch_sel<>'A') then rec := pred(rec); end; {ok} end; {while} end; overlay procedure toggle_audit; { Turn the audit trail on and off } var i, ext,space: integer; t: tad_array; AuditName,sect_name: FileName; done:boolean; this:sectptr; begin if audit_on then begin setsect(AudDrv,AudUsr); {$I-} Close(AuditFile); {$I+} if ioresult=0 then writeln(USR, 'Audit file closed.') else writeln(usr,'Possible Audit file problem. Audit OFF.'); audit_on := FALSE; setsect(homdrv,homusr); end else begin done:=false; this:=sectbase; while (this<>nil) and (this^.sectdrive<>AudDrv) and (this^.sectuser<>AudUsr) do this:=this^.next; if (this^.sectdrive=AudDrv) and (this^.sectuser=AudUsr) then sect_name:=this^.sectname else begin sect_name:='SYSTEM'; Auddrv:=homdrv; Audusr:=homusr; end; repeat Writeln(usr); Write(usr,'Audit File will be written to Section: ',sect_name,' '); Done:= (not Ask('Change it')); if (not done) then begin writeln(usr); sect_name:=get_section_name(' '); this:=sectbase; while (this<>nil) and (this^.sectname<>sect_name) do this:=this^.next; if this^.sectname=sect_name then begin Auddrv:=this^.sectdrive; Audusr:=this^.sectuser; end else begin Auddrv:=homdrv; Audusr:=homusr; end; end; until (not online) or done; GetTAD(t); ext := 0; setsect(AudDrv,Audusr); repeat AuditName := intstr(t[4], 2) + '-' + intstr(t[3], 2) + '-' + intstr(t[5], 2) + '.' + intstr(ext, 3); for i:= 1 to length(AuditName) do if AuditName[i] = ' ' then AuditName[i]:= '0'; Assign(AuditFile, AuditName); {$I-} Reset(AuditFile) {$I+}; { Make sure it's a new file } ext := succ(ext) until IOresult <> 0; Rewrite(AuditFile); setsect(homdrv,homusr); space:=diskfree(auddrv,audusr); writeln(USR, 'Audit file, ', AuditName, ', ready.'); writeln(usr,'There is currently ',space, 'K space available for the audit file.'); writeln(usr,'No further disk space checking will be performed.'); writeln(usr); audit_on := TRUE end end; Overlay Procedure Clear_Heaps; var thisM: MesgPtr; thisF,thisA: FilePtr; begin while DirBase <> nil do { Delete out directory linked list } begin thisF := DirBase; DirBase := DirBase^.Next; { Go to next on chain } dispose(thisF) { Reclaim space } end; while MesgBase <> nil do { Delete messages linked list} begin thisM := MesgBase; MesgBase := MesgBase^.next; { Go to next on list } dispose(thisM) { Reclaim space } end; while LibBase <> nil do { Delete out directory linked list } begin thisF := LibBase; LibBase := LibBase^.Next; { Go to next on chain } dispose(thisF) { Reclaim space } end; while ArcBase <> nil do { Delete out directory linked list } begin thisA := ArcBase; ArcBase := ArcBase^.Next; { Go to next on chain } dispose(thisA) { Reclaim space } end; end; { end of PICS2G.inc }