(* N *) (*$include:'SETDIR.INT'*) (*$include:'SETDOS.INT'*) (*$include:'SETGRAPH.INT'*) (**********************************************************************) (* Setcopy program for use with logcopy. Manages database that log *) (* copy reads in when invoked. *) (**********************************************************************) Program Setcopy(input,output); uses SETDIR,SETDOS,SETGRAPH; Const Program_name = 'SETCOPY version 3.00 by Keith P. Robison'; Copyright = 'copyright Syracuse University 1988'; data_drive = '^'; data_path = 'SYS:PUBLIC'; data_filename = data_drive*':LOG©.DAT'; max_programs = 100; program_name_length = 80; server_name_length = 48; VER = 'VeRsIoN=SETCOPY Version 3.00 by Keith P. Robison'*chr(0)*'$'; Type pointers_type = Array [1 .. max_programs] of Word; program_info = Record Copies : Byte; logit : Byte; name : Lstring(program_name_length); server : Lstring(server_name_length); End; programs_type = Array [1 .. max_programs] of program_info; Var pointer : pointers_type; info : programs_type; count : Integer; fout : file of byte; fin : file of byte; version : Lstring(80); logging : Boolean; Value version := VER; logging := FALSE; (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure cls; Begin scroll_screen_up(0,0,0,24,79,31); gotoxy(0,0); End; (* cls *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure key_press; Begin gotoxy(24,20); Write('Press ENTER to continue'); readln; End; (* key_press *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure upper_case(Var s : Lstring); Var i : Integer; Begin if s.len > 0 then for i:= 1 to ord(s.len) Do if (s[i] >= 'a') and (s[i] <= 'z') Then s[i]:=chr(ord(s[i])-32); End; (* upper_case *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure Calc_pointers; Var i : Integer; Begin pointer[1]:=wrd(count*2+2); if count > 1 Then for i:= 2 to count Do pointer[i]:=pointer[i-1]+3+info[i-1].name.len+1+ info[i-1].server.len; End; (* Calc_pointers *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure write_pointers; Var i : Integer; Begin if count > 0 Then for i:= 1 to count do write(fout,lobyte(pointer[i]),hibyte(pointer[i])); Write(fout,0,0); End; (* write_pointers *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure write_info; Var i,j : Integer; Begin for i:= 1 to count do Begin write(fout,info[i].copies,info[i].logit,info[i].name.len); if info[i].name.len > 0 Then for j:= 1 to ord(info[i].name.len) Do Write(fout,wrd(info[i].name[j])); write(fout,info[i].server.len); if info[i].server.len > 0 Then for j:= 1 to ord(info[i].server.len) Do Write(fout,wrd(info[i].server[j])); End; End; (* write_info *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure read_pointers; Var bl,bh : Byte; Begin count:=0; Repeat count:=count+1; Read(fin,bl,bh); pointer[count]:=byword(bh,bl); Until pointer[count] = 0; count:=count-1; End; (* read_pointers *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure read_info; Var i,j : Integer; b : Byte; Begin for i:= 1 to count Do Begin read(fin,info[i].copies,info[i].logit,info[i].name.len); if info[i].name.len > 0 Then for j:= 1 to ord(info[i].name.len) Do Begin read(fin,b); info[i].name[j]:=chr(b); End; read(fin,info[i].server.len); if info[i].name.len > 0 Then for j:= 1 to ord(info[i].server.len) Do Begin read(fin,b); info[i].server[j]:=chr(b); End; End; End; (* read_info *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure read_file; Var b : Byte; Begin assign(fin,data_filename); fin.trap:=TRUE; reset(fin); if fin.errs = 0 Then Begin read(fin,b); If b = 0 then logging:=TRUE Else if b = 255 then logging:=FALSE; read_pointers; read_info; close(fin); End; End; (* read_file *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure write_file; Var temp : Lstring(64); rc : Integer; Begin assign(fout,data_filename); fin.trap:=TRUE; rewrite(fout); if fout.errs = 0 Then Begin if logging then write(fout,0) Else write(fout,255); calc_pointers; write_pointers; write_info; close(fout); copylst(data_filename,temp); concat(temp,chr(0)); rc:=attrib(ads temp,128); End Else writeln('Unable to write file'); End; (* Write_file *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure initialize; Var rc : Integer; base : Integer; mask : integer; Begin rc:=net_alloc_temp_base(data_drive,0,data_path,base,mask); count:=0; End; (* initialize *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure add_item; Var ch : Char; Begin cls; count:=count+1; Write('Enter program name:'); readln(info[count].name); upper_case(info[count].name); Write('Log executions ? (Y/N):'); readln(ch); if ch in ['Y','y'] Then info[count].logit:=0 Else info[count].logit:=1; Write('Limited number of copies ? (Y/N) :'); readln(ch); if ch in ['Y','y'] Then Begin Write('How Many Copies:'); readln(info[count].copies); Write('Enter Server:'); readln(info[count].server); upper_case(info[count].server); End Else Begin info[count].copies:=0; info[count].server.len:=0; End; key_press; End; (* add_item *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure change_logging; Begin cls; gotoxy(12,10); if logging then Begin logging:=FALSE; Writeln('Default logging set to OFF'); End Else Begin logging:=TRUE; Writeln('Default logging set to ON'); End; key_press; End; (* change_logging *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure delete_item; Var item : Integer; i,j : Integer; Begin cls; Writeln; Write('Enter number of item to delete (0=Quit):'); Readln(item); if item > 0 then Begin if item <> count then for i:= item+1 to count do info[i-1]:=info[i]; count:=count-1; End; key_press; End; (* delete_item *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure list_items; Var i : Integer; temp : Lstring(80); Begin cls; Writeln; writeln('Item ',' ':20,'Program Name',' ':12,'Logging Copies Server'); for i:= 1 to 80 do temp[i]:='='; temp.len:=80; Write(temp); if count = 0 then writeln('File is empty or does not exist') Else for i:= 1 to count do Begin write(i:3,' | ',info[i].name:40,' |'); if info[i].logit = 1 then write(' OFF ') Else write(' ON '); If info[i].copies = 0 then write('| ALL ') Else write('| ',info[i].copies:3,' '); if info[i].server.len > 0 then write('| ',info[i].server) Else write('|'); Writeln; End; Write(temp); key_press; End; (* list_items *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure modify_item; Var ch : Char; item : Integer; i,j : Integer; temp : Lstring(80); Begin cls; Writeln; Write('Enter number of item to modify (0=Quit):'); Readln(item); if (item > 0) and (item <= count) then Begin write('Item ',' ':20,'Program Name',' ':12); writeln('Logging Copies Server'); for i:= 1 to 80 do temp[i]:='='; temp.len:=80; Write(temp); write(item:3,' | ',info[item].name:40,' |'); if info[item].logit = 1 then write(' OFF ') Else write(' ON '); If info[item].copies = 0 then write('| ALL ') Else write('| ',info[item].copies:3,' '); if info[item].server.len > 0 then write('| ',info[item].server) Else write('|'); Writeln; Write(temp); Writeln; Write('Enter program name [',info[item].name,']:'); readln(temp); if temp.len > 0 then copylst(temp,info[item].name); upper_case(info[item].name); Write('Log executions ? (Y/N) ['); if info[item].logit=0 then write('Y]:') Else write('N]:'); readln(temp); if temp.len > 0 then Begin ch:=temp[1]; if ch in ['Y','y'] Then info[item].logit:=0 Else info[item].logit:=1; End; Write('Limited number of copies ? (Y/N) ['); if info[item].copies > 0 then write('Y]:') Else write('N]:'); readln(temp); if temp.len > 0 then ch:=temp[1] Else Begin if info[item].copies > 0 then ch:= 'Y' Else ch:='N' End; if ch in ['Y','y'] Then Begin Write('How Many Copies [',info[item].copies:3,']:'); readln(temp); if temp.len > 0 then Begin if NOT decode(temp,info[item].copies) Then info[item].copies:=0; End; if info[item].copies > 0 Then Begin Write('Enter Server [',info[item].server,']:'); readln(temp); if temp.len > 0 then copylst(temp,info[item].server); while (info[item].server.len > 0 ) and (info[item].server[1]=' ') do delete(info[item].server,1,1); upper_case(info[item].server); End; End Else Begin info[item].copies:=0; info[item].server.len:=0; End; End; key_press; End; (* Modify_item *) (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure exit; Begin write_file; End; (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure quit; Begin End; (**********************************************************************) (* *) (* *) (**********************************************************************) Procedure menu; Var s : Lstring(1); ch : Char; Begin Repeat cls; Writeln(program_name); Writeln(copyright); Writeln; Writeln; Write('Default logging is '); if logging then Writeln('ON') Else Writeln('OFF'); Writeln; Writeln('A)dd a item'); Writeln('C)hanged default logging'); Writeln('D)elete an item'); Writeln('L)ist items'); Writeln('M)odify an item'); Writeln; Writeln('Q)uit and Do NOT update file'); Writeln('E)xit and update file'); Writeln; Write('Enter letter of choice :'); readln(s); If s.len > 0 then Begin ch := s[1]; writeln; Case ch of 'A','a' : add_item; 'C','c' : change_logging; 'D','d' : delete_item; 'E','e' : exit; 'L','l' : list_items; 'M','m' : modify_item; 'Q','q' : quit; otherwise; End; End; Until ch in ['q','Q','e','E'] End; (**********************************************************************) (* *) (* *) (**********************************************************************) Begin initialize; read_file; menu; End. (* O *)