home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / PKCON.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-17  |  5KB  |  172 lines
  1. program PKCON;
  2. uses dos,   (* DOS access unit *)
  3.      crt;   (* CRT access unit *)
  4.  
  5. (*----  Draws "NOW PROCESSING" pretty box  ----------------------*)
  6.  
  7. procedure prettyboxes;
  8.  begin
  9.     clrscr;
  10.     gotoxy(1,1);
  11.     textcolor(9);
  12.     writeln('                       PK-ZIP v.92 -> v1.00 Conversion');
  13.     write  ('                       Written by: ');
  14.     textcolor(12);
  15.     write  ('Paradigm Ghod');
  16.     textcolor(8);
  17.     write  (' - ');
  18.     textcolor(12);
  19.     writeln('TCS');
  20.     textcolor(10);
  21.     writeln;
  22.     writeln('                               Now Processing');
  23.     textcolor(11);
  24.     writeln('                              ╓──────────────╖');
  25.     writeln('                              ║              ║');
  26.     writeln('                              ╙──────────────╜');
  27.  end;
  28.  
  29. (*----  Removes files from temporary directory  -----------------*)
  30.  
  31. Procedure RemoveTemp;
  32.       var sucval:byte;
  33. procedure cleanslate;
  34.  begin
  35.     gotoxy(1,20);
  36.     write ('                          ');
  37.  end;
  38.  
  39. begin
  40.   sucval:=64;
  41.    repeat
  42.      inc(sucval);
  43.      gotoxy(1,20);
  44.      exec('C:\dos\command.com','/C ERASE '+chr(sucval)+'???????.* >NUL');
  45.      cleanslate;
  46.    until sucval=91;
  47.  
  48.   sucval:=47;
  49.    repeat
  50.      inc(sucval);
  51.      gotoxy(1,20);
  52.      exec('C:\dos\command.com','/C ERASE '+chr(sucval)+'???????.* >NUL');
  53.      cleanslate;
  54.    until sucval=58;
  55.    exec('C:\dos\command.com','/C ERASE $*.* >NUL');
  56.    cleanslate;
  57.    exec('C:\dos\command.com','/C ERASE %*.* >NUL');
  58.    cleanslate;
  59.    exec('C:\dos\command.com','/C ERASE (*.* >NUL');
  60.    cleanslate;
  61.    exec('C:\dos\command.com','/C ERASE )*.* >NUL');
  62.    cleanslate;
  63.    exec('C:\dos\command.com','/C ERASE #*.* >NUL');
  64.    cleanslate;
  65.    exec('C:\dos\command.com','/C ERASE &*.* >NUL');
  66.    cleanslate;
  67. end;
  68.  
  69.  
  70.  
  71. (*----  Does conversion from PK .92 to PK 1.00  -----------------*)
  72.  
  73. procedure doconversion (var ffinfo:searchrec; var main:string);
  74.       var a       :integer;
  75.   begin
  76.    gotoxy(32,6);
  77.    write('              ');
  78.    gotoxy(33,6);
  79.    textcolor(13);
  80.     a:=ffinfo.attr;
  81.     if (a and 1)=1 then exit;
  82.     if (a and 2)=2 then exit;
  83.     if (a and 4)=4 then exit;
  84.     if (a and 8)=8 then exit;
  85.     if (a and 16)=16 then exit;
  86.     write (ffinfo.name);
  87.     textcolor(9);
  88.     gotoxy(1,11);
  89.     chdir(main);
  90.     writeln ('                       Extracting Archive - Please Wait                ');
  91.     exec ('C:\DOS\COMMAND.COM','/C pkunzip '+ffinfo.name+' C:\TEMP >NUL');
  92.     chdir ('C:\TEMP');
  93.     textcolor(9);
  94.     gotoxy(1,11);
  95.     write ('                 Compressing files with IMPLOSION - please wait          ');
  96.     exec ('C:\DOS\COMMAND.COM','/C pkzip -ex -a '+ffinfo.name+' *.* >NUL');
  97.     textcolor(9);
  98.     gotoxy(1,11);
  99.     write ('                Moving compressed file to '+main+' - please wait         ');
  100.     exec ('C:\DOS\COMMAND.COM','/C copy '+ffinfo.name+' '+main+' >NUL');
  101.     textcolor(9);
  102.     gotoxy(1,11);
  103.     write ('                   Removing file from your system - please wait          ');
  104.     exec ('C:\DOS\COMMAND.COM','/C del '+ffinfo.name+' >NUL');
  105.     gotoxy(1,11);
  106.     write ('          Removing unzipped files from temporary directory - please wait ');
  107.     RemoveTemp;
  108.     chdir (main);
  109.   end;
  110.  
  111. (*----  Searches directory for wildcard - Then converts if found  ------*)
  112.   procedure directory;
  113.         var r         :registers;
  114.             ffinfo    :searchrec;
  115.             tpath     :string[80];
  116.             b         :byte;
  117.             cnt       :integer;
  118.             inputlam  :string[40];
  119.             maindir   :string[40];
  120.   begin
  121.     { getdir (defaultdrive,tpath); }
  122.     tpath:='C:\*.ZIP';
  123.     textcolor(12);
  124.     write ('Path');
  125.     textcolor(10);
  126.     write ('/');
  127.     textcolor(12);
  128.     write ('Wildcard');
  129.     textcolor(13);
  130.     write (' [');
  131.     textcolor(9);
  132.     write ('CR');
  133.     textcolor(10);
  134.     write ('-');
  135.     textcolor(9);
  136.     write (tpath);
  137.     textcolor(13);
  138.     write (']');
  139.     textcolor(11);
  140.     write (':');
  141.     textcolor(14);
  142.     readln(inputlam);
  143.     if length(inputlam)<>0 then tpath:=inputlam;
  144.     Write('Please enter your current path name [CR-C:\DL\]');
  145.     readln(maindir);
  146.     if maindir='' then maindir:='C:\DL';
  147.     findfirst ('C:\*.*',8,ffinfo);
  148.     findfirst (tpath,$17,ffinfo);
  149.     textcolor(8);
  150.     if doserror<>0 then writeln ('There were no files found matching those specifications.') else begin
  151.       prettyboxes;
  152.       cnt:=0;
  153.       while doserror=0 do begin
  154.         inc(cnt);
  155.         doconversion (ffinfo,maindir);
  156.         findnext (ffinfo)
  157.       end;
  158.       gotoxy(1,6);
  159.       textcolor(14);
  160.       gotoxy(1,15);
  161.       writeln ('                   Total Converted Files: ');
  162.       textcolor(11);
  163.       writeln (cnt)
  164.     end;
  165.   end;
  166.  
  167. begin
  168. clrscr;
  169. mkdir('C:\TEMP');
  170. directory;
  171. rmdir('C:\TEMP');
  172. end.