home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_ATV.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  24.7 KB  |  639 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   ECO_ATV was conceived, designed and written      ░░▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor Naaijkens for                           ░░▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) 1992 by EUROCON PANATIONAL CORPORATION       ░░▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved by The ECO Group.            ░░▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓   ECO_ATV is a unit that makes using archives      ░░▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓   entirely transparant to the application.         ░░▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓   viewing, deleting, moving and adding included!   ░░▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓
  21.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  22.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  23.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  24. *)
  25. {$M 65520, 0, 655360}
  26. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  27. unit eco_atv;
  28.  
  29. interface 
  30.  
  31. uses 
  32.   dos, eco_lib,  eco_cfi,
  33.   eco_swap
  34.  
  35.   ;
  36.  
  37.  
  38. const
  39.   viewer : string[12] = 'FCV.COM';
  40.  
  41.  
  42. type
  43.   cfgtype = record
  44.     applic_f, applic_b, 
  45.     applic_h,
  46.     x1, y1, x2, y2      : byte;
  47.   end;
  48.  
  49.   optiontype = (o_unpak, o_delete, o_nothing);
  50.  
  51.   arcpanelobj = object
  52.     ful, quit,
  53.     showmem,
  54.     showreads,
  55.     complete_error : boolean;
  56.     treewidth,
  57.     status,
  58.     error          :    word;
  59.     cfg            : cfgtype;
  60.     mfree          : longint;
  61.     nulstr, archer,
  62.     olddir         : pathstr;
  63.     wst            :  string;
  64.     {=Internal===============================================================}
  65.     function __pak_tv(arc: pathstr; var opt: optiontype): boolean;
  66.     {=External===============================================================}
  67.     function __atv(arcname: pathstr): boolean;
  68.   end; { arcpanelobj }
  69.  
  70.  
  71.  
  72. implementation
  73.  
  74.  
  75.  
  76.  
  77.  
  78.   function arcpanelobj.__pak_tv(arc: pathstr; var opt: optiontype): boolean;
  79.   type
  80.     str80 = string[80];
  81.     tvrec = record
  82.       st  : string[69];
  83.       pad :    pathstr;
  84.       so,
  85.       sp  :    longint;
  86.     end;
  87.  
  88.   var
  89.     fname           :                    str79;
  90.     arc_content     : array[1..5120] of ^tvrec;
  91.     pak_tv_arc      :                     text;
  92.     nam, ext,
  93.     s, ss, fpad,
  94.     fnam, fext,
  95.     pak_entry,
  96.     pak_entry2      :                   string;
  97.     cur, off,
  98.     key, i,
  99.     tagged,
  100.     nrtags,
  101.     count           :                     word;
  102.     numm, numl      :                     byte;
  103.     ifnext          :                  boolean;
  104.     taglen,
  105.     tagsiz          :                  longint;
  106.     strt            :                     char;
  107.     oldscn          :             _scnimageptr;
  108.  
  109.  
  110.  
  111.     function convertdate(long : longint) : string;
  112.     var
  113.       temp,temp2 : string[9];
  114.       date       : datetime;
  115.  
  116.     begin
  117.       with date do begin
  118.         temp := '';
  119.         unpacktime(long,date);
  120.         str(day,temp2);
  121.         if day < 10 then temp2 := '0'+temp2;
  122.         temp := temp + temp2 + '-';
  123.         temp2 := copy(_strmonths[month], 1, 3);
  124.         temp := temp + temp2 + '-';
  125.         year := year - 1900;
  126.         str(year,temp2);
  127.         if year < 10 then temp2 := '0'+temp2;
  128.         temp := temp + temp2;
  129.       end;
  130.       convertdate := temp;
  131.     end;
  132.  
  133.  
  134.     function converttime(long : longint) : string;
  135.     var
  136.       temp,temp2 : string[8];
  137.       time       : datetime;
  138.  
  139.     begin
  140.       with time do begin
  141.         temp := '';
  142.         unpacktime(long,time);
  143.         str(hour,temp2);
  144.         if hour < 10 then temp2 := '0' + temp2;
  145.         temp := temp + temp2 + ':';
  146.         str(min,temp2);
  147.         if min < 10 then temp2 := '0' + temp2;
  148.         temp := temp + temp2;
  149.       end;
  150.       converttime := temp;
  151.     end;
  152.  
  153.  
  154.     function compressed_type(attrib : byte) : string;
  155.     begin
  156.       case attrib of
  157.         1..2: compressed_type := 'SEA stored';
  158.         3   : compressed_type := 'SEA packed';
  159.         4   : compressed_type := 'SEA Squeezed';
  160.         5..8: compressed_type := 'SEA Crunched';
  161.         9   : compressed_type := 'PKWare (old) Squashed';
  162.         10  : compressed_type := 'NoGate Crushed';
  163.         11  : compressed_type := 'NoGate Destilled';
  164.         45  : compressed_type := 'Nogate archive-comment';
  165.         46  : compressed_type := 'Nogate file-comment';
  166.         47  : compressed_type := 'Nogate file path';
  167.         48  : compressed_type := 'Nogate Security enveloppe';
  168.         49  : compressed_type := 'Nogate Error correction';
  169.  
  170.         50  : compressed_type := 'ZIP (local header) Stored';
  171.         51  : compressed_type := 'ZIP (local header) Shrunk';
  172.         52  : compressed_type := 'ZIP (local header) Reduced-1';
  173.         53  : compressed_type := 'ZIP (local header) Reduced-2';
  174.         54  : compressed_type := 'ZIP (local header) Reduced-3';
  175.         55  : compressed_type := 'ZIP (local header) Reduced-4';
  176.         56  : compressed_type := 'ZIP (local header) Imploded';
  177.         80  : compressed_type := 'ZIP (central header) Stored';
  178.         81  : compressed_type := 'ZIP (central header) Shrunk';
  179.         82  : compressed_type := 'ZIP (central header) Reduced-1';
  180.         83  : compressed_type := 'ZIP (central header) Reduced-2';
  181.         84  : compressed_type := 'ZIP (central header) Reduced-3';
  182.         85  : compressed_type := 'ZIP (central header) Reduced-4';
  183.         86  : compressed_type := 'ZIP (central header) Imploded';
  184.         99  : compressed_type := 'ZIP End_of_central directory';
  185.  
  186.         100 : compressed_type := 'ZOO Stored';
  187.         101 : compressed_type := 'ZOO LWZ compression';
  188.         150 : compressed_type := 'ZOO (deleted) Stored';
  189.         151 : compressed_type := 'ZOO (deleted) LWZ compression';
  190.  
  191.         170 : compressed_type := 'MD  Stored';
  192.         171 : compressed_type := 'MD  LZH13';
  193.         179 : compressed_type := 'MD  Unknown';
  194.  
  195.         180 : compressed_type := 'LBR Header';
  196.         181 : compressed_type := 'LBR stored';
  197.  
  198.         190 : compressed_type := 'ARJ Stored';
  199.         191 : compressed_type := 'ARJ Method 1';
  200.         192 : compressed_type := 'ARJ Method 2';
  201.         193 : compressed_type := 'ARJ Method 3';
  202.         194 : compressed_type := 'ARJ Method 4';
  203.  
  204.         200 : compressed_type := 'LZH stored';
  205.         201 : compressed_type := 'LZH LZHufman';
  206.         205 : compressed_type := 'LZH -lzh5-';
  207.  
  208.         230 : compressed_type := 'LZH/LZS -lz0-';
  209.         231 : compressed_type := 'LZH/LZS -lz1-';
  210.         232 : compressed_type := 'LZH/LZS -lz2-';
  211.         233 : compressed_type := 'LZH/LZS -lz3-';
  212.         234 : compressed_type := 'LZH/LZS -lz4-';
  213.         235 : compressed_type := 'LZH/LZS -lz5-';
  214.  
  215.         249 : compressed_type := 'LZH/LZS -lz?-';
  216.         250 : compressed_type := 'DWC stored';
  217.         251 : compressed_type := 'DWC crunched';
  218.         else compressed_type := 'Unknown';
  219.       end;
  220.     end;
  221.  
  222.  
  223.     procedure write_items;
  224.     var 
  225.       i, j :   word;
  226.  
  227.     begin
  228.       with cfg do begin
  229.         if y2-y1-4<count then j := y2-y1-4 else j := count;
  230.         for i := 1 to j do with cfg do begin
  231.           wst := __packfil(arc_content[i+off]^.pad, 6); 
  232.           wst := copy(wst, 3, length(wst)-2); wst := ' ' + copy(wst, 1, 6);
  233.           __write(x1+1, y1+2+i, applic_f, applic_b,
  234.             copy(arc_content[i+off]^.st, 1, x2-x1-1) + 
  235.             __juststr(wst, ' ', 6, _left_just_str)
  236.           )
  237.         end;
  238.       end;
  239.     end;
  240.  
  241.  
  242.  
  243.     function __chkkey: word;
  244.     begin
  245.       if keypressed then __chkkey := __retkey else __chkkey := $0000;
  246.     end;
  247.  
  248.  
  249.  
  250.   begin
  251.     ful := true; quit := false; complete_error := false;
  252.     with cfg do begin
  253.       ext := __extractext(arc); ext := __cvtstr(ext, _to_upcase_str);
  254.       archer := 'ARJ.EXE';
  255.       if ext = 'ARC' then archer := 'ARC.EXE';
  256.       if ext = 'LZH' then archer := 'LHA.EXE';
  257.       if ext = 'ZOO' then archer := 'ZOO.EXE';
  258.       if ext = 'ZIP' then archer := 'ZIP.EXE'; { this doesn't work }
  259.       new(oldscn); __savscn(oldscn); tagged := 0;
  260.       taglen := 0; tagsiz := 0;
  261.       with cfg do begin
  262.         __bandwin(true, x1, y1, x2, y2, applic_f, applic_b, sh_default, 15);
  263.         __clrscn(x1+1, y1+1, x2-1, y2-1, applic_f, applic_b, ' ');
  264.         __betwscn(x1+1, x2-1, y1 + (y2-y1) div 2, applic_h, applic_b,
  265.           'Searching archive: '+ arc);
  266.         {__parsefil(arc, nam, ext); ext := __cvtstr(ext, _to_upcase_str);}
  267.         __betwscn(x1, x2, y1-1, applic_f, applic_b,
  268.           '[ ' + __cvtstr(ext, _to_upcase_str) + '-TV ]');
  269.       end;
  270.       if mfree < 20480 then with cfg do begin
  271.         __betwscn(x1+1, x2-1, y1 + (y2-y1) div 2 - 1, applic_f, applic_b,
  272.           'NOT ENOUGH MEMORY TO VIEW ARCHIVE');
  273.         __betwscn(x1+1, x2-1, y1 + (y2-y1) div 2 + 1, applic_f, applic_b,
  274.           'AT LEAST 4,096 BYTES MUST BE FREE');
  275.         __delaykey(5000);
  276.         __pak_tv := false;
  277.       end else begin
  278.         count := 0; pak_entry := ''; off := 0; cur := 1;
  279.         cfismartmode := true;
  280.         {readcentralheader := true;} fname := arc;
  281.         if not opencfifile(fname) then with cfg do begin
  282.           __betwscn(x1,x2,y1  , applic_f,applic_b,'[ Information Error ]');
  283.           __betwscn(x1,x2,y1+2, applic_f,applic_b,'This archive appears');
  284.           __betwscn(x1,x2,y1+3, applic_f,applic_b,'to contain no real');
  285.           __betwscn(x1,x2,y1+4, applic_f,applic_b,'files. Function denied.');
  286.           __delaykey(3000); complete_error := true;
  287.         end else begin
  288.           cfierror := false; count := 0;
  289.           __betwscn(1, 80, 17, applic_f, applic_b,
  290.             'Size of archive: ' + __pntstr(__sizefil(arc))
  291.           );
  292.           __betwscn(1, 80, 04, applic_f, applic_b, 'Items');
  293.           __betwscn(1, 80, 06, applic_f, applic_b, '▄▄▄▄▄▄▄▄▄▄▄▄▄');
  294.           __betwscn(1, 80, 07, applic_f, applic_b, '█           █');
  295.           __betwscn(1, 80, 08, applic_f, applic_b, '█           █');
  296.           __betwscn(1, 80, 09, applic_f, applic_b, '█           █');
  297.           __betwscn(1, 80, 10, applic_f, applic_b, '▀▀▀▀▀▀▀▀▀▀▀▀▀');
  298.           repeat
  299.             ifnext := cfinext;
  300.             s := ''; ss := '';
  301.             if not(cfierror) and ifnext then with cfitype do begin
  302.               if (cfiosize <> 0) then begin
  303.                 if (cfipsize / cfiosize)=1 then ss := ' 100' else
  304.                   ss := __formstr('@@.@', (cfipsize / cfiosize) * 100)
  305.               end else ss := ' 100';
  306.               __splitfil(__normfil(__backapp(cfipath)+cfiname), fpad, fnam, fext);
  307.               s := '   ' + __juststr(fnam+fext, ' ', 14, _left_just_str) +
  308.                 __juststr(__pntstr(cfiosize), ' ', 9, _right_just_str) + '   ' +
  309.                 ss + '% ' +
  310.                 __juststr(__pntstr(cfipsize), ' ', 9, _right_just_str) + ' ' +
  311.                 __juststr(convertdate(cfitime), ' ', 9, _right_just_str) + ' ' +
  312.                 __juststr(converttime(cfitime), ' ', 5, _right_just_str) + ' ' +
  313.                 compressed_type(cfimethod);
  314.               inc(count); new(arc_content[count]);
  315.               if showreads then
  316.                 __betwscn(1, 80, 8, applic_h, applic_b, __pntstr(count));
  317.               with arc_content[count]^ do begin
  318.                 st := s; so := cfiosize; sp := cfipsize; pad := fpad;
  319.               end;
  320.             end;
  321.           until (cfierror) or (maxavail <= 4096) or (__chkkey=_esc);
  322.           closecfi;
  323.           __clrscn(x1+1, y1+1, x2-1, y2-1, applic_f, applic_b, ' ');
  324.   
  325.           numl := length(__num(count));
  326.           with cfg do begin
  327.             __betwscn(x1+1, x2-1, y1+(y2-y1) div 2, applic_h,applic_b,
  328.               __rep(19+length(arc), ' ')); write_items;
  329.             __write(x1+1, y1+1, applic_h, applic_b,
  330.               '   Filename       Original    FS      Packed' +
  331.               '   Date    Time  Method   Path'
  332.             );
  333.           end;
  334.   
  335.           __write(x1+4, y1-1, applic_f, applic_b, '[ ' + __num(count) + ':' +
  336.             __juststr(__num(off+cur), '0', numl, _right_just_str) + ' ]'
  337.           );
  338.           numm := length(__num(maxavail div 1024));
  339.           if showmem then __write(x2-10, y1-1, applic_f, applic_b,
  340.             '[ ' + __juststr(
  341.                __num(maxavail div 1024), '0', numm, _right_just_str
  342.              ) + 'K ]'
  343.           );
  344.  
  345.           if complete_error then key := _esc;
  346.  
  347.           if not complete_error then repeat
  348.             __write(x1+4+2+numl+1, y1-1, applic_f, applic_b,
  349.               __juststr(__num(off+cur), '0', numl, _right_just_str)
  350.             );
  351.             __attrib(x1+1, y1+cur+2, x2-1, y1+cur+2, applic_b, applic_f);
  352.             key := __retkey;
  353.            __attrib(x1+1, y1+cur+2, x2-1, y1+cur+2, applic_f, applic_b);
  354.   
  355.             case key of
  356.   
  357.               _up, _padup: begin
  358.                 if cur>1 then dec(cur) else if off>0 then begin
  359.                   wst := __packfil(arc_content[off+cur]^.pad, 6); 
  360.                   wst := copy(wst, 3, length(wst)-2); 
  361.                   wst := ' ' + copy(wst, 1, 6);
  362.                   dec(off); __copyscn(x1+1, y1+3, x2-1, y2-3, x1+1, y1+4);
  363.                   __write(x1+1, y1+3, cfg.applic_f, cfg.applic_b,
  364.                     arc_content[off+cur]^.st + 
  365.                     __juststr(wst, ' ', 6, _left_just_str)
  366.                     );
  367.                 end;
  368.               end;
  369.   
  370.               _c_v, _ins, _padins, _down, _paddown, _space: begin
  371.                 wst := __packfil(arc_content[off+cur]^.pad, 6); 
  372.                 wst := copy(wst, 3, length(wst)-2); 
  373.                 wst := ' ' + copy(wst, 1, 6);
  374.                 if (
  375.                   (key=_c_v) or (key=_ins) or (key=_padins) or (key=_space)
  376.                 ) then begin
  377.                   if not(
  378.                     (arc_content[off+cur]^.st[2]='√') and (key=_space)
  379.                   ) then begin
  380.                     if arc_content[off+cur]^.st[2]  = ' ' then
  381.                       arc_content[off+cur]^.st[2] := '√' else
  382.                       arc_content[off+cur]^.st[2] := ' ';
  383.                     if (key=_space) then arc_content[off+cur]^.st[2] := '√';
  384.                     with cfg do __write(x1+1,y1+cur+2,applic_f,applic_b,
  385.                       arc_content[off+cur]^.st + 
  386.                       __juststr(wst, ' ', 6, _left_just_str)
  387.                     );
  388.                     if arc_content[off+cur]^.st[2] = ' ' then begin
  389.                      dec(tagged);
  390.                      dec(tagsiz, arc_content[off+cur]^.so);
  391.                      dec(taglen, arc_content[off+cur]^.sp);
  392.                     end else begin
  393.                      inc(tagged);
  394.                      inc(tagsiz, arc_content[off+cur]^.so);
  395.                      inc(taglen, arc_content[off+cur]^.sp);
  396.                     end;
  397.                     with cfg do begin
  398.                       __betwscn(x1,x2, y2+1, applic_f, applic_b,
  399.                         __rep(x2-x1-2, '═'));
  400.                       __betwscn(x1,x2, y2+1, applic_h, applic_b,
  401.                         '[ Tags: '      + __pntstr(tagged) +
  402.                         '  Amount: '    + __pntstr(taglen) +
  403.                         '  Real size: ' + __pntstr(tagsiz)   +
  404.                         ' ]');
  405.                     end;
  406.                   end;
  407.                 end;
  408.                 if ((cur<count) and (count<=y2-y1-4)) or
  409.                    ((count>y2-y1-4) and (cur<y2-y1-4)) then inc(cur) else
  410.                   if (off<(count-y2+y1+4)) and (count>y2-y1-4) then begin
  411.                     inc(off); __copyscn(x1+1, y1+4, x2-1, y2-2, x1+1, y1+3);
  412.                     __write(x1+1, y2-2, cfg.applic_f,
  413.                       cfg.applic_b, arc_content[off+cur]^.st + 
  414.                       __juststr(wst, ' ', 6, _left_just_str)
  415.                     );
  416.                   end;
  417.               end;
  418.   
  419.               _home, _padhome: begin off := 0; cur := 1; write_items end;
  420.   
  421.               _end, _padend: begin
  422.                 if count>y2-y1-4 then off := count - y2 + y1 + 4 else off := 0;
  423.                 cur := __min(y2-y1-4, count); write_items
  424.               end;
  425.   
  426.               _pgdn, _padpgdn: begin
  427.                 if (count > 2*(y2-y1-4)) and (off <= count-(y2-y1-4)*2) then
  428.                   inc(off, y2-y1-4) else
  429.                 begin off := count-(y2-y1-4); cur := __min(count, y2-y1-4) end;
  430.                 write_items;
  431.               end;
  432.   
  433.               _pgup, _padpgup: begin
  434.                 if (count > y2-y1-4) and (off >= (y2-y1-4)) then
  435.                   dec(off, y2-y1-4) else begin off := 0; cur := 1 end;
  436.                 write_items;
  437.               end;
  438.  
  439.               _i, _f4: begin
  440.                 __savscn(scn2);
  441.                 __bandwin(true, x1+12, y1+4, x2-12, y2-6, applic_b, applic_f, sh_default, 0);
  442.                 __betwscn(x1, x2, y1+3, applic_b, applic_h, '[ ' + arc + ' ]');
  443.                 __write(x1 + 15, y1+ 8, applic_b, applic_f, 'Archive size: ' +
  444.                   __pntstr(__sizefil(arc))
  445.                 );
  446.                 __write(x1 + 15, y1+ 10, applic_b, applic_f, 'Current file: ');
  447.                 __write(x1 + 15, y1+ 11, applic_b, applic_f, '  ' +
  448.                   __packfil(arc_content[off+cur]^.pad, x2-x1-12-12-12) + 
  449.                   copy(arc_content[off+cur]^.st, 4, 12)
  450.                 );
  451.                 __write(x1 + 15, y1+ 12, applic_b, applic_f, + '  ' +
  452.                   __cvtstr(
  453.                     copy(arc_content[off+cur]^.st, 16, 11), _rem_lead_white_str
  454.                   ) + ' bytes'
  455.                 );
  456.                 __delaykey(10000);
  457.                 __resscn(scn2);
  458.               end;
  459.  
  460.               _v, _f3: begin
  461.                 __savscn(scn2);
  462.                 __write(3, y2+1, 0, 7, '[ Viewing ' + __cvtstr(
  463.                   copy(arc_content[off+cur]^.st, 4, 16),
  464.                     _to_upcase_str + _rem_white_str
  465.                   ) + ' in ' + __normfil(arc) +' ]'
  466.                 ); { was spawn }
  467.  
  468.                 {SAVE & CREATE DIR}
  469.                 getdir(0, olddir); mkdir('\TEMPVIEW.$$$'); chdir('\TEMPVIEW.$$$');
  470.                 useemsifavailable := true;
  471.  
  472.                 {UNPACK}
  473.                 if not initexecswap(heapptr, '\SWAP.$$$') then begin
  474.                   writeln('Shell not possible!'); __delaykey(5000);
  475.                   {exec(archer + ' E ' + arc + ' ' +
  476.                     copy(arc_content[off+cur]^.st, 4, 16) + ' >nul', error
  477.                   );}
  478.                 end else begin
  479.                   swapvectors;
  480.  
  481.                   numm := length(__num(bytesswapped div 1024));
  482.                   __write(x2-16, y2+1, 0, 15,
  483.                     '[ ' + __juststr(
  484.                     __num(bytesswapped div 1024), '0', numm, _right_just_str
  485.                     ) + 'K ' + swaploc[emsallocated] + ' ]'
  486.                   );
  487.                   status := execwithswap(getenv('COMSPEC'), ' /C ' + archer + ' E ' +
  488.                     arc + ' ' + copy(arc_content[off+cur]^.st, 4, 16) + ' >nul'
  489.                   );
  490.                   swapvectors;
  491. {@}
  492.                   __renamfil(copy(arc_content[off+cur]^.st, 4, 16),
  493.                     '\TEMPVIEW.$$$\'+copy(arc_content[off+cur]^.st, 4, 16),
  494.                     error
  495.                   );
  496.                 end;
  497.                 shutdownexecswap;
  498.  
  499.                 {VIEW}
  500.                 if not initexecswap(heapptr, 'SWAP.$$$') then begin
  501.                   writeln('Shell not possible!'); __delaykey(5000);
  502.                   {__dosexpgm(
  503.                     viewer + ' \TEMPVIEW.$$$\' + 
  504.                     copy(arc_content[off+cur]^.st, 4, 16), error
  505.                    )}
  506.                 end else begin
  507.                   swapvectors;
  508.                   status := execwithswap(getenv('COMSPEC'), 
  509.                     ' /C ' + viewer + ' \TEMPVIEW.$$$\' +
  510.                     copy(arc_content[off+cur]^.st, 4, 16)
  511.                   );
  512.                   swapvectors;
  513.                 end;
  514.                 shutdownexecswap;
  515.  
  516.                 {REMOVE TEMP FILES & DIR}
  517.                 __erasefil('\TEMPVIEW.$$$\'+copy(arc_content[off+cur]^.st,4,12),error);
  518.                 chdir(olddir); rmdir('\TEMPVIEW.$$$');
  519.                 __resscn(scn2);
  520.               end;
  521.  
  522.               _star, _padstar: begin
  523.                 for i := 1 to count do if arc_content[i]^.st[2] = '√' then begin
  524.                   arc_content[i]^.st[2] := ' ';
  525.                   dec(tagged); dec(tagsiz, arc_content[i]^.so);
  526.                   dec(taglen, arc_content[i]^.sp);
  527.                 end else begin
  528.                   arc_content[i]^.st[2] := '√';
  529.                   inc(tagged); inc(tagsiz, arc_content[i]^.so);
  530.                   inc(taglen, arc_content[i]^.sp);
  531.                 end; write_items;
  532.                 with cfg do begin
  533.                   __betwscn(x1,x2, y2+1, applic_f, applic_b, __rep(x2-x1-2, '═'));
  534.                   __betwscn(x1,x2, y2+1, applic_h, applic_b,
  535.                     '[ Tags: '      + __pntstr(tagged) +
  536.                     '  Amount: '    + __pntstr(taglen) +
  537.                     '  Real size: ' + __pntstr(tagsiz)   +
  538.                     ' ]');
  539.                 end; { with }
  540.               end; { star }
  541.   
  542.             end; { case }
  543.   
  544.           until (key=_enter) or (key=_esc) or (key=_del) or (key=_paddel);
  545.   
  546.           quit := key = _esc; if key = _paddel then key := _del;
  547.           if (key = _enter) or (key = _del) then begin
  548.             nrtags := 0;
  549.             assign(pak_tv_arc, '\FC_FILS.DAT'); rewrite(pak_tv_arc);
  550.             for i := 1 to count do begin
  551.               if arc_content[i]^.st[2]<>' ' then begin
  552.                 inc(nrtags);
  553.                 writeln(pak_tv_arc,
  554.                   __backapp(fexpand(arc_content[i]^.pad)) +
  555.                   __cvtstr(copy(arc_content[i]^.st, 4, 12), _rem_white_str)
  556.                 );
  557.               end;
  558.             end;
  559.             close(pak_tv_arc);
  560.           end;
  561.   
  562.           for i := 1 to count do release(arc_content[i]);
  563.           if key = _enter then opt := o_unpak else if key = _del then
  564.             opt := o_delete else opt := o_nothing;
  565.           __pak_tv := ((key = _enter) or (key = _del)) and (nrtags>0);
  566.         end; { is archive }
  567.       end; { with }
  568.     end; { enough memory }
  569.     __resscn(oldscn); release(oldscn);
  570.   end; { arcpanelobj }
  571.  
  572.  
  573.  
  574.  
  575.   {██████████████████████████████████████████}
  576.   function arcpanelobj.__atv(arcname: pathstr): boolean;
  577.   var
  578.     option : optiontype;
  579.  
  580.  
  581.   begin
  582.     ful := true; quit := false; complete_error := false;
  583.     option := o_nothing; mfree := maxavail;
  584.     with cfg do begin
  585.       applic_f := lightgray;
  586.       applic_h := white;
  587.       applic_b := lightblue;
  588.       x1 := 03;
  589.       y1 := 03;
  590.       x2 := 78;
  591.       y2 := _currows-2;
  592.     end;
  593.      
  594.     repeat
  595.       if __pak_tv(arcname, option) then begin
  596.         __cls;
  597.         {
  598.         if option = o_unpak then write('Files tagged, unpacking them...') else
  599.           write('Files tagged, deleting them...');
  600.         }
  601.         useemsifavailable := true; nulstr := ' >nul';
  602.   
  603.         if nulstr = '' then begin
  604.           writeln; 
  605.           if option = o_unpak then 
  606.             writeln(archer + ' E ' + arcname + ' !\FC_FILS.DAT' + nulstr) else
  607.             writeln(archer + ' D ' + arcname + ' !\FC_FILS.DAT' + nulstr);
  608.         end;
  609.         if not initexecswap(heapptr, '\SWAP.$$$') then begin
  610.           writeln('Shell not possible!'); __delaykey(5000);
  611.           {
  612.           if option = o_unpak then __dosexpgm(
  613.             archer + ' E ' + arcname + ' !\FC_FILS.DAT' + nulstr, error
  614.           )  else __dosexpgm(
  615.             archer + ' D ' + arcname + ' !\FC_FILS.DAT' + nulstr, error
  616.           )}
  617.         end else begin
  618.           swapvectors;
  619.           if option = o_unpak then status := execwithswap(getenv('COMSPEC'), 
  620.             ' /C ' + archer + ' E ' + arcname + ' !\FC_FILS.DAT' + nulstr
  621.           ) else status := execwithswap(getenv('COMSPEC'), 
  622.             ' /C ' + archer + ' D ' + arcname + ' !\FC_FILS.DAT' + nulstr
  623.           );
  624.           swapvectors;
  625.         end;
  626.         shutdownexecswap;
  627.   
  628.         __resscn(scn2);
  629.       end;
  630.       {writeln('Leave file alone');}
  631.     until quit or complete_error;
  632.     if __existfil('\FC_FILS.DAT') then __erasefil('\FC_FILS.DAT', error);
  633.     __atv := complete_error;
  634.   end; { arcpanelobj.__atv }
  635.  
  636.  
  637.  
  638. end. { unit eco_atv  The ECO Library Archive Television }
  639.