home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
OS2
/
RCOPY.ZIP
/
RCOPY.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-02-01
|
48KB
|
1 lines
/* RCOPY.CMD(C) V1.2 02/94 DEAN AMMONS ALL RIGHTS RESERVED */;'@ECHO OFF';parse arg rc_args;call RxFuncAdd 'SysLoadFuncs','RexxUtil','SysLoadFuncs';call SysLoadFuncs;rc=SETLOCAL();'set DELDIR=';do while chars()>0;c=charin();end;if rc_args='' | left(subword(rc_args,1,1),1)='/' | left(rc_args,1)='?' | right(rc_args,1)='?' then;do;rc_args=RCOPY_H(rc_args);if rc_args='' then;EXIT '';end;rc_args=rc_args||value('RCOPY',,'OS2ENVIRONMENT');orig_rc_args=rc_args;cur_dir=DIRECTORY();cur_dr=left(cur_dir,2);rc_loc=SysSearchPath('PATH','RCOPY.CMD');if rc_loc='' then;rc_loc=cur_dir;else;rc_loc=FILESPEC('drive',rc_loc)||FILESPEC('path',rc_loc);if left(subword(rc_args,1,1),1)<>'/' then;do;all_specs=translate(subword(rc_args,1,1));rc_args=subword(rc_args,2);all_specs=RMV_C_P(all_specs);if pos('/',all_specs)>0 then;do;rc_args=substr(all_specs,pos('/',all_specs))||rc_args;all_specs=left(all_specs,pos('/',all_specs)-1);end;i=1;h='';do while subword(all_specs,i,1)<>'';h2=subword(all_specs,i,1);i=i+1;if left(h2,1)='@' then;h=h||RD_RQ_FLE(substr(h2,2))||' ';else;h=h||h2||' ';end;all_specs=h;end;all_specs=strip(all_specs,'B',' ');if left(subword(rc_args,1,1),1)<>'/' & subword(rc_args,1,1)<>'' then;do;cpy_to_loc=translate(subword(rc_args,1,1));rc_args=subword(rc_args,2);if pos('/',cpy_to_loc)>0 then;do;rc_args=substr(cpy_to_loc,pos('/',cpy_to_loc))||rc_args;cpy_to_loc=left(cpy_to_loc,pos('/',cpy_to_loc)-1);end;end;else;cpy_to_loc=cur_dir;h='';do until l=0;l=pos('/PGM',translate(rc_args));if l>0 then;do;l2=pos('/',rc_args,l+1);if l2=0 then;l2=length(rc_args)+1;h=h||substr(rc_args,l,l2-l);rc_args=left(rc_args,l-1)||substr(rc_args,l2);end;end;do while pos(' ',h)>0;h=overlay('·',h,pos(' ',h));end;rc_args=rc_args||h;do while pos('/',rc_args)>0;rc_args=overlay(' ',rc_args,pos('/',rc_args));end;o_s_o='';a_pr='N';s_a='*****';ty_a='C';dir_cr='N';r_attr='N';o_d_t_d='N';c_tme.1='';c_tme.2='';c_dte.1='';c_dte.2='';row=0;tst='N';snd='Y';appnd='N';t_cmp='A';n_f_o='N';auto_r='N';pr_attr_a='Y';sh_dis='N';sh_dis2='N';u_f_o='N';e_f_o='N';frmt_d='N';rmv_e_d='N';asme_d_f='';sk_dps='N';c_sz.1='';c_sz.2='';r_dte='N';n_d_1st_d='N';n_e_asme_dir='N';v_op='N';m_in='N';mlt_dr='';sv_dup='N';lg_f='';e_t_dir='N';sk_d_cr_pr='N';o_dirs='';e_p=0;f_loc='';nf_loc='';i=1;w_t_s='N';wy_sk='N';sd_nbr=0;reset_ro='N';m_i_d=999;r_pg.0=0;s_f_fn=' ';rpc_f='';splt_sz=0;us_fls='N';a_f_s='N';f_splt=0;sel_fn='';us_fn=' ';l_o='N';splt_inprog='N';a_n_d='N';F3k='';no_dis_op='N';dsk_nbr=1;p_dsk_nbr=dsk_nbr;sup_tots='N';h_f_s='N';dltd=0;fls_p=0;bytes_c=0;fls_c=0;fls_o='';d_dirs=0;r_d_sp=512;do while subword(rc_args,i,1)<>'';o_prm='/'||strip(subword(rc_args,i,1),'T',',');o_prm=RMV_C_P(o_prm);i=i+1;rc_prm=translate(o_prm);if rc_prm='/AD' then;asme_d_f='D';if rc_prm='/AF' then;asme_d_f='F';if rc_prm='/AP' then;appnd=substr('YN',pos(appnd,'NY'),1);if rc_prm='/AN' then;a_n_d=substr('YN',pos(a_n_d,'NY'),1);if rc_prm='/AS' then;a_f_s=substr('YN',pos(a_f_s,'NY'),1);if rc_prm='/DEL' then;ty_a='D';if rc_prm='/DO' then;t_cmp=substr('OA',pos(t_cmp,'AO'),1);if rc_prm='/AFX' then;n_e_asme_dir=substr('YN',pos(n_e_asme_dir,'NY'),1);if rc_prm='/DC' then;dir_cr=substr('YN',pos(dir_cr,'NY'),1);if left(rc_prm,4)='/DR:' then;mlt_dr=substr(rc_prm,5);if rc_prm='/ED' then;e_t_dir=substr('YN',pos(e_t_dir,'NY'),1);if rc_prm='/FA' then;frmt_d=substr('YN',pos(frmt_d,'NY'),1);if rc_prm='/H' then;h_f_s=substr('YN',pos(h_f_s,'NY'),1);if rc_prm='/L' then;l_o=substr('YN',pos(l_o,'NY'),1);if rc_prm='/LG' then;if lg_f='' then;lg_f=rc_loc||'RCOPY.LOG';else;lg_f='';if left(rc_prm,4)='/LG:' then;do;lg_f=strip(substr(rc_prm,5),'T','\');if pos('.',lg_f)=0 then;lg_f=lg_f||'\RCOPY.LOG';if left(lg_f,1)='@' then;do;lg_f=substr(lg_f,2);rc=SysFileDelete(lg_f);end;end;if left(rc_prm,3)='/MU' then;do;m_in=substr('YN',pos(m_in,'NY'),1);if substr(rc_prm,4,1)=':' then;do;m_i_d=substr(rc_prm,5);if m_i_d<2 then;m_i_d=2;end;end;if left(rc_prm,3)='/PE' then;do;e_p=substr(rc_prm,4);if datatype(e_p,'whole number')<>1 then;e_p=99999;end;if rc_prm='/RD' then;r_dte=substr('YN',pos(r_dte,'NY'),1);if rc_prm='/RO' then;reset_ro=substr('YN',pos(reset_ro,'NY'),1);if rc_prm='/SA' then;sv_dup=substr('YN',pos(sv_dup,'NY'),1);if rc_prm='/SD' then;sh_dis=substr('YN',pos(sh_dis,'NY'),1);if rc_prm='/SD2' then;sh_dis2=substr('YN',pos(sh_dis2,'NY'),1);if left(rc_prm,5)='/#FP:' then;if datatype(substr(rc_prm,6),'whole number')=1 then;fls_p=substr(rc_prm,6);if left(rc_prm,5)='/#BC:' then;if datatype(substr(rc_prm,6),'whole number')=1 then;bytes_c=substr(rc_prm,6);if left(rc_prm,5)='/#FC:' then;if datatype(substr(rc_prm,6),'whole number')=1 then;fls_c=substr(rc_prm,6);if left(rc_prm,5)='/#ND:' then;if datatype(substr(rc_prm,6),'whole number')=1 then;do;sd_nbr=substr(rc_prm,6);if sd_nbr>0 then;dsk_nbr=sd_nbr;end;if rc_prm='/SE' then;sk_dps=substr('YN',pos(sk_dps,'NY'),1);if left(rc_prm,4)='/SF:' then;do;if datatype(substr(rc_prm,5),'whole number')=1 then;do;splt_sz=format(substr(rc_prm,5));if pos('.',splt_sz)>0 then;splt_sz=left(splt_sz,pos('.',splt_sz)-1);if splt_sz='' then;splt_sz=32;splt_sz=splt_sz*1024;end;end;if left(rc_prm,3)='/ST' & pos(':',rc_prm)>0 then;do;if substr(rc_prm,4,1)<>':' then;do;rds_disks=substr(rc_prm,4);rds_disks=left(rds_disks,pos(':',rds_disks)-1);end;if datatype(rds_disks,'whole number')<>1 then;rds_disks=99999;rc_prm=substr(rc_prm,pos(':',rc_prm)+1);if datatype(rc_prm,'whole number')=1 then;r_d_sp=r_d_sp+format(rc_prm);end;if rc_prm='/A' then;pr_attr_a=substr('YN',pos(pr_attr_a,'NY'),1);if rc_prm='/B' then;r_attr=substr('YN',pos(r_attr,'NY'),1);if rc_prm='/DF' then;o_d_t_d=substr('YN',pos(o_d_t_d,'NY'),1);if rc_prm='/DF2' then;n_d_1st_d=substr('YN',pos(n_d_1st_d,'NY'),1);if left(rc_prm,4)='/DD:' then;if datatype(substr(rc_prm,5),'whole number')=1 then;dltd=substr(rc_prm,5);if rc_prm='/BO' then;e_f_o=substr('YN',pos(e_f_o,'NY'),1);if rc_prm='/N' then;n_f_o=substr('YN',pos(n_f_o,'NY'),1);if rc_prm='/ND' then;no_dis_op=substr('YN',pos(no_dis_op,'NY'),1);if rc_prm='/NS' then;snd=substr('YN',pos(snd,'NY'),1);if rc_prm='/NT' then;sup_tots=substr('YN',pos(sup_tots,'NY'),1);if left(rc_prm,4)='/PGM' & pos(':',rc_prm)>0 then;do;F3k=61;if substr(rc_prm,5,1)<>':' then;do;fls_pp=substr(rc_prm,5);fls_pp=left(fls_pp,pos(':',fls_pp)-1);end;if datatype(fls_pp,'whole number')<>1 then;fls_pp=99999;l=r_pg.0+1;r_pg.0=l;r_pg.l=substr(o_prm,pos(':',o_prm)+1);if left(r_pg.l,1)='-' then;do;rpc_f='PGM.CMD';r_pg.l=substr(r_pg.l,2);rc=SysFileDelete(rpc_f);end;do while pos('·',r_pg.l)>0;r_pg.l=overlay(' ',r_pg.l,pos('·',r_pg.l));end;do while pos(']',r_pg.l)>0;r_pg.l=overlay('/',r_pg.l,pos(']',r_pg.l));end;do while pos(')',r_pg.l)>0;r_pg.l=overlay('>',r_pg.l,pos(')',r_pg.l));end;do while pos('(',r_pg.l)>0;r_pg.l=overlay('<',r_pg.l,pos('(',r_pg.l));end;do while pos('!',r_pg.l)>0;r_pg.l=overlay('|',r_pg.l,pos('!',r_pg.l));end;r_pg.l=fls_pp||' '||translate(subword(r_pg.l,1,1))||' '||subword(r_pg.l,2);end;if left(rc_prm,4)='/OF:' then;do;h=substr(rc_prm,5);if left(h,1)='@' then;h=RD_RQ_FLE(substr(h,2));fls_o=fls_o||' '||h;end;if left(rc_prm,4)='/OD:' then;do;h=substr(rc_prm,5);if left(h,1)='@' then;h=RD_RQ_FLE(substr(h,2));o_dirs=o_dirs||' '||h;end;if rc_prm='/P' then;a_pr=substr('YN',pos(a_pr,'NY'),1);if rc_prm='/R' then;auto_r=substr('YN',pos(auto_r,'NY'),1);if rc_prm='/RE' then;rmv_e_d=substr('YN',pos(rmv_e_d,'NY'),1);if rc_prm='/S' then;o_s_o=o_s_o||'S';if rc_prm='/T' then;tst=substr('YN',pos(tst,'NY'),1);if rc_prm='/U' then;u_f_o=substr('YN',pos(u_f_o,'NY'),1);if rc_prm='/US' then;us_fls=substr('YN',pos(us_fls,'NY'),1);if rc_prm='/V' then;v_op=substr('YN',pos(v_op,'NY'),1);if rc_prm='/WA' then;w_t_s=substr('YN',pos(w_t_s,'NY'),1);if rc_prm='/WY' then;wy_sk=substr('YN',pos(wy_sk,'NY'),1);if rc_prm='/M' then;ty_a='M';dh='';if left(rc_prm,3)='/D:' then;do;rc_prm=substr(rc_prm,4);if pos(left(rc_prm,1),'=()')=0 then;rc_prm='='||rc_prm;d=substr(rc_prm,2);if datatype(d,'whole number')=1 then;do;if left(rc_prm,1)=')' then;d='-'||d;dh=CMP_DTE(d);dha=left(rc_prm,1);if c_dte.1='' then;do;c_dte.1=dh;c_dte_a.1=dha;end;else;if c_dte.2='' then;do;c_dte.2=dh;c_dte_a.2=dha;end;end;end;th='';if left(rc_prm,3)='/T:' then;do;rc_prm=substr(rc_prm,4);if pos(left(rc_prm,1),'=()')=0 then;rc_prm='='||rc_prm;th=strip(substr(rc_prm,2),'L','0');if pos(':',th)=0 then;do;l=4-length(th);if l>0 then;th=center('',l,'0')||th;th=left(th,2)||':'||right(th,2);end;chk_h=left(th,pos(':',th)-1);chk_m=substr(th,pos(':',th)+1);chk_m=strip(chk_m,'T','P');chk_m=strip(chk_m,'T','A');if right(th,1)='P' & chk_h<12 then;chk_h=chk_h+12;th=chk_h||chk_m;tha=left(rc_prm,1);if datatype(th,'whole number')=1 then;if c_tme.1='' then;do;c_tme.1=th;c_tme_a.1=tha;end;else;if c_tme.2='' then;do;c_tme.2=th;c_tme_a.2=tha;end;end;sh='';if left(rc_prm,4)='/SZ:' then;do;rc_prm=substr(rc_prm,5);if pos(left(rc_prm,1),'=()')=0 then;rc_prm='='||rc_prm;sh=substr(rc_prm,2);sha=left(rc_prm,1);if datatype(sh,'whole number')=1 then;if c_sz.1='' then;do;c_sz.1=sh;c_sz_a.1=sha;end;else;if c_sz.2='' then;do;c_sz.2=sh;c_sz_a.2=sha;end;end;if left(rc_prm,4)='/IP:' then;f_loc=f_loc||substr(rc_prm,5)||' ';if left(rc_prm,5)='/IP-:' then;nf_loc=nf_loc||substr(rc_prm,6)||' ';end;EscK='27';EnterK='13';n_in_d=1;e_ok=1;fls_s=fls_p-fls_c;if pos('\',cpy_to_loc)=0 & pos(':',cpy_to_loc)=0 then;asme_d_f='F';if pos('\',cpy_to_loc)=0 & pos(':',cpy_to_loc)=0 then;cpy_to_loc=strip(cur_dir,'T','\')||'\'||cpy_to_loc;if left(cpy_to_loc,1)='\' then;cpy_to_loc=cur_dr||cpy_to_loc;if w_t_s='Y' then;call LOAD_DISKETTE left(cpy_to_loc,2);if a_f_s='Y' then;a_n_d='N';if l_o='Y' then;do;r_pg.0=1;r_pg.1='1';end;if asme_d_f='' & dir_cr='Y' then;asme_d_f='D';if no_dis_op='Y' then;do;sh_dis2='Y';sup_tots='Y';end;if sh_dis2='Y' then;sh_dis='Y';if v_op='Y' then;v_op=' /V';else;v_op='';if pos(left(cpy_to_loc,1),'AB')=0 then;frmt_d='N';if frmt_d='Y' then;do;o_d_t_d='N';n_d_1st_d='N';end;if n_d_1st_d='Y' then;o_d_t_d='Y';if e_f_o='Y' then;auto_r='Y';if lg_f<>'' then;do;rc=lineout(lg_f,' ',);call lineout lg_f, '**** RCOPY Started at '||left(time('N'),5)||' '||space(left(date('N'),6),0)||right(date('N'),2);call lineout lg_f, ' ';call lineout lg_f, ' RCOPY '||orig_rc_args;call lineout lg_f, ' ';end;if tst='Y' then;call D_MSG('N' 'N' center(' TEST RUN ONLY -- PROCESSING WILL BE SIMULATED ',78,'*'));if sd_nbr=0 & no_dis_op='N' then;do;call D_MSG('N' 'N' '┌───────────────────┐');call D_MSG('N' 'N' '│RCOPY(c) v1.2 02/94│');call D_MSG('N' 'N' '└───────────────────┘');end;if frmt_d='Y' then;call frmt_dISKETTE;rc=GET_DISKSPACE(left(cpy_to_loc,2));if right(cpy_to_loc,1)=':' then;do;cpy_to_loc=DIRECTORY(cpy_to_loc);call DIRECTORY(cur_dir);end;d_t_d=o_d_t_d;ed=0;if pos(right(cpy_to_loc,1),'\.')=0 then;call CHK_F_D;else;sk_d_cr_pr='Y';bse_cpy_to_loc=FILESPEC('drive',cpy_to_loc)||FILESPEC('path',cpy_to_loc);bse_cpy_to_fle=FILESPEC('name',cpy_to_loc);splt_to_loc=bse_cpy_to_loc;if bse_cpy_to_fle='NUL' & ty_a='M' then;ty_a='D';if bse_cpy_to_loc<>'' then;cpy_to_dir=bse_cpy_to_loc;cpy_to_dir_l=length(cpy_to_dir);if r_pg.0>0 then;ty_a='R';else;if us_fls='Y' | splt_sz>0 then;do;if us_fls='Y' then;splt_sz=0;ty_a='S';end;if ty_a='C' then;rmv_e_d='N';if pos('\',substr(cpy_to_loc,4))=0 then;dir_srch_criteria=strip(cpy_to_loc,'T','\')||'\';else;do;l=length(cpy_to_loc);do while l>0;if substr(cpy_to_loc,l,1)='\' then;do;dir_srch_criteria=left(cpy_to_loc,l);leave;end;l=l-1;end;end;appnd_fle_data='';fls_on_cur_disk=sd_nbr;tot_fls=fls_p;p_cpy_to_dir='';p_fle_loc='';do until m_in='N';tot_fs=1;nd='';checked_locs='';dis_cntr=0;new_dir_msg='';do while subword(all_specs,tot_fs,1)<>'';dr_tp=mlt_dr;fle_specs=subword(all_specs,tot_fs,1);if mlt_dr='' then;do;if pos('\',fle_specs)=0 then;fle_specs=strip(cur_dir,'T','\')||'\'||fle_specs;if left(fle_specs,1)='\' then;fle_specs=cur_dr||fle_specs;end;if substr(fle_specs,2,1)=':' then;do;if pos(left(fle_specs,1),dr_tp)=0 then;dr_tp=dr_tp||left(fle_specs,1);specs=substr(fle_specs,4);end;else;specs=fle_specs;if pos('S',o_s_o)>0 then;h=' (Sub-Directories Included)';else;h='';do s=1 to length(dr_tp);fle_specs=substr(dr_tp,s,1)||':\'||strip(specs,'L','\');if pos('S',o_s_o)>0 | pos('*',specs)>0 then;do;call D_MSG('Y' sh_dis 'Searching ==> '||fle_specs||h);if sh_dis='N' then;dis_cntr=dis_cntr+1;call SVE_CUR(sh_dis);end;if ty_a='S' & splt_sz=0 then;do;l=L_EXT(fle_specs);if substr(fle_specs,l,1)<>'.' | pos('*',fle_specs)>0 | pos('?',fle_specs)>0 then;do;call D_MSG('N' no_dis_op fle_specs||' - Invalid File Extension for UNSPLIT');tot_fs=tot_fs+1;leave;end;s_ext.0=tot_fs;s_ext.tot_fs=substr(fle_specs,l+1);fle_specs=left(fle_specs,l)||'*';end;rc=GET_DISKSPACE(left(fle_specs,2));Call SysFileTree fle_specs, 'fspecs.'||tot_fs||'.', 'F'||o_s_o, s_a;if rmv_e_d='Y' then;do l = length(fle_specs) to 1 by -1;if substr(fle_specs,l,1)='\' then;do;ed=ed+1;save_dir.ed=left(fle_specs,l-1);leave;end;end;tot_fls=tot_fls+fspecs.tot_fs.0;tot_fs=tot_fs+1;end;end;tot_fs=tot_fs-1;if tot_fs=0 then;do;e_ok=0;signal E_RC;end;cpy_to_srch_pattern='*.*';if tot_fs=1 then;do;if pos('?',fle_specs)=0 & pos('*',fle_specs)=0 & pos(right(fle_specs,1),':\')=0 & DIRECTORY(fle_specs)='' then;cpy_to_srch_pattern='';end;call PROCESS_FILES;if rmv_e_d='Y' then;call RMV_E_D;if ty_a='S' & s_f_fn<>'' then;do;if splt_sz>0 then;call SPLT_FLS;else;call UNSPLT_FLS;s_f_fn='';end;if n_in_d=m_i_d then;m_in='N';if m_in='Y' then;do;say center('',78,' ');h='Press <ENTER> after Inserting Diskette ';if m_i_d<>999 then;h=h||n_in_d+1||' of '||m_i_d;else;h=h||'#'||n_in_d+1;h=h||' or <ESC> to Terminate';say h;say;call SVE_CUR('N');if snd='Y' then;beep(524,250);do until subword(ikey,1,1)=EscK | subword(ikey,1,1)=EnterK;ikey=G_KY();end;call RET_CUR('3');if subword(ikey,1,1)=EscK then;m_in='N';else;do;n_in_d=n_in_d+1;e_t_dir='N';end;end;end;e_ok=0;signal E_RC;PROCESS_FILES:;if dis_cntr>0 then;do;if dis_cntr>row then;call SysCls;else;call RET_CUR(dis_cntr);dis_cntr=0;end;if d_t_d='Y' & tst='N' & n_d_1st_d='N' then;do;call DEL_T_DR;d_t_d='N';end;i=0;fsi=1;next_disk='N';byps_fle='Y';cur_dir_fls='';skip_dir='N';do forever;if chars()>0 then;call PR_PSE;i=i+1;if ((fls_c+fls_s)=tot_fls) then;leave;else;if i>fspecs.fsi.0 then;do;i=1;if fsi<=tot_fs then;do until fspecs.fsi.0>0 | fsi>tot_fs;fsi=fsi+1;end;if fsi>tot_fs then;do;if cur_dir_fls<>'' then;call PR_SEL_F;next_disk='Y';fsi=1;end;end;if fspecs.fsi.i='.'| fspecs.fsi.0=0 then;iterate;fspecs.fsi.i=space(fspecs.fsi.i);parse var fspecs.fsi.i fle_dte fle_tme fle_sz fle_attr fle_nme_full;fle_loc=FILESPEC('drive',fle_nme_full)||strip(FILESPEC('path',fle_nme_full),'T','\');if right(fle_loc,1)=':' then;fle_loc=fle_loc||'\';org_fl=fle_loc;fle_nme=FILESPEC('name',fle_nme_full);cur_splt_ext=0;fle_inf_msg=fle_nme;l=12-length(fle_inf_msg);if l>0 then;fle_inf_msg=fle_inf_msg||center('',l,' ');f=fle_sz;l=8-length(f);if l>0 then;f=center('',l,' ')||f;if substr(fle_dte,2,1)='/' then;fle_dte=' '||fle_dte;if substr(fle_tme,2,1)=':' then;fle_tme=' '||fle_tme;fle_inf_msg=fle_inf_msg||' '||f||' '||fle_dte||' '||fle_tme;if p_fle_loc<>fle_loc & cur_dir_fls<>'' then;do;call PR_SEL_F;i=i-1;iterate;end;if ty_a='S' & splt_sz=0 then;if pos('.',fle_nme)=0 | datatype(right(fle_nme,3),'whole number')<>1 then;do;call PR_WY_LN(fsi i 'Not Split File');iterate;end;if p_fle_loc<>fle_loc then;call PR_MSG_DIS 'N';okay='Y';if skip_dir='Y' then;okay='Dir Omitted';else;if h_f_s='N' & (substr(fle_attr,3,1)='H' | substr(fle_attr,5,1)='S') then;okay='System/Hidden';else;if pr_attr_a='N' & substr(fle_attr,1,1)<>'A' then;okay='Not Updated';else;do;if okay='Y' & f_loc<>'' then;call CHK_FND_L;if okay='Y' & nf_loc<>'' then;call CHK_NF_L;if okay='Y' & c_dte.1<>'' then;call CHK_DTE;if okay='Y' & c_tme.1<>'' then;call CHK_TME;if okay='Y' & c_sz.1<>'' then;call CHK_SZ;if okay='Y' & fls_o<>'' then;call CHK_F;end;if okay='Y' then;cur_dir_fls=cur_dir_fls||fsi||' '||i||' ';else;call PR_WY_LN(fsi i okay);end;return;CHK_F:;o=1;do while subword(fls_o,o,1)<>'' & okay='Y';h=BLD_CPY_T_FN(subword(fls_o,o,1));o=o+1;if fle_nme=h then;okay='File Omitted';end;return;CHK_FND_L:;o=1;do while subword(f_loc,o,1)<>'' & okay='Y';h=strip(subword(f_loc,o,1),'T','\')||'\'||fle_nme;o=o+1;Call SysFileTree h, 'chk_fls.', 'FO';if chk_fls.0=0 then;okay='Not Found/IP';end;return;CHK_NF_L:;o=1;do while subword(nf_loc,o,1)<>'' & okay='Y';h=strip(subword(nf_loc,o,1),'T','\')||'\'||fle_nme;o=o+1;Call SysFileTree h, 'chk_fls.', 'FO';if chk_fls.0>0 then;okay='Found/IP-';end;return;CHK_DTE:;d=fle_dte;do while pos('/',d)>0;d=overlay(' ',d,pos('/',d));end;parse var d mm dd yy;if length(mm)=1 then;mm='0'||mm;if length(dd)=1 then;dd='0'||dd;d=yy||mm||dd;do ii=1 to 2;if (okay='Y' & t_cmp='O' & ii=2) | c_dte.ii='' then;leave;if c_dte_a.ii='(' then;if d>=c_dte.ii then;okay='Too New';if c_dte_a.ii=')' then;if d<=c_dte.ii then;okay='Too Old';if c_dte_a.ii='=' then;if c_dte.ii<>d then;okay='Unequal Date';end;return;CHK_TME:;t=translate(fle_tme);chk_h=left(t,pos(':',t)-1);chk_m=substr(t,pos(':',t)+1);chk_m=left(chk_m,length(chk_m)-1);if right(t,1)='P' & chk_h<12 then;chk_h=chk_h+12;t=chk_h||chk_m;do ii=1 to 2;if (okay='Y' & t_cmp='O' & ii=2) | c_tme.ii='' then;leave;if c_tme_a.ii='(' then;if t>=c_tme.ii then;okay='Too New';if c_tme_a.ii=')' then;if t<=c_tme.ii then;okay='Too Old';if c_tme_a.ii='=' then;if c_tme.ii<>t then;okay='Unequal Time';end;return;CHK_SZ:;do ii=1 to 2;if (okay='Y' & t_cmp='O' & ii=2) | c_sz.ii='' then;leave;if c_sz_a.ii='(' then;if fle_sz>=c_sz.ii then;okay='Too Large';if c_sz_a.ii=')' then;if fle_sz<=c_sz.ii then;okay='Too Small';if c_sz_a.ii='=' then;if c_sz.ii<>fle_sz then;okay='Unequal Size';end;return;PR_SEL_F:;sel_cntr=0;org_fl='';do until subword(cur_dir_fls,sel_cntr,1)='';sel_cntr=sel_cntr+1;if subword(cur_dir_fls,sel_cntr,1)='' then;leave;sel1=subword(cur_dir_fls,sel_cntr,1);sel_cntr=sel_cntr+1;sel2=subword(cur_dir_fls,sel_cntr,1);byps_fle='N';dupe_copy='N';if chars()>0 then;call PR_PSE;parse var fspecs.sel1.sel2 fle_dte fle_tme fle_sz fle_attr fle_nme_full;if org_fl='' then;do;fle_loc=FILESPEC('drive',fle_nme_full)||strip(FILESPEC('path',fle_nme_full),'T','\');if right(fle_loc,1)=':' then;fle_loc=fle_loc||'\';org_fl=fle_loc;if dltd<0 then;do;fle_loc=DR_D(fle_loc dltd);if length(fle_loc)=3 then;fle_loc='';end;if dir_cr='Y' then;do;h=strip(strip(bse_cpy_to_loc,'T','\')||substr(fle_loc,3),'T','\')||'\';if bse_cpy_to_fle<>'' then;h=h||bse_cpy_to_fle;if cpy_to_loc<>h then;do;nd='';cpy_to_loc=h;cpy_to_dir=FILESPEC('drive',cpy_to_loc)||FILESPEC('path',cpy_to_loc);if cpy_to_dir<>'' then;do;cpy_to_dir_l=length(cpy_to_dir);if dltd>0 then;cpy_to_dir=DR_D(cpy_to_dir dltd);end;end;if bse_cpy_to_loc<>'' & ty_a='S' then;splt_to_loc=FILESPEC('drive',cpy_to_loc)||FILESPEC('path',cpy_to_loc);end;end;fle_nme=FILESPEC('name',fle_nme_full);chk_fle_sz=fle_sz+r_d_sp;cur_splt_ext=0;fle_inf_msg=fle_nme;l=12-length(fle_inf_msg);if l>0 then;fle_inf_msg=fle_inf_msg||center('',l,' ');f=fle_sz;l=8-length(f);if l>0 then;f=center('',l,' ')||f;if substr(fle_dte,2,1)='/' then;fle_dte=' '||fle_dte;if substr(fle_tme,2,1)=':' then;fle_tme=' '||fle_tme;fle_inf_msg=fle_inf_msg||' '||f||' '||fle_dte||' '||fle_tme;if bse_cpy_to_fle<>'' then;cpy_to_fle=BLD_CPY_T_FN(bse_cpy_to_fle);else;cpy_to_fle=fle_nme;if next_disk='Y' then;do;disk_space=GET_DISKSPACE(left(cpy_to_loc,2));call LOAD_NEXT_DISK;if byps_fle='Y' then;iterate;end;if p_cpy_to_dir<>cpy_to_dir then;do;p_cpy_to_dir=cpy_to_dir;if e_t_dir='Y' & tst='N' then;'del '||cpy_to_dir||'*.* /F/N 1>nul 2>nul';end;if pos(ty_a,'DSM')>0 & fle_nme='EA DATA. SF' then;do;call PR_WY_LN(sel1 sel2 'System File');iterate;end;if pos(ty_a,'DRS')=0 then;if fle_nme_full=strip(cpy_to_dir,'T','\')||'\'||cpy_to_fle then;do;call PR_WY_LN(sel1 sel2 "Can't Copy to Itself");iterate;end;fle_fnd='N';if pos(ty_a,'DRS')=0 then;do;Call SysFileTree cpy_to_dir||cpy_to_fle, 'chk_fls.', 'F', s_a;if chk_fls.0>0 then;do;chk_fls.1=space(chk_fls.1);parse var chk_fls.1 fle_d fle_t fle_s . fle_nme_f;fle_fnd='Y';end;end;if (e_f_o='Y' & fle_fnd<>'Y') then;do;call PR_WY_LN(sel1 sel2 'Not Both');iterate;end;if fle_fnd='Y' then;do;if n_f_o='Y' then;do;call PR_WY_LN(sel1 sel2 'Not New');iterate;end;if fle_d=fle_dte & fle_t=fle_tme & fle_s=fle_sz then;do;msg1='Exact';dupe_copy='Y';if sk_dps='Y' then;do;call PR_WY_LN(sel1 sel2 'Duplicate');iterate;end;end;else;msg1='A';if dupe_copy='Y' then;if u_f_o='Y' then;do;call PR_WY_LN(sel1 sel2 'Not Newer');iterate;end;msg1=msg1||' copy of '||cpy_to_fle||' already exists--';msg2='Current: '||fle_d||' '||fle_t||' ('||fle_s||') ';msg2=msg2||'Copy: '||fle_dte||' '||fle_tme||' ('||fle_sz||')';end;else;do;msg2=' '||fle_dte||' '||fle_tme||' ('||fle_sz||')';fle_s=0;fle_d='';fle_t='';end;if byps_fle='N' & pos(ty_a,'DRS')=0 & cur_splt_ext=0 & tst='N' then;do;call CHECK_DISK_SPACE;if byps_fle='Y' then;iterate;end;if byps_fle='N' & nd='' & pos(ty_a,'DR')=0 then;do;call CHECK_DIRECTORY;if dir_error='Y' then;nd=c_t_d;if byps_fle='Y' then;iterate;end;if p_fspec=fle_loc & p_fspec<>'' then;if pos('Processing ==> ',SysTextScreenRead(1,0))=0 then;do;p_fspec='';call PR_MSG_DIS 'Y';end;if byps_fle='N' then;if p_to_spec<>cpy_to_dir | p_fspec<>fle_loc | new_dir_msg<>'' then;do;if pos(ty_a,'DR')=0 then;do;h=strip(cpy_to_dir,'T','\');if right(h,1)=':' then;h=h||'\';if ty_a='S' then;do;if splt_sz>0 then;h='..Split To ==> '||h;else;h='UnSplit To ==> '||h;end;else;if ty_a='M' then;h='...Move To ==> '||h;else;h='...Copy To ==> '||h;call D_MSG('N' sh_dis h||new_dir_msg);end;else;if sh_dis='Y' & org_fl<>cur_dir then;call D_MSG('Y' no_dis_op 'Processing ==> '||org_fl||center('',63-length(org_fl),' '));p_to_spec=cpy_to_dir;p_fspec=fle_loc;new_dir_msg='';end;if (fle_fnd='Y' & u_f_o='Y') | cur_splt_ext>0 | byps_fle='Y' | (sv_dup='Y' & a_pr='N') then;NOP;else;if fle_fnd='Y' & a_pr='N' & auto_r='N' & pos(ty_a,'DRS')=0 then;do;say;say msg1;say msg2;say '<R>eplace <N>o Action <C>ontinuous Replace <Escape>?';call SVE_CUR('N');do until pos(subword(ikey,2,1),'RNC')>0 | subword(ikey,1,1)=EscK;if snd='Y' then;beep(524,250);ikey=G_KY();end;call RET_CUR('4');if subword(ikey,1,1)=EscK then;signal E_RC;if subword(ikey,2,1)='N' then;do;fls_s=fls_s+1;fspecs.sel1.sel2='.';byps_fle='Y';end;if subword(ikey,2,1)='C' then;auto_r='Y';end;else;if a_pr='Y' then;do;if pos(ty_a,'DSR')>0 then;do;if pos(ty_a,'SR')>0 then;t='Select ';else;t='Delete ';end;else;do;if ty_a='M' then;t= 'Move ';else;t= 'Copy ';h2='<Y>es <N>o <C>ontinuous '||h||'<Escape>?';end;h=t||fle_nme||'?';h2='<Y>es <N>o <C>ontinuous '||t||'<Escape>?';l=78-length(h);cntr=3;say;if fle_fnd='Y' then;do;say msg1;say msg2;cntr=cntr+2;end;if l>0 then;h=h||center('',l,' ');say h;if fle_fnd='N' then;do;say msg2;cntr=cntr+1;end;say h2;call SVE_CUR('N');do until pos(subword(ikey,2,1),'YNC')>0 | subword(ikey,1,1)=EscK;if snd='Y' then;beep(524,250);ikey=G_KY();end;call RET_CUR(cntr);if subword(ikey,1,1)=EscK then;signal E_RC;if subword(ikey,2,1)='N' then;do;fls_s=fls_s+1;fspecs.sel1.sel2='.';byps_fle='Y';end;if subword(ikey,2,1)='C' then;do;auto_r='Y';a_pr='N';end;end;if tst='N' & byps_fle<>'Y' & pos(ty_a,'MDR')>0 then;if reset_ro='Y' & substr(fle_attr,4,1)='R' then;'attrib -R "'||fle_nme_full||'" 1>nul 2>nul';process_rc=0;if byps_fle='Y' then;f_a_msg='*Bypassed';else;if ty_a='R' then;f_a_msg='*Selected';else;if ty_a='S' then;do;if splt_sz>0 then;f_a_msg='*Split Into '||format(((fle_sz/splt_sz)+.5),,0)||' Files';else;f_a_msg='*UnSplit';end;else;if ty_a='D' then;f_a_msg='*Deleted';else;if ty_a='M' then;f_a_msg='*Moved-';else;f_a_msg='*Copied-';fspecs.sel1.sel2='.';if p_dsk_nbr<>dsk_nbr then;do;call D_MSG('N' sh_dis 'Disk #'||dsk_nbr);fls_on_cur_disk=0;p_dsk_nbr=dsk_nbr;end;fls_p=fls_p+1;fle_inf_msg=' '||fls_p||'. '||fle_inf_msg||' ';call D_MSG('Y' no_dis_op fle_inf_msg);call SVE_CUR(no_dis_op);col=length(fle_inf_msg);if byps_fle='N' then;do;if h_f_s='Y' & (substr(fle_attr,3,1)='H' | substr(fle_attr,5,1)='S') then;'attrib -S -H "'||fle_nme_full||'" 1>nul 2>nul';if sv_dup='Y' & fle_fnd='Y' & appnd<>'YY' then;do;fle_fnd='N';if tst='N' then;call REN_CPY_T_FLE cpy_to_dir||cpy_to_fle;end;if dir_error='Y' then;process_rc=-1;else;do;if ty_a='R' then;do;sel_fn=sel_fn||fle_nme||' ';s_f_fn=s_f_fn||fle_nme_full||' ';end;else;if ty_a='S' & splt_sz>0 then;do;if pos(' '||fle_nme_full||' ',s_f_fn)=0 then;s_f_fn=s_f_fn||fle_nme_full||' ';end;else;if ty_a='S' & splt_sz=0 then;do;l=L_EXT(fle_nme_full);if pos(' '||left(fle_nme_full,l),s_f_fn)=0 then;s_f_fn=s_f_fn||fle_nme_full||'+'||sel1||' ';end;else;if ty_a='D' then;do;if tst='N' then;process_rc=SysFileDelete(fle_nme_full);end;else;if ty_a='C' | left(fle_nme_full,1)<>left(cpy_to_dir,1) | right(fle_nme_full,3)='DLL' | left(appnd,1)='Y' then;call CPY_FLE;else;call MVE_FLE;if h_f_s='Y' & (substr(fle_attr,3,1)='H' | substr(fle_attr,5,1)='S') then;do;'attrib +S +H "'||fle_nme_full||'" 1>nul 2>nul';if pos(ty_a,'MC')>0 then;'attrib +S +H "'||cpy_to_dir||cpy_to_fle||'" 1>nul 2>nul';end;end;if process_rc<>0 then;fle_fnd='X';else;if left(appnd,1)='Y' then;do;appnd_fle_data=chk_fle.1;auto_r='Y';end;if fle_fnd<>'X' & cur_splt_ext=0 & tst='N' & pos(ty_a,'DRS')=0 then;do;Call SysFileTree cpy_to_dir||cpy_to_fle, 'chk_fle.', 'FO';if chk_fle.0=0 then;fle_fnd='X';end;if fle_fnd='X' then;do;if ty_a='D' then;f_a_msg='*Delete FAILED';else;if ty_a='M' then;f_a_msg='*Move FAILED';else;f_a_msg='*Copy FAILED';fls_s=fls_s+1;if process_rc>0 then;do;if ty_a='D' & process_rc=5 & substr(fle_attr,4,1)='R' then;f_a_msg=f_a_msg||' - Read Only';else;f_a_msg=f_a_msg||' RC='||process_rc;end;end;else;If pos(ty_a,'DSR')>0 then;NOP;else;if fle_fnd='N' & appnd<>'YY' then;f_a_msg=f_a_msg||'New';else;if left(appnd,1)='Y' then;do;f_a_msg=f_a_msg||'Appended';appnd='YY';end;else;if dupe_copy='Y' then;f_a_msg=f_a_msg||'Duplicate';else;f_a_msg=f_a_msg||'Replaced';if cpy_to_fle<>fle_nme & pos(ty_a,'DRS')=0 then;f_a_msg=f_a_msg||' ('||cpy_to_fle||')';end;if fle_fnd='X' | byps_fle='Y' then;do;if no_dis_op='N' & row>0 then;rc=SysCurPos(row-1,col);call D_MSG('Y' no_dis_op f_a_msg);if lg_f<>'' then;call D_MSG('N' 'Y' fle_inf_msg||f_a_msg);iterate;end;fls_c=fls_c+1;fls_on_cur_disk=fls_on_cur_disk+1;bytes_c=bytes_c+fle_sz;if ty_a='C' then;do;if r_attr='Y' & tst='N' & process_rc=0 then;'attrib -A "'||fle_nme_full||'" 1>nul 2>nul';end;else;if ty_a='M' & process_rc=0 then;do;if left(fle_nme_full,1)<>left(cpy_to_dir,1) | right(fle_nme_full,3)='DLL' | left(appnd,1)='Y' | cur_splt_ext>0 then;do;if tst='N' then;do;rc=SysFileDelete(fle_nme_full);if rc<>0 then;f_a_msg='*Copied-'||substr(f_a_msg,8);end;end;end;if pos(ty_a,'DRS')=0 & tst='N' then;if substr(fle_attr,4,1)='R' then;'attrib +R "'||cpy_to_dir||cpy_to_fle||'" 1>nul 2>nul';if r_dte='Y' then;'copy "'||cpy_to_dir||cpy_to_fle||'" /B + ,, "'||cpy_to_dir||cpy_to_fle||'" 1>nul 2>nul';if no_dis_op='N' & row>0 then;rc=SysCurPos(row-1,col);if cur_splt_ext>0 then;f_a_msg=f_a_msg||' ('||strip(cur_splt_ext,'L','0')||' Split Files)';call D_MSG('Y' no_dis_op f_a_msg);if lg_f<>'' then;call D_MSG('N' 'Y' fle_inf_msg||f_a_msg);end;cur_dir_fls='';return;PR_MSG_DIS:;parse arg suppress_log;p_fle_loc=fle_loc;h=substr(fle_loc,3);o=1;skip_dir='N';do while subword(o_dirs,o,1)<>'' & skip_dir='N';h2=substr(subword(o_dirs,o,1),pos(':',subword(o_dirs,o,1))+1);o=o+1;if right(h2,1)='\' then;l=length(h);else;l=length(h2);if strip(h2,'T','\')=left(h,l) then;skip_dir='Y';end;if skip_dir='Y' then;h='Bypassing ';else;h='Processing ';call D_MSG(suppress_log sh_dis h||'==> '||org_fl||center('',63-length(org_fl),' '));if rmv_e_d='Y' then;do;ed=ed+1;save_dir.ed=strip(org_fl,'T','\');end;return;PR_WY_LN:;parse arg s1 s2 why_msg;fls_s=fls_s+1;fspecs.s1.s2='.';if wy_sk='Y' then;do;sp=center('',length(fls_p)+3,' ');call D_MSG('N' no_dis_op sp||fle_inf_msg||' *Skipped-'||why_msg);end;return;CPY_FLE:;if tst='Y' | cur_splt_ext>0 then;return;if left(appnd,1)='Y' & fle_fnd='Y' then;'copy "'||cpy_to_dir||cpy_to_fle||'"+"'||fle_nme_full||'"'||v_op||' 1>nul 2>nul';else;if fle_sz=0 then;do;if right(cpy_to_dir,2)<>':\' then;h=strip(cpy_to_dir,'T','\');else;h=cpy_to_dir;'xcopy "'||fle_nme_full||'" '||h||v_op||' 1>nul 2>nul';end;else;'copy "'||fle_nme_full||'" "'||cpy_to_dir||cpy_to_fle||'"'||v_op||' 1>nul 2>nul';process_rc=rc;return;MVE_FLE:;if tst='Y' | cur_splt_ext>0 then;return;if fle_fnd='Y' then;rc=SysFileDelete(cpy_to_dir||cpy_to_fle);if fle_fnd='N' | (fle_fnd='Y' & rc=0) then;do;if left(cur_dir,1)<>left(fle_nme_full,1) then;call DIRECTORY(left(fle_nme_full,3));'move "'||substr(fle_nme_full,3)||'" "'||substr(cpy_to_dir,3)||cpy_to_fle||'" 1>nul 2>nul';if left(cur_dir,1)<>left(fle_nme_full,1) then;call DIRECTORY(cur_dir);end;process_rc=rc;return;CHK_F_D:;if DIRECTORY(cpy_to_loc)<>'' then;do;call DIRECTORY(cur_dir);cpy_to_loc=strip(cpy_to_loc,'T','\')||'\';return;end;Call SysFileTree cpy_to_loc, 'chk_fle.', 'F', s_a;fle_nme=FILESPEC('name',cpy_to_loc);if (pos('.',fle_nme)>0 & n_e_asme_dir='Y') | chk_fle.0>0 | pos('*',fle_nme)>0 | pos('?',fle_nme)>0 then;NOP;else;if asme_d_f='D' then;cpy_to_loc=strip(cpy_to_loc,'T','\')||'\';else;do;if asme_d_f<>'F' then;do;say;say 'Is "'||fle_nme||'" A <F>ile or <D>irectory?';call SVE_CUR('N');do until pos(subword(ikey,2,1),'FD')>0;if snd='Y' then;beep(524,250);ikey=G_KY();if subword(ikey,1,1)=EscK then;signal E_RC;end;call RET_CUR('2');end;if subword(ikey,2,1)='F' | asme_d_f='F' then;NOP;else;cpy_to_loc=strip(cpy_to_loc,'T','\')||'\';end;return;BLD_CPY_T_FN: PROCEDURE EXPOSE fle_nme;parse arg n_s .;do while pos('?',n_s)>0;l=pos('?',n_s);if l>1 then;n_s=left(n_s,l-1)||substr(fle_nme,l,1)||substr(n_s,l+1);else;n_s=substr(fle_nme,l,1)||substr(n_s,l+1);end;l=L_EXT(fle_nme);if substr(fle_nme,l,1)='.' then;do;cn.1=left(fle_nme,l-1);cn.2=substr(fle_nme,l);end;else;cn.2='';l=L_EXT(n_s);if substr(n_s,l,1)='.' then;do;fn.1=left(n_s,l-1);fn.2=substr(n_s,l);end;else;fn.2=cn.2;if fn.1='' | fn.1='*' then;fn.1=cn.1;data=fn.1;do s=1 to 2;do while pos('*',fn.s)>0;l=pos('*',fn.s)-1;if pos('*',fn.s,l+2)>0 then;do;fn.s=overlay(substr(cn.s,l+1,1),fn.s,l+1);iterate;end;if l=0 then;do;fn.s=substr(fn.s,2);fn.s=left(cn.s,length(cn.s)-length(fn.s))||fn.s;end;else;do;fn.s=left(fn.s,l);if length(cn.s)>l then;fn.s=fn.s||substr(cn.s,l+1);end;end;end;return fn.1||fn.2;RMV_E_D:;p_root_dir='';call D_MSG('N' no_dis_op ' ');call D_MSG('N' no_dis_op 'Removing Empty Directories');call SVE_CUR(no_dis_op);do i=1 to ed;if p_root_dir=save_dir.i then;iterate;if left(p_root_dir,1)<>left(save_dir.i,1) then;call DIRECTORY(left(save_dir.i,3));p_root_dir=save_dir.i;Call SysFileTree save_dir.i||'\*.*', 'chk_dir.', 'DSO';do ii=chk_dir.0 to 1 by -1;if tst='N' then;if SysRmDir(chk_dir.ii)=0 then;d_dirs=d_dirs+1;end;if tst='N' & length(save_dir.i)>3 then;if SysRmDir(save_dir.i)=0 then;d_dirs=d_dirs+1;end;call RET_CUR('2');call DIRECTORY(cur_dir);return;REN_CPY_T_FLE: PROCEDURE;parse arg req_fle .;cd=DIRECTORY();call DIRECTORY(left(req_fle,3));l=L_EXT(req_fle);if substr(req_fle,l,1)='.' then;do;ext=substr(req_fle,l+1,1);r_f=left(req_fle,l-1);end;else;ext='';c=0;do until chk_fls.0=0;c=c+1;if c<10 then;e=ext||'0'||c;else;e=ext||c;s_fle=r_f||'.'||e;Call SysFileTree s_fle, 'chk_fls.', 'F';if chk_fls.0=0 & c=99 then;do;rc=SysFileDelete(s_fle);leave;end;end;'MOVE "'||substr(req_fle,3)||'" "'||substr(s_fle,3)||'" 1>nul 2>nul';call DIRECTORY(cd);return;DEL_T_DR:;if pos(left(cpy_to_loc,1),'AB')=0 then;do;if snd='Y' then;beep(524,250);say center('',78,' ');say 'All Files/Directories in '||left(cpy_to_loc,2)||' Will Be Deleted. OKAY (Y/N)?';say;call SVE_CUR('N');do until pos(subword(ikey,2,1),'YN')>0 | subword(ikey,1,1)=EscK;ikey=G_KY();end;call RET_CUR('3');if subword(ikey,2,1)='N' then;signal E_RC;end;call DIRECTORY(left(cpy_to_loc,3));call D_MSG('N' no_dis_op 'Deleting All Files on '||left(cpy_to_loc,2));call SVE_CUR(no_dis_op);Call SysFileTree left(cpy_to_loc,3)||'*.*', 'fspecs.sel1.', 'DS';Do i = fspecs.sel1.0 to 1 by -1;if chars()>0 then;do;ikey=G_KY();if subword(ikey,1,1)=EscK then;signal E_RC;end;dir_name=subword(fspecs.sel1.i,5);'attrib -R -H -S '||strip(dir_name,'T','\')||'\*.* 1>nul 2>nul';Call SysFileTree strip(dir_name,'T','\')||'\*.*' , 'db2.', 'F';if db2.0>0 then;'del '||strip(dir_name,'T','\')||'\*.* /n/f 1>nul 2>nul';rc=SysRmDir(dir_name);end;if chars()>0 then;do;ikey=G_KY();if subword(ikey,1,1)=EscK then;signal E_RC;end;'attrib -R -H -S '||left(cpy_to_loc,3)||'*.* 1>nul 2>nul';'if exist "'||left(cpy_to_loc,3)||'EA DATA. SF" attrib +R +H +S "'||left(cpy_to_loc,3)||'EA DATA. SF"';Call SysFileTree left(cpy_to_loc,3)||'*.*' , 'db2.', 'F','**---';if db2.0>0 then;'del '||left(cpy_to_loc,3)||'*.* /n/f 1>nul 2>nul';call DIRECTORY(cur_dir);call RET_CUR('1');return;CMP_DTE: PROCEDURE;arg r_dte;do while pos('-',r_dte)>0;r_dte=overlay(' ',r_dte,pos('-',r_dte));end;do while pos('/',r_dte)>0;r_dte=overlay(' ',r_dte,pos('/',r_dte));end;r_dte=space(r_dte,0);if r_dte='' then;r_dte=substr(date('S'),3);else;if left(r_dte,1)='+' | left(r_dte,1)='-' then;do;dir=left(r_dte,1);r_dte=substr(r_dte,2);end;do i = 1 to length(r_dte);if pos(substr(r_dte,i,1),'0123456789')=0 then;r_dte='';end;if length(r_dte)<5 then;r_dte=CMP_DTE_DAYS(r_dte);return r_dte;CMP_DTE_DAYS: PROCEDURE;arg n_d;if dir='+' then;f=1;else;f=-1;n_j_d=date('D')+(n_d*f);n_j_y=substr(date('S'),3,2);if pos('.',n_j_y/4)>0 then;m_d=365;else;m_d=366;do while n_j_d<1 | n_j_d>m_d;n_j_y=n_j_y+f;if pos('.',n_j_y/4)>0 then;m_d=365;else;m_d=366;n_j_d=m_d-(n_j_d*f);end;l=3-length(n_j_d);if l>0 then;n_j_d=center('',l,'0')||n_j_d;return CMP_G(n_j_y||n_j_d);CMP_G: PROCEDURE;arg r_j_dt2;r_j_yr=format(substr(r_j_dt2,1,2));r_c_j_d=format(substr(r_j_dt2,3,3));if pos('.',r_j_yr/4)>0 then;f='28';else;f='29';m_d='31 '||f||' 31 30 31 30 31 31 30 31 30 31';g_m=0;g_d=0;do until r_c_j_d<1;g_m=g_m+1;if g_m=13 then;do;g_m=1;r_j_yr=r_j_yr+1;end;d=subword(m_d,g_m,1);if (r_c_j_d-d)<1 then;g_d=r_c_j_d;r_c_j_d=r_c_j_d-d;end;l=2-length(g_m);if l>0 then;g_m=center('',l,'0')||g_m;l=2-length(g_d);if l>0 then;g_d=center('',l,'0')||g_d;return r_j_yr||g_m||g_d;SPLT_FLS:;i=1;do while subword(s_f_fn,i,1)<>'';fle_nme_full=subword(s_f_fn,i,1);fle_sz=chars(fle_nme_full);chk_fle_sz=fle_sz;i=i+1;l=L_EXT(fle_nme_full);if substr(fle_nme_full,l,1)='.' then;fle_nme=left(fle_nme_full,l-1);else;fle_nme=f;fle_nme=splt_to_loc||FILESPEC('name',fle_nme);byps_fle='N';cpy_to_loc=left(fle_nme,3);call CHECK_DISK_SPACE;if byps_fle='Y' then;do;call D_MSG('N' no_dis_op 'Not Enough Disk Space to Split '||fle_nme_full);iterate;end;if tst='N' then;do s=0 to 10;'if exist '||fle_nme||'.'||s||'*'||' del '||fle_nme||'.'||s||'* 1>nul 2>nul';end;call D_MSG('N' sh_dis ' ');call D_MSG('N' sh_dis 'Splitting the File '||fle_nme_full);call SVE_CUR(sh_dis);s=1;cntr=0;do while chars(fle_nme_full)>0;if chars()>0 then;call PR_PSE;if s=1 then;do;l=fle_sz/splt_sz;if l<=1 | l>999 then;leave;end;if tst='Y' then;do;cntr=format(((fle_sz/splt_sz)+.5),,0);leave;end;cntr=cntr+1;l=3-length(cntr);if l>0 then;cntr=center('',l,'0')||cntr;new_fle_nme=fle_nme||'.'||cntr;call GET_CHRS(s splt_sz fle_nme_full new_fle_nme);s=s+splt_sz;rc=stream(new_fle_nme,'C','CLOSE');end;call RET_CUR('2');f_splt=f_splt+cntr;if tst='N' then;rc=stream(fle_nme_full,'C','CLOSE');end;return;;UNSPLT_FLS:;i=1;do while subword(s_f_fn,i,1)<>'';fle_nme_full=subword(s_f_fn,i,1);l=pos('+',fle_nme_full);fs=substr(fle_nme_full,l+1);fle_nme_full=left(fle_nme_full,l-1);i=i+1;l=L_EXT(fle_nme_full);if substr(fle_nme_full,l,1)='.' then;fle_nme=left(fle_nme_full,l-1);else;fle_nme=fle_nme_full;j_fle=fle_nme||'.'||s_ext.fs;j_fle=splt_to_loc||FILESPEC('name',j_fle);cpy_to_loc=left(j_fle,3);if pos(' '||j_fle,us_fn)=0 then;do;h='Creating';us_fn=us_fn||j_fle||' ';if tst='N' then;rc=SysFileDelete(j_fle);end;else;h='Updating';call D_MSG('N' sh_dis ' ');call D_MSG('N' sh_dis h||' the File '||j_fle);call SVE_CUR(sh_dis);Call SysFileTree fle_nme||'.*', 'flst.','FO';db.0=flst.0;f=' ';do ii=1 to flst.0;ext=right(flst.ii,3);if datatype(ext,'whole number')<>1 | pos('.',ext)>0 then;iterate;ext=strip(ext,'L','0');db.ext=flst.ii;f=f||ext||' ';if ext>db.0 then;db.0=ext;end;drop(flst.);cntr=0;do ii=1 to db.0;if chars()>0 then;call PR_PSE;if tst='Y' | pos(' '||ii||' ',f)=0 then;iterate;cntr=cntr+1;fle_nme_full=db.ii;fle_sz=chars(fle_nme_full);byps_fle='N';call CHECK_DISK_SPACE;if byps_fle='Y' then;leave;s=1;do until s>=fle_sz;h=charin(fle_nme_full,s,1000000);s=s+1000000;rc=charout(j_fle,h);end;rc=stream(fle_nme_full,'c','close');end;call RET_CUR('2');if byps_fle='Y' then;call D_MSG('N' no_dis_op 'Not Enough Disk Space to UnSplit '||fle_nme_full);rc=stream(j_fle,'c','close');drop(db.);end;return;CHECK_DISK_SPACE:;disk_space=GET_DISKSPACE(left(cpy_to_loc,2));if fle_fnd='Y' then;disk_space=disk_space+fle_s;if (disk_space-r_d_sp)<1 & ty_a<>'S' then;call LOAD_NEXT_DISK;else;if chk_fle_sz>disk_space then;byps_fle='Y';return;LOAD_NEXT_DISK:;strt_pos=1;cur_splt_ext=0;splt_inprog='N';fs_hold=fle_sz;do until splt_inprog='N' & disk_space>(fle_sz+r_d_sp);if splt_inprog='N' & a_f_s='Y' then;do;call SPLIT_FOR_DISK;if byps_fle='Y' then;signal E_RC;end;say center('',78,' ');c=5;t='<N>=New Disk ';h='N';if splt_inprog='Y' then;do;say 'Not Enough Diskspace for the Split File '||next_n_fn;t=t||' <ESC>=Quit';end;else;do;say 'Not Enough Diskspace for the file '||fle_nme_full;if a_n_d='N' then;do;if disk_space>1000 then;do;h=h||'BS';t=t||' <B>=Bypass File <S>=Split File <ESC>=Quit';end;else;do;h='BN';t=t||' <B>=Bypass File <ESC>=Quit';end;end;end;say 'Required: '||FORMAT_NUM(chk_fle_sz)||' Available: '||FORMAT_NUM(disk_space);ikey='';if splt_inprog='Y' | a_n_d='Y' then;c=3;else;do;say;say t;if snd='Y' then;beep(524,250);do until subword(ikey,1,1)=EscK | subword(ikey,1,1)=EnterK | pos(subword(ikey,2,1),h)>0;ikey=G_KY();end;call SVE_CUR('N');call RET_CUR(c);c=0;end;if pos(subword(ikey,2,1),'N')>0 | splt_inprog='Y' | a_n_d='Y' then;do;h='';t='Insert New Diskette in Drive '||left(bse_cpy_to_loc,2)||' and Press <ENTER> to Continue';t2='';if frmt_d='N' then;do;t2=t2||' or <F> to Format New Disk';h=h||'F';end;if o_d_t_d='N' then;do;t2=t2||' or <D> to Delete all Files on New Disk';h=h||'D';end;say;say t;c=c+2;if t2<>'' then;do;say t2;c=c+1;end;if pos('D',h)=0 & subword(ikey,2,1)<>'F' then;do;say 'ALL FILES ON NEW DISKETTE WILL BE DELETED BEFORE PROCESSING CONTINUES';c=c+1;end;if pos('F',h)=0 then;do;say 'NEW DISKETTE WILL BE FORMATTED BEFORE PROCESSING CONTINUES';c=c+1;end;if snd='Y' then;beep(524,250);do until subword(ikey,1,1)=EscK | subword(ikey,1,1)=EnterK | pos(subword(ikey,2,1),h)>0;ikey=G_KY();end;call SVE_CUR('N');call RET_CUR(c);end;if subword(ikey,1,1)=EscK then;do;if splt_inprog='Y' then;rc=stream(full_fle_nme,'c','close');signal E_RC;end;if pos(subword(ikey,2,1),'SB')=0 & fls_on_cur_disk>0 then;dsk_nbr=dsk_nbr+1;if subword(ikey,2,1)='B' then;do;fls_s=fls_s+1;fspecs.sel1.sel2='.';byps_fle='Y';return;end;if subword(ikey,2,1)='F' | (frmt_d='Y' & subword(ikey,2,1)<>'S') then;call frmt_dISKETTE;if subword(ikey,2,1)='D' then;d_t_d='Y';else;d_t_d=o_d_t_d;checked_locs='';next_disk='N';nd='';if d_t_d='Y' & pos(subword(ikey,2,1),'SF')=0 then;do;if tst='N' then;call DEL_T_DR;d_t_d='N';end;if subword(ikey,2,1)='S' | splt_inprog='Y' then;do;call SPLIT_FOR_DISK;if byps_fle='Y' then;signal E_RC;end;disk_space=GET_DISKSPACE(left(cpy_to_loc,2));end;fle_sz=fs_hold;if dsk_nbr>rds_disks then;r_d_sp=512;return;frmt_dISKETTE:;do until rc=0;call D_MSG('N' no_dis_op 'Formatting Drive '||left(cpy_to_loc,2));call SVE_CUR(no_dis_op);if tst='Y' then;leave;'FORMAT '||left(cpy_to_loc,2)||' /ONCE/V:RCOPY 1>nul 2>nul';if rc<>0 then;do;call RET_CUR('1');call D_MSG('N' no_dis_op ' ');call D_MSG('N' no_dis_op 'Formatting Drive '||left(cpy_to_loc,2)||' FAILED');call LOAD_DISKETTE left(cpy_to_loc,2) 'Y';call RET_CUR('4');end;end;call RET_CUR('1');return;SPLIT_FOR_DISK:;splt_inprog='Y';call CHECK_DIRECTORY;if byps_fle='Y' then;return;fn=cpy_to_loc||cpy_to_fle;l=L_EXT(fn);if substr(fn,l,1)='.' then;fn=left(fn,l-1);disk_space=GET_DISKSPACE(left(cpy_to_loc,2));if (fle_sz+r_d_sp)<disk_space then;fs=fle_sz;else;fs=disk_space;cur_splt_ext=cur_splt_ext+1;l=3-length(cur_splt_ext);if l>0 then;cur_splt_ext=center('',l,'0')||cur_splt_ext;n_fn=fn||'.'||cur_splt_ext;call D_MSG('N' sh_dis ' ');call D_MSG('N' sh_dis 'Creating Split File '||n_fn||' ('||FORMAT_NUM(fs)||' bytes)');call D_MSG('N' sh_dis ' From '||fle_nme_full);call SVE_CUR(sh_dis);call GET_CHRS(strt_pos fs fle_nme_full n_fn);strt_pos=strt_pos+fs;disk_space=disk_space-fs;fls_on_cur_disk=fls_on_cur_disk+1;if tst='N' then;rc=stream(n_fn,'c','close');fle_sz=chars(fle_nme_full);chk_fle_sz=fle_sz;if fle_sz=0 then;do;splt_inprog='N';rc=stream(full_fle_nme,'c','close');end;next_n_fn=cur_splt_ext+1;l=3-length(next_n_fn);if l>0 then;next_n_fn=center('',l,'0')||next_n_fn;next_n_fn=fn||'.'||next_n_fn;f_splt=f_splt+1;call RET_CUR('3');return;GET_DISKSPACE:;parse arg dr;parse value SysDriveInfo(dr) with . ds .;if ds='' then;if pos(left(dr,1),'AB')>0 then;ds=LOAD_DISKETTE(dr);else;ds=-1;return ds;LOAD_DISKETTE:;parse arg dr nds;say '';say 'Place Diskette in Drive '||dr||' and Press <Enter> to Continue or <Esc> to Quit';call SVE_CUR('N');do until ds<>'';if snd='Y' then;beep(524,250);ikey=G_KY();if subword(ikey,1,1)=EscK then;signal E_RC;if nds='Y' then;leave;ds=GET_DISKSPACE(dr);end;w_t_s='N';call RET_CUR('2');return ds;CHECK_DIRECTORY:;dir_error='N';c_t_d=strip(cpy_to_dir,'T','\');fnd=VER_DIR(c_t_d);if fnd='Y' then;return;if splt_inprog='N' then;do;nbr_sd=0;do l = 4 to length(cpy_to_dir);if substr(cpy_to_dir,l,1)='\' then;nbr_sd=nbr_sd+1;end;chk_fle_sz=chk_fle_sz+(nbr_sd*512);call CHECK_DISK_SPACE;chk_fle_sz=chk_fle_sz-(nbr_sd*512);if byps_fle='Y' then;return;end;if dir_cr='N' & a_pr='N' & splt_inprog='N' & sk_d_cr_pr='N' then;do;if snd='Y' then;beep(524,250);say center('',78,' ');say 'The Directory '||c_t_d||' Does Not Exist. Create it (Y/N)?';call SVE_CUR('N');do until pos(subword(ikey,2,1),'YN')>0 | subword(ikey,1,1)=EscK;ikey=G_KY();end;call RET_CUR('2');if subword(ikey,1,1)=EscK then;signal E_RC;if subword(ikey,2,1)='N' then;do;dir_error='Y';return;end;end;parse value MAKE_DIR(c_t_d||'\') with dir_error cd;if dir_error='Y' then;return;nd=c_t_d;new_dir_msg=' (Directory Created)';return;MAKE_DIR: PROCEDURE EXPOSE checked_locs tst cur_dir;parse arg req_dir .;dir=req_dir;do l=4 to length(req_dir);if substr(req_dir,l,1)='\' then;do;dir=left(req_dir,l-1);if VER_DIR(dir)='N' then;do;if tst='N' then;if SysMkDir(dir)<>0 then;return 'Y';checked_locs=checked_locs||dir||';';end;end;end;call DIRECTORY(cur_dir);return 'N' dir;VER_DIR:;parse upper arg check_loc;if pos(check_loc||';',checked_locs)>0 then;return 'Y';cd=DIRECTORY(check_loc);if cd='' then;return 'N';checked_locs=checked_locs||check_loc||';';return 'Y';GET_CHRS: PROCEDURE EXPOSE tst;parse arg strt_p g_sz g_fle p_fle;do until g_sz<1;if g_sz<1000000 then;g=g_sz;else;g=1000000;d=charin(g_fle,strt_p,g);strt_p=strt_p+g;g_sz=g_sz-g;if tst='N' then;rc=charout(p_fle,d);end;return;FORMAT_NUM: PROCEDURE;parse arg n;if pos('.',n)>0 then;n=left(n,pos('.',n)-1);n=strip(n,'L','0');if n='' then;n=0;if length(n)<4 then;return n;h='';i=length(n)-2;do forever;h=','||substr(n,i,3)||h;if i<4 then;leave;i=i-3;end;if i>1 then;h=left(n,i-1)||h;return strip(h,'B',',');RMV_C_P: PROCEDURE;parse arg r_d .;do while pos(',',r_d)>0;r_d=overlay(' ',r_d,pos(',',r_d));end;do while pos('+',r_d)>0;r_d=overlay(' ',r_d,pos('+',r_d));end;return r_d;RD_RQ_FLE: PROCEDURE;parse arg r_f;r='';do while lines(r_f);h=linein(r_f);if left(h,1)<>':' then;r=r||h||' ';end;rc=stream(r_f,'c','close');return strip(r,'T',' ');E_RC:;if ty_a='S' then;do;if splt_sz=0 then;do;us_fn=strip(us_fn,'B',' ');i=1;do while subword(us_fn,i,1)<>'';i=i+1;end;fls_c=i-1;end;else;fls_c=f_splt;end;call D_MSG('N' sup_tots center('',78,' '));if n_in_d>1 then;n_in_d='from '||n_in_d||' Diskettes ';else;n_in_d='';if ty_a='R' then;t='Selected ';else;if ty_a='S' then;t='Created ';else;t='Processed ';call D_MSG('N' sup_tots t||FORMAT_NUM(fls_c)||' Files '||n_in_d||'Containing '||FORMAT_NUM(bytes_c)||' Characters.');if fls_s>0 then;call D_MSG('N' sup_tots 'Skipped '||FORMAT_NUM(fls_s)||' Files. ');if d_dirs>0 then;call D_MSG('N' sh_dis2 'Removed '||FORMAT_NUM(d_dirs)||' Directories. ');if datatype(r_pg.0,'whole number')<>1 then;signal E_RC2;lf='';max_prm=1000;if lg_f<>'' then;do;lf=' >>'||lg_f;max_prm=max_prm-3-length(lg_f);end;do sub=1 to r_pg.0;fls_pp=subword(r_pg.sub,1,1);r_pg.sub=subword(r_pg.sub,2);if strip(r_pg.sub)='' then;iterate;if lf<>'' then;do;l=pos('>',r_pg.sub);if l>0 then;r_pg.sub=strip(left(r_pg.sub,l-1),'T',' ');end;c_fn='$';l=pos('$',r_pg.sub);if l=0 then;do;l=pos('#',r_pg.sub);c_fn='#';end;i=1;do while subword(s_f_fn,i,1)<>'';if chars()>0 then;do;call PR_PSE 'Y';if subword(ikey,1,1)=EscK then;do;sub=r_pg.0;leave;end;end;if i=1 then;do;call D_MSG('N' sh_dis2 ' ');if l=0 then;t=' without Selected Files';else;if fls_pp=1 then;t=' for Each File Selected';else;if fls_pp=99999 then;t=' with Selected Files';else;t=' for Every '||FORMAT_NUM(fls_pp)||' Selected Files';if rpc_f<>'' then;call D_MSG('N' sh_dis2 'Save to '||rpc_f||' an execution of "'||r_pg.sub||lf||'"');else;call D_MSG('N' sh_dis2 'Executing "'||r_pg.sub||lf||'"');call D_MSG('N' sh_dis2 t);call D_MSG('N' sh_dis2 ' ');end;h2='';do ii=1 to fls_pp;if c_fn='$' then;fn=subword(s_f_fn,i,1);else;fn=subword(sel_fn,i,1);if length(r_pg.sub)+length(h2)+length(fn)>max_prm then;leave;h2=h2||fn||' ';i=i+1;end;if l=0 then;do;h=r_pg.sub;i=999999;ii=fls_pp;end;else;do;do while pos('%',h)>0;h=left(h,pos('%',h)-1)||left(subword(h2,1,1),2)||substr(h,pos('%',h)+1);end;if pos('{',h)>0 then;do;cd=substr(subword(h2,1,1),3);if substr(h,pos('{',h)-1,1)=':' then;dr=substr(h,pos('{',h)-2,2);else;dr='';parse value MAKE_DIR(dr||cd) with dir_error cd;h=left(h,pos('{',h)-1)||substr(cd,length(dr)+1)||substr(h,pos('{',h)+1);end;do while pos(c_fn,h2)>0;h2=overlay('·',h2,pos(c_fn,h2));end;h=r_pg.sub;do while pos(c_fn,h)>0;h=left(h,pos(c_fn,h)-1)||strip(h2,'T',' ')||substr(h,pos(c_fn,h)+1);end;do while pos('·',h)>0;h=overlay(c_fn,h,pos('·',h));end;end;if tst='N' then;if rpc_f<>'' then;call lineout rpc_f,h||lf;else;do;if lf<>'' then;rc=stream(lg_f,'c','close');'call '||h||lf;end;end;if rpc_f<>'' then;rc=stream(rpc_f,'c','close');end;E_RC2:;if tst='Y' then;do;call D_MSG('N' 'N' '');call D_MSG('N' 'N' center(' TEST RUN ONLY -- NO CHANGES ACTUALLY OCCURRED ',78,'*'));end;call D_MSG('N' sup_tots center('',78,' '));do i=1 to e_p;if i=1 then;say 'Press any key when ready . . .';call syssleep 1;if chars()>0 then;leave;end;call DIRECTORY(cur_dir);rc=ENDLOCAL();if lg_f<>'' then;do;call lineout lg_f, '**** RCOPY Ended at '||left(time('N'),5);call lineout lg_f, ' ';rc=stream(lg_f,'c','close');end;EXIT e_ok fls_c dsk_nbr fls_p bytes_c;PR_PSE:;parse upper arg sk_e .;say;h='* Press Any Key to Continue or <ESC> to Terminate';if F3k<>'' then;h=h||' (<F3> for /PGM Requests)';say h||' *';call SVE_CUR('N');ikey=G_KY();ikey=G_KY();call RET_CUR('2');if (subword(ikey,1,1)=EscK | subword(ikey,1,1)=F3k) & sk_e<>'Y' then;do;if subword(ikey,1,1)=EscK then;r_pg.0='';signal E_RC;end;return;D_MSG: PROCEDURE EXPOSE lg_f;parse arg s_l s_d m_d;if s_d='N' then;say m_d;if lg_f<>'' & s_l='N' then;call lineout lg_f,m_d;return;G_KY: PROCEDURE;parse value SysGetKey('NOECHO') With k;kn=c2d(k);if kn=224 | kn=0 then;do;parse value SysGetKey('NOECHO') With k;kn=kn+c2d(k);end;do while chars()>0;c=charin();end;return kn translate(k);SVE_CUR:;parse arg sk .;if sk='N' then;parse value SysCurPos() With row col;return;RET_CUR: PROCEDURE EXPOSE row no_dis_op;parse arg n_l .;if no_dis_op='N' & row>0 then;do;rc=SysCurPos(row-n_l,0);do blk_line=1 to n_l;say center('',78,' ');end;rc=SysCurPos(row-n_l,0);end;return;DR_D: PROCEDURE;parse arg d l_t_d;h=left(d,2);d=substr(d,3);do i=1 to ABS(l_t_d);l=pos('\',d,2);if l=0 then;leave;d=substr(d,l);end;return h||d;L_EXT: PROCEDURE;parse arg fn;do l=length(fn) to length(fn)-3 by -1;if pos(substr(fn,l,1),':\.')>0 | l=1 then;leave;end;return max(l,1);
