home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / vi_si_on / filexf2.inc < prev    next >
Text File  |  1990-09-01  |  5KB  |  168 lines
  1.   Procedure Zipfile;
  2.     Var a:arearec;
  3.       cnt,cn,start_area : integer ;
  4.       bang:text;
  5.       wang:lstr;
  6.       u:udrec;
  7.       color1,color2,color3,color4,color5,color6,color7:sstr;
  8.       done,first:Boolean;
  9.       T:Char;
  10.  
  11.   Procedure listfileb(n:Integer;extended:Boolean);
  12.     Var ud:udrec;
  13.       q:sstr;
  14.      path, Filez:anystr; _Name:namestr; _Ext: Extstr;
  15.       Sze:longint;
  16.      Any:lstr;
  17.     Begin
  18.       seekudfile(n);
  19.       Read(udfile,ud);
  20.       any:=strr(n)+'.';
  21.       write(bang,Color6+any:4,Color4);
  22.  
  23.         FSplit(ud.filename,path,_name,_ext);
  24.       path:=upcase(_name[1]);
  25.       _name[1]:=path[1];
  26.       write (bang,_Name:8,UpString(_Ext):4,'  '+Color3);
  27.       if (ud.sendto='') then
  28.       If ud.newfile
  29.       Then Write(bang,' New   ')
  30.       Else If ud.specialfile
  31.         Then Write(bang,' Ask   ')
  32.         Else If ud.points>0
  33.           Then Write(bang,ud.points:4 , '   ')
  34.           Else Write(bang,' Free  ')
  35.         else if match(ud.sendto,urec.handle) then write(bang,' Take  ') else
  36.         write(bang,' Priv  ');
  37.          write(bang,Color7);
  38.       Filez:=getfname(ud.path,ud.filename);
  39.       If Not(exist(filez)) Then write(bang,'[Offline]':10) Else begin
  40.        sze:=ud.filesize;
  41.         if sze<1024 then
  42.                write(bang,sze:10) else begin
  43.                  any:=strlong(sze div 1024)+'k ';
  44.                Write(bang,any:9);
  45.                end;
  46.       end;
  47.       WriteLn(bang,' '+Color2,copy(ud.descrip,1,40));
  48.     End;
  49.     Begin
  50.       Writehdr('Complete File List');
  51.       writestr(^M^P'Add color to the file listing? *');
  52.       writeln(^M^S'Please wait...Compiling List...');
  53.       Color1:=^M+^M;
  54.       Color2:='';
  55.       Color3:='';
  56.       Color4:='';
  57.       Color5:='';
  58.       Color6:='';
  59.       Color7:='';
  60.       if yes then
  61.       Begin
  62.         Color1:=#27+'[0;1m'+^M+^M+#27+'[37m';
  63.         Color2:=#27+'[36m';
  64.         Color3:=#27+'[35m';
  65.         Color4:=#27+'[34m';
  66.         Color5:=#27+'[37m';
  67.         Color6:=#27+'[33m';
  68.         Color7:=#27+'[31m';
  69.       End;
  70.       assign (Bang,'FileList.Zip');
  71.       if exist('FileList.zip') then erase(Bang);
  72.       assign  (bang,'FileList.txt');
  73.       if exist('FileList.Txt') then erase(bang);
  74.       rewrite(bang);
  75.       write(bang,Color1);
  76.       writeln(bang,'-------------------------------------------------------------------------');
  77.       write(bang,Color2+'Complete File Listing for the '+Color3+ConfigSet.LongNam+Color2);
  78.       writeLn(bang,' as of '+Color4+DateStr(Now)+Color2+' - '+Color4+TimeStr(Now));
  79.       writeln(bang,Color5+'-------------------------------------------------------------------------');
  80.       writeln(bang,^M);
  81.           beenaborted:=False;
  82.       start_area := curarea ;
  83.       For cn:=1 To FileSize(afile) Do Begin
  84.         seekafile(cn);
  85.         Read(afile,a);
  86.         If Allowed_in_Area(a) Then Begin
  87.           setarea(cn,true);
  88.               Begin
  89.       done:=False;
  90.  
  91.       Repeat
  92.  
  93.         first:=False;
  94.         beenaborted:=False;
  95.  
  96.         For cnt:=1 To FileSize(udfile) Do Begin
  97.           seekudfile(cnt);
  98.           Read(udfile,u);
  99.  
  100.            Begin
  101.  
  102.             If Not first Then Begin
  103.               write(bang,^M+^M+^M);
  104.               WriteLn(bang,Color5+'-------------------------------------------------------------------------');
  105.               writeLn(bang,Color6+' File Section:'+Color4+Area.Name);
  106.               writeln(bang,Color5+'-------------------------------------------------------------------------'+^M);
  107.             first:=True;End;
  108.             listfileb(cnt,False);
  109.         End;
  110.            done:=True;
  111.         End;
  112.         If Not first Then done:=True;
  113.       Until done;
  114.     End;
  115.  
  116.         End;
  117.       End ;
  118.       textclose(bang);
  119.       Writehdr('List Compilation done!');
  120.       writeln(^M);
  121.       writehdr(' Demon Tasker... Zipping File List ');
  122.       exec ('PKZIP.EXE','-ex FileList.zip FileList.txt');
  123.       erase(bang);
  124.       Writestr (^M'[D]ownload Now or [+] Add to Batch list [D] :');
  125.       if input='+' then Add_to_batch (0,'FileList.zip',0) else
  126.       download (0,'Filelist.zip',0);
  127.     End;
  128.  
  129.  
  130.   Procedure listarchive;
  131.     Var n:Integer;
  132.       ud:udrec;
  133.       fname:lstr;
  134.  
  135.     Begin
  136.       If nofiles Then exit;
  137.       n:=getfilenum('list');
  138.       If n=0 Then exit;
  139.       seekudfile(n);
  140.       Read(udfile,ud);
  141.       If Not AbleToDoAnything(Ud) then Exit;
  142.       Fname:=GetFname(Ud.Path,Ud.FileName);
  143.       fname:=upstring(fname);
  144.       clearscr;
  145.       writeln(^S'ViSiON ZIP/ARC/PAK/ICE/LZH Viewer');
  146.       write(^S'Archive Type: '^U);
  147.       if pos ('.ZIP', fname)>0 then zipview(fname) else
  148.       if pos ('.PAK',fname)>0 then PakView(fname) else
  149.       if pos ('.ARC',fname)>0 then Arcview(fname) else
  150.       if (pos ('.LZH',fname)>0) or (pos('.ICE',fname)>0) then lzhview(fname) else
  151.        writeln('Not an ARCHIVE!'^M^M);
  152.       Writestr (^B^M^P'Press [Return] to continue *');
  153.     End;
  154.  
  155.     procedure typefile;
  156.     var n:integer;
  157.         ud:udrec;
  158.     begin
  159.     if nofiles then exit;
  160.     n:=getfilenum('type');
  161.     if n=0 then exit;
  162.     seekudfile(n);
  163.     read(udfile,ud);
  164.     If Not AbleToDoAnything(Ud) then Exit;
  165.     printfile(ud.path+ud.filename);
  166.     writestr(^B^M^M'Press [Return] to continue *');
  167.     end;
  168.