home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #2 / RBBS_vol1_no2.iso / 014r / larc15.zip / LARC15.BAS next >
BASIC Source File  |  1987-03-15  |  12KB  |  389 lines
  1. ' $title:'LARC - Attempt to make the Littlest ARC file' $pagesize:74 $linesize:132
  2. ' by Vernon D. Buerg, 2/21/87; 2/25/87 (1.1); 2/26/87 (1.2); 2/28/87 (1.3)
  3. '                     3/01/87 (1.4); 3/15/87 (1.5)
  4. '
  5. ' Purpose:
  6. '       - make the smallest ARC files possible
  7. '       - learn how the ADVBAS subroutines work
  8. '       - convert LBR to ARC files
  9. '       - evaluate compression efficiency of ARC utilities
  10. '
  11. ' Usage:
  12. '       LARC d:[\path\]filespec  [d:\outpath]  [/A] [/P] [/C] [/L] [/R]
  13. '
  14. '       The input file specification is required and specifies the
  15. '       location of ARC files to be processed. The path name is optional.
  16. '
  17. '       You MUST not have the input dir as the current dir. The current
  18. '       drive (and directory) is used for temporary work space. Each
  19. '       ARC file is extracted to the current directory.
  20. '
  21. '       If the processed ARC file is smaller, the original ARC file
  22. '       is replaced. The file's date and time are preserved.
  23. '
  24. '       If an LBR library file is encountered, it is ARC'ed. A copy
  25. '       of LUE.COM must be available in the DOS path. If you want to
  26. '       just convert LBR files, supply an input filespec of "*.LBR".
  27. '
  28. '       You must have ARCA, PKXARC and PKARC accessible from the DOS path
  29. '       depending on the options /A, /P, and /C supplied.
  30. '
  31. ' Options:
  32. '       /A specifies that ARCA should be used.
  33. '       /P specifies that PKARC should be used.
  34. '       /C specifies that ARC should be used.
  35. '       /R specifies that a summary report is produced in the file LARC.RPT.
  36. '       /L indicates that original LBR files be deleted after being converted.
  37. ' ==========================================================================
  38. ' Definitions
  39.  
  40.     defint a-z
  41.     dim arc$(1000)                  ' filenames and stats for later
  42.     dim method$(3)                  ' up to three methods used
  43.     dim savings(3)                  ' total bytes saved per method
  44.  
  45.     version$="LARC Version 1.5"     ' some internal signs
  46.     author$="by Vernon D. Buerg"
  47.  
  48.     false = 0 : true = not false
  49.     cluster = 512                   ' target disk cluster size
  50.  
  51.      ' $dynamic
  52.     dim before!(1000)               ' original file sizes
  53.     dim after!(1000,3)              ' sizes after each method
  54.     dim stamp(1000,6)               ' file mo,dy,yr;hr,min,sec
  55.      ' $static
  56.  
  57.     def fneat$(x!)                  ' neaten number displays
  58.        fneat$ = right$(space$(8)+str$(x!),8)
  59.     end def
  60.  
  61.     def fn ltrim$(x$)               ' trim leading blanks
  62.        while left$(x$,1)=" "
  63.          x$=mid$(x$,2)
  64.        wend
  65.        fn ltrim$ = x$
  66.     end def
  67.  
  68.     def fn rtrim$(x$)               ' trim trailing blanks
  69.        while right$(x$,1)=" "
  70.          x$=left$(x$,len(x$)-1)
  71.        wend
  72.        fn rtrim$ = x$
  73.     end def
  74.  
  75.     def fn trim$(x$)                ' trim left and right blanks
  76.        fn trim$ = fn rtrim$(fn ltrim$(x$))
  77.     end def
  78.  
  79.     def fn switch (x$)              ' process option switches
  80.        if instr(parm$,x$) _
  81.          then fn switch = true : _
  82.           mid$(parm$,instr(parm$,x$),2)="  " _
  83.          else fn switch = false
  84.     end def
  85.  
  86. ' $page $subtitle: 'Initialization'
  87. ' =============================================================================
  88.  
  89. initialize:
  90.     on error goto err.traps
  91.  
  92.     call getdosv(majorv,minorv)     ' check dos version
  93.      if majorv<3 then print "Incorrect DOS version." : end
  94.  
  95.     parm$=command$                  ' command parameters and options
  96.     swa = fn switch ("/A")          ' use ARCA
  97.     swp = fn switch ("/P")          ' use PKARC
  98.     swc = fn switch ("/C")          ' use ARC
  99.     swr = fn switch ("/R")          ' produce LARC.RPT
  100.     swl = fn switch ("/L")          ' delete converted LBR files
  101.  
  102.     if not swa and not swp and not swc _
  103.       then swa=true                 ' default to just ARCA
  104.  
  105.     method=0                        ' index to method name
  106.     if swp then method=method+1 : method$(method)="P"
  107.     if swa then method=method+1 : method$(method)="A"
  108.     if swc then method=method+1 : method$(method)="C"
  109.  
  110.                     ' get input file d:\path\filename
  111.     if instr(parm$," ") _           ' and output drive:\path
  112.       then infile$ = fn trim$(left$(parm$,instr(parm$," ")-1)) : _
  113.            outpath$ = fn trim$(mid$(parm$,instr(parm$," ")+1)) _
  114.       else infile$ = fn trim$(parm$) : _
  115.            outpath$ = ""
  116.  
  117.     if infile$="" then print "Input filespec missing!" : end
  118.  
  119.     if instr(infile$,".")=0 then infile$=infile$+".ARC"
  120.  
  121.  
  122.     in.drive$=" "                   ' get drive letter of original files
  123.      if mid$(infile$,2,1) = ":" _
  124.        then in.drive$=left$(infile$,1) : _
  125.         infile$=mid$(infile$,3) _
  126.        else print "You must supply the input drive letter!" : _
  127.         end
  128.  
  129.     call drvspace (in.drive$,a,b,c) ' initial free space on source drive
  130.      before.space! = csng(a)*csng(b)*csng(c)
  131.      cluster = a * 512              ' target disk cluster size
  132.  
  133.     inpath$=""                      ' get input drive and path names
  134.     for i=len(infile$) to 1 step -1
  135.      if mid$(infile$,i,1)="\" _
  136.        then inpath$=left$(infile$,i) : _
  137.         infile$=mid$(infile$,i+1) _
  138.        else next
  139.  
  140.     temp.drive$=" "                 ' make sure different drives\paths
  141.      call getdrv(temp.drive$)       ' for temp, input, and output
  142.  
  143.     temp.path$=string$(64,0)        ' temporary d:\path
  144.      call getsub (temp.path$,tlen)
  145.      temp.path$="\"+left$(temp.path$,tlen)+"\"
  146.      temp.file$=temp.drive$+":"+left$(temp.path$,len(temp.path$)-1)
  147.  
  148.     if (temp.drive$ = in.drive$ and temp.path$=inpath$) _
  149.          or outpath$ = temp.file$ then
  150.       print "Input path:  ";in.drive$+":"+inpath$
  151.       print "Output path: ";outpath$
  152.       print "Temp path:   ";temp.file$
  153.       print
  154.       print "You must use a different d:\path for the original input files,"
  155.       print "and the output destination drive and path;  other than the"
  156.       print "current directory used for the temporary work files!"
  157.       end
  158.     end if
  159.  
  160. ' $page $subtitle: 'Mainline'
  161. ' =============================================================================
  162.  
  163. mainline:
  164.     attr = 0 : retcd=0                      ' get first file name
  165.     arcname$=in.drive$+":"+inpath$+infile$  ' from original filespec
  166.  
  167.     call findfirstf (arcname$+chr$(0),attr,retcd)
  168.      if retcd then
  169.        print "No matching files found for ";arcname$
  170.        end
  171.      end if
  172.  
  173. ' Build table of files to process
  174.  
  175. get.file:                                       ' extract next file name
  176.     infile$=space$(12)
  177.      call getnamef (infile$,flen)
  178.      if flen <0 _
  179.        then print "GETNAMEF logical error." : end _
  180.        else infile$=left$(infile$,flen)
  181.  
  182.     numfiles=numfiles+1                     ' save data for report
  183.  
  184.      call getdatef(month,day,year)          ' preserve datestamp
  185.       stamp(numfiles,1)=month
  186.       stamp(numfiles,2)=day
  187.       stamp(numfiles,3)=year
  188.      call gettimef(hour,minute,second)
  189.       stamp(numfiles,4)=hour
  190.       stamp(numfiles,5)=minute
  191.       stamp(numfiles,6)=second
  192.  
  193.      call getsizef(lo,hi)                   ' original file size
  194.       lo!=csng(lo)
  195.       if lo<0 then lo!=lo!+65536!
  196.       insize!=lo!+csng(hi)*65536!
  197.  
  198.      arc$(numfiles)=infile$
  199.      before!(numfiles)=insize!
  200.      for method=1 to 3
  201.       after!(numfiles,method)=insize!
  202.      next method
  203.  
  204.     call findnextf (retcd)                  ' next file to process
  205.     if retcd=0 then goto get.file
  206.  
  207.  
  208. ' $page $subtitle:'Invoke ARC processors for each archive file'
  209. ' ----------------------------------------------------------------
  210.  
  211. process:
  212. 100     for filenum=1 to numfiles
  213.      infile$=arc$(filenum)                  ' original file name
  214.      insize!=before!(filenum)               '  and file size
  215.      before!=insize!
  216.      arcname$=in.drive$+":"+inpath$+infile$    ' complete original filespec
  217.  
  218.      outfile$=infile$                       ' form target file name
  219.      if instr(infile$,".LBR") _
  220.        then mid$(outfile$,instr(infile$,".LBR"),4)=".ARC"
  221.  
  222.  
  223. 120     method = 0                              ' index for method used to ARC
  224.  
  225.     if insize!<cluster then                 ' skip small files?
  226.       for s=1 to 3
  227.        after!(filenum,s)=insize!
  228.       next
  229.       if outpath$ = "" _                    ' unless copying all ARC files
  230.         then goto next.file
  231.     end if
  232.  
  233.     replaced=copies                         ' times file has been copied
  234.  
  235.     if instr(arcname$,".LBR") _             ' extract the file
  236.       then cmd$="lue "+arcname$ _
  237.       else cmd$="pkxarc /r "+arcname$
  238.      cls
  239.      shell cmd$
  240.  
  241.     if swp then
  242.      cmd$="pkarc a "+outfile$+" *.*"        ' comparison to pk
  243.      cls
  244.      shell cmd$
  245.      gosub evaluate
  246.     end if
  247.  
  248.     if swa then
  249.     cmd$="arca "+outfile$+" *.*"            ' and to arca
  250.      cls
  251.      shell cmd$
  252.      gosub evaluate
  253.     end if
  254.  
  255.     if swc then                             ' and to SEA ARC
  256.      cmd$="arc -a "+outfile$+" *.*"
  257.      cls
  258.      shell cmd$
  259.      gosub evaluate
  260.     end if
  261.  
  262.     kill "*.*"                              ' rid extracted files
  263.  
  264.     if swl and instr(arcname$,".LBR") and replaced<>copies _
  265.       then kill arcname$            ' delete original LBR file
  266.  
  267.     if outpath$<>"" and replaced=copies _   ' did not copy it yet?
  268.       then shell "copy "+arcname$+" "+outpath$
  269.  
  270. next.file:
  271.     next filenum
  272.  
  273. ' $page $subtitle: 'Display file statistics'
  274. ' =============================================================================
  275.  
  276. report:
  277. 200     if swr _
  278.       then rptname$="larc.rpt" _
  279.       else rptname$="scrn:"
  280.  
  281.     open rptname$ for output as #1
  282.     gosub heading
  283.  
  284.     for i=1 to numfiles
  285.      if swr=0 and csrlin>22 then gosub newpage
  286.      print #1,arc$(i);tab(15); fneat$(before!(i));
  287.      for s=1 to method
  288.       after=int( (after!(i,s)+cluster-1)/cluster)
  289.       before=int( (before!(i)+cluster-1)/cluster)
  290.       savings = after-before
  291.       savings(s)=savings(s)+savings
  292.       print #1,fneat$(after!(i,s)); fneat$(csng(savings)*cluster);
  293.      next s
  294.      print #1,
  295.     next
  296.  
  297.     if swr=0 and csrlin>12 then gosub newpage
  298.      print #1,copies;"file(s) replaced";    ' Sum of savings by method
  299.      print #1,tab(30);" ";
  300.     for s=1 to method
  301.      print #1,fneat$(csng(savings(s))*cluster);"        ";
  302.     next
  303.     print #1,
  304.  
  305.     call drvspace (in.drive$,a,b,c)         ' get disk space saving
  306.      after.space! = csng(a)*csng(b)*csng(c)
  307.  
  308.      print #1,
  309.      print #1," Free disk space: "
  310.      print #1,"           before ";
  311.      print #1,using "##,###,###";before.space!
  312.      print #1,"           after  ";
  313.      print #1,using "##,###,###";after.space!
  314.      print #1,"           saved  ";after.space! - before.space!;"bytes"
  315.  
  316.     close #1                                ' all done
  317.     beep                                    ' wake em up
  318.  
  319.     if swr then
  320.      open rptname$ for input as #1          ' display the report
  321.      while not eof (1)                      '  in addition to writing it to
  322.       line input #1,a$                      '   the file to LARC.RPT
  323.       print a$
  324.      wend
  325.      close #1
  326.     end if
  327.  
  328.     end
  329.  
  330. newpage:
  331.     line input "Press ENTER to continue:";a$
  332. heading:
  333.     cls                                     ' pretty fancy, eh?
  334.     print #1,version$;" - Processing ";command$
  335.      print #1,
  336.      print #1,"Filename";tab(15);"  before";
  337.      for s=1 to method
  338.       print #1,"  after";method$(s);"    diff";
  339.      next
  340.     print #1,
  341.     locate ,1
  342.     return
  343.  
  344. ' $page $subtitle: 'Evaluate results of re-ARCing the files'
  345. ' ---------------------------------------------------------
  346.  
  347. evaluate:
  348.     method = method + 1
  349. 300     open outfile$ for input as #2           ' get new file size
  350.      outsize!=lof(2)
  351.      close #2
  352.  
  353. 310     after!(filenum,method)=outsize!
  354.  
  355.     'after=int( (outsize!+cluster-1)/cluster) ' compute clusters saved
  356.     'before=int( (before!+cluster-1)/cluster)
  357.     savings! = outsize! - before!             ' bytes (was clusters) saved
  358.  
  359. 400     if savings! <0 or (outpath$<>"" and method=1) then
  360.  
  361.      call setftd(outfile$+chr$(0),stamp(filenum,1),stamp(filenum,2), _
  362.              stamp(filenum,3),stamp(filenum,4),stamp(filenum,5), _
  363.              stamp(filenum,6) )         ' preserve date stamp
  364.  
  365.      if outpath$="" _               ' overlay original or to another subdir
  366.        then cmd$= "copy "+outfile$+" "+in.drive$+":"+inpath$+outfile$ _
  367.        else cmd$= "copy "+outfile$+" "+outpath$
  368.  
  369.      shell cmd$
  370.  
  371.      before!=outsize!               ' new original file size
  372.      copies=copies+1
  373.     end if
  374.  
  375. 410     kill outfile$                   ' rid the temporary ARC file
  376. copy.done:
  377.     return
  378.  
  379. copy.failed:
  380.     return next.file                ' file not found, not created, etc.
  381.  
  382.  
  383. err.traps:
  384.     if erl=100 then print arcname$;" not found"
  385.     if erl=410 then resume copy.done        ' short file only copied
  386.     if erl=300 then resume copy.failed      ' no ARC created
  387.     print "Error";err;"at line";erl
  388.     end
  389.