home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / RCMP20 / RCMPDEMO.PRG next >
Text File  |  1993-09-20  |  15KB  |  527 lines
  1. *--------------------------------------------------------------------------
  2. * RCmpDemo.PRG - Program to demonstrate the use of the functions
  3. *                in the Clipper Library RCmpLib
  4. *
  5. * Used functions :
  6. *
  7. *    R_Compress ()    - Compress a file
  8. *    R_DeComp ()    - Decompress a file
  9. *    R_CPName ()    - Get the original name of a compressed file
  10. *    R_CPSize ()    - Get the original size of a compressed file
  11. *    R_FSize ()    - Get the file size of a file
  12. *    R_IsRCmp ()    - Determine if a file is compressed by RCmpLib
  13. *
  14. * This demo has been written for Clipper version 5.xx
  15. *
  16. * Compile    :    CLIPPER RCMPDEMO /N
  17. *
  18. * Link       :    RTLINK   file RCMPDEMO lib RCMPLIB    - or -
  19. *        BLINKER  file RCMPDEMO lib RCMPLIB    - or -
  20. *        EXOSPACE file RCMPDEMO lib RCMPEXO
  21. *
  22. * Syntax     :  RCMPDEMO
  23. *--------------------------------------------------------------------------
  24. * Date       :  20/09/93
  25. *--------------------------------------------------------------------------
  26. * Author     :  Rolf van Gelder
  27. *               Binnenwiertzstraat 27
  28. *               5615 HG  EINDHOVEN
  29. *            THE NETHERLANDS
  30. *
  31. * E-Mail     :  Internet: RCROLF@urc.tue.nl
  32. *               BitNet  : RCROLF@heitue5
  33. *--------------------------------------------------------------------------
  34. * (c) 1993  Rolf van Gelder, All rights reserved
  35. *--------------------------------------------------------------------------
  36. MEMVAR    GetList                && To eliminate Clipper /W warning
  37.  
  38.  
  39. *--------------------------------------------------------------------------
  40. * Standard Clipper HEADER files
  41. *--------------------------------------------------------------------------
  42. #include "Directry.CH"
  43.  
  44.  
  45. *--------------------------------------------------------------------------
  46. * RCMPLIB header file
  47. *--------------------------------------------------------------------------
  48. #include "RCmpLib.CH"
  49.  
  50. *-- Initialize the array with error messages (from RCmpLib.CH)
  51. STATIC    aErrTxt := CP_ERRMSG
  52.  
  53.  
  54. *--------------------------------------------------------------------------
  55. * STATIC CODEBLOCKS
  56. *--------------------------------------------------------------------------
  57.  
  58. *-- "Hit any key" message
  59. STATIC    bHitKey := { || DevPos (MaxRow(),0),DevOut('Hit any key ...'),;
  60.                         InKey (0) }
  61.  
  62. *-- Headerline (with clear screen)
  63. STATIC    bHeader := { || Scroll(), DevPos (0,0), ;
  64.                         DevOut ('RCmpDemo: Demo program for RCmpLib v2.0 - '+;
  65.                                 '20/09/93       (C) 1993  Rolf v Gelder' ), ;
  66.                         DevPos (1,0), ;
  67.                         DevOut ( Replicate ('─',80) ) }
  68.  
  69.  
  70. *--------------------------------------------------------------------------
  71. *
  72. *                          Main function : RCmpDemo
  73. *
  74. *--------------------------------------------------------------------------
  75. FUNCTION RCmpDemo
  76.  
  77. *-- Main menu
  78. LOCAL    aMenu := { 'Compress   .DBF, .DBT, .NTX files', ;
  79.                    'Decompress .DBF, .DBT, .NTX files', ;
  80.                    'Decompress ALL files', ;
  81.                    'List of ALL compressed files', ;
  82.                    'End of Demo' }
  83.  
  84. *-- Choice
  85. LOCAL    nChoice := 1
  86.  
  87. IF IsColor ()
  88.    *-- Set screen color
  89.    SetColor ( 'W+/RB' )
  90. ENDIF
  91.  
  92. *--------------------------------------------------------------------------
  93. * M A I N   P R O G R A M   L O O P
  94. *--------------------------------------------------------------------------
  95. DO WHILE .t.
  96.  
  97.    *-- Display header lines
  98.    Eval ( bHeader )
  99.  
  100.    DevPos ( 3, 31 )
  101.    DevOut ( '-+- MAIN  MENU -+-' )
  102.  
  103.    *-- Draw box
  104.    @5,18 TO 11,61 DOUBLE
  105.  
  106.    *-- Display main menu
  107.    nChoice := AChoice ( 6, 20, 10, 59, aMenu, , , nChoice )
  108.  
  109.    IF LastKey () = 27 .or. nChoice = 5
  110.       *-- <Esc> or 'End of Demo'
  111.       EXIT
  112.    ENDIF
  113.  
  114.    *-- Display header lines
  115.    Eval ( bHeader )
  116.  
  117.    DO CASE
  118.    CASE nChoice = 1
  119.       *-- Compress .DBF, .DBT and .NTX files
  120.  
  121.       DevPos ( 3, 0 )
  122.       DevOut ( '>>> COMPRESSION OF *.DBF *.DBT and *.NTX FILES' )
  123.       DevPos ( 5, 0 )
  124.  
  125.       DevOut ( 'Compression of the file----   Files size----------  ' + ;
  126.                'Gain----  Seconds' )
  127.       DevPos ( 6, 0 )
  128.  
  129.       *-- The function MultiDir creates a directory array containing
  130.       *--    all files with the specified extensions
  131.       CompArray ( MultiDir ( { '*.DBF', '*.DBT', '*.NTX' } ) )
  132.  
  133.  
  134.    CASE nChoice = 2
  135.       *-- Decompress .DBF, .DBT and .NTX files
  136.  
  137.       DevPos ( 3, 0 )
  138.       DevOut ( '>>> DECOMPRESSION of *.DBF *.DBT and *.NTX FILES' )
  139.       DevPos ( 5, 0 )
  140.  
  141.       *-- Note :
  142.       *-- In the file names of compressed files the first letter of the
  143.       *--    extension is replaced by the (#) character
  144.       DeCompArr ( MultiDir ( { '*.#BF', '*.#BT', '*.#TX' } ) )
  145.  
  146.  
  147.    CASE nChoice = 3
  148.       *-- Decompress ALL compressed files in the current DOS directory
  149.  
  150.       DevPos ( 3, 0 )
  151.       DevOut ( '>>> DECOMPRESSION OF ALL FILES IN THE CURRENT DIRECTORY' )
  152.       DevPos ( 5, 0 )
  153.  
  154.       DeCompAll ()
  155.  
  156.  
  157.    CASE nChoice = 4
  158.       *-- Create a list of ALL compressed files in the current directory
  159.  
  160.       DevPos ( 3, 0 )
  161.       DevOut ( '>>> LIST OF ALL COMPRESSED FILES IN THE CURRENT DIRECTORY' )
  162.  
  163.       CompList ()
  164.  
  165.    ENDCASE
  166.  
  167. ENDDO
  168.  
  169. DevPos ( 23, 0 )
  170.  
  171. RETURN nil
  172.  
  173.  
  174. *--------------------------------------------------------------------------
  175. *
  176. *                             CompArray ( aFiles )
  177. *
  178. *--------------------------------------------------------------------------
  179. * Function to compress files :
  180. *    The file names of the files to compress are passed in an array
  181. *
  182. * INPUT
  183. *       aFiles
  184. *        Array (created by the DIRECTORY()-function) with information
  185. *        about the files to be compressed
  186. * OUTPUT
  187. *       nil
  188. *--------------------------------------------------------------------------
  189. STATIC FUNCTION CompArray ( aFiles )
  190.  
  191. LOCAL    i                && Counter
  192. LOCAL    nFiles  := Len ( aFiles )    && Number of files in the array
  193. LOCAL    cOutFile            && Name of output file
  194. LOCAL    cInFile                && Name of input  file
  195. LOCAL    nRetCode            && Return code from R_Compress()
  196. LOCAL    nFSizeIn            && Size of input  file
  197. LOCAL    nFSizeOut            && Size of output file
  198. LOCAL    nCmpFact   := 0            && Gain = Compression factor
  199. LOCAL    nTBegin                && Starting time (in secs)
  200. LOCAL    nTEnd                && Ending   time (in secs)
  201.  
  202. IF nFiles < 1
  203.  
  204.    ALERT ( 'No files found to compress ...' )
  205.  
  206.    RETURN nil
  207.  
  208. ENDIF
  209.  
  210. *-- Process the files in the array
  211. FOR i := 1 TO nFiles
  212.  
  213.    cInFile  := aFiles [i,F_NAME]    && Name of input file
  214.    nFSizeIn := aFiles [i,F_SIZE]    && Size of input file
  215.  
  216.    *--------------------------------------------------------------------
  217.    * The extension of the default output file name starts with the '#'
  218.    * sign.
  219.    *--------------------------------------------------------------------
  220.    cOutFile := Left ( cInFile, AT ( '.', cInfile ) ) + '#' + ;
  221.       Right ( cInfile, 2 )
  222.  
  223.    *-- Display the file name
  224.    QOut ( PadR ( cInFile, 12 ) + ' => ' + PadR ( cOutFile, 12 ) + '  ' )
  225.  
  226.    *-- Start timer
  227.    nTBegin  := Seconds ()
  228.  
  229.    *-- COMPRESS THE INPUT FILE
  230.    nRetCode := R_Compress ( cInFile )
  231.  
  232.    *-- Stop timer
  233.    nTEnd    := Seconds ()
  234.  
  235.    IF nRetCode = CP_OKAY
  236.       *-- Compression okay !
  237.  
  238.       *-- Determine the size of the output file
  239.       nFSizeOut := R_FSize ( cOutFile )
  240.  
  241.       *-- Calculate the compression factor
  242.       nCmpFact  := 100 * ( nFSizeIn - nFSizeOut ) / nFSizeIn
  243.  
  244.       *-- Show the statistics
  245.       QQOut ( Str ( nFSizeIn, 8 ) + ' => ' + Str ( nFSizeOut, 8 ) + ;
  246.               '  ' + Str ( nCmpFact, 6, 2 ) + ' %   ' + ;
  247.               Str ( nTEnd - nTBegin, 7, 2 ) )
  248.  
  249.       *-- Compression was okay : original file can be deleted
  250.       FErase ( cInFile )
  251.  
  252.    ELSE
  253.       *-- Error during compression : display error message
  254.  
  255.       QQOut ( ' => Error: ' + aErrTxt [ nRetCode ] )
  256.  
  257.    ENDIF
  258.  
  259. * v1.0a *
  260.    IF Row () > ( MaxRow () - 3 )
  261.       *-- Screen full !
  262.  
  263.       *-- Hit any key
  264.       Eval ( bHitKey )
  265.  
  266.       @6,0 Clear
  267.  
  268.       DevPos ( 6, 0 )
  269.  
  270.    ENDIF
  271.  
  272. NEXT
  273.  
  274. *-- Hit any key
  275. Eval ( bHitKey )
  276.  
  277. RETURN nil
  278.  
  279.  
  280. *--------------------------------------------------------------------------
  281. *
  282. *                            DeCompArr ( aFiles )
  283. *
  284. *--------------------------------------------------------------------------
  285. * Function to decompress files :
  286. *    The file names of the files to decompress are passed in an array
  287. *
  288. * INPUT
  289. *       aFiles
  290. *        Array (created by the DIRECTORY()-function) with information
  291. *        about the files to be decompressed
  292. * OUTPUT
  293. *       nil
  294. *--------------------------------------------------------------------------
  295. FUNCTION DeCompArr ( aFiles )
  296.  
  297. LOCAL    nFiles  := Len ( aFiles )    && Number of files in the array
  298. LOCAL    i                && Counter
  299. LOCAL    cInFile                && Name of the input file
  300. LOCAL    nRetCode            && Return code from R_DeComp()
  301. LOCAL    nTBegin                && Starting time (in secs)
  302. LOCAL    nTEnd                && Ending   time (in secs)
  303.  
  304. IF nFiles < 1
  305.  
  306.    ALERT ( 'No file found to decompress ...' )
  307.  
  308.    RETURN nil
  309.  
  310. ENDIF
  311.  
  312. *-- Note :
  313. *-- The FOR ... NEXT LOOP can be nicely replaced by the AEval() function !
  314.  
  315. FOR i := 1 TO nFiles
  316.  
  317.     cInFile := aFiles [i,F_NAME]    && Name of the input file
  318.  
  319.     *-- Display the file name
  320.     QOut ( 'DECompressing: ' + PadR ( cInFile,15 ) )
  321.  
  322.     *-- DECOMPRESS THE INPUT FILE
  323.     nTBegin  := Seconds ()
  324.     nRetCode := R_DeComp ( cInFile )
  325.     nTEnd    := Seconds ()
  326.  
  327.     IF nRetCode = CP_OKAY
  328.        *-- Decompression okay : original file can be deleted !
  329.  
  330.        FErase ( cInFile )
  331.  
  332.        QQOut ( ' => Okay !  Time: '+Str (nTEnd-nTBegin,7,2) + ' secs.' )
  333.  
  334.    ELSE
  335.        *-- Error decompressing file : display error message
  336.  
  337.        QQOut ( ' => Error: ' + aErrTxt [ nRetCode ] )
  338.  
  339.    ENDIF
  340.  
  341.    IF Row () > ( MaxRow () - 3 )
  342.       *-- Screen full !
  343.  
  344.       *-- Hit any key
  345.       Eval ( bHitKey )
  346.  
  347.       @5,0 Clear
  348.  
  349.       DevPos ( 5, 0 )
  350.  
  351.    ENDIF
  352.  
  353. NEXT
  354.  
  355. *-- Hit any key
  356. Eval ( bHitKey )
  357.  
  358. RETURN nil
  359.  
  360.  
  361. *--------------------------------------------------------------------------
  362. *
  363. *                            DeCompAll ( )
  364. *
  365. *--------------------------------------------------------------------------
  366. * Function to decompress ALL compressed files in the current DOS directory
  367. *
  368. * INPUT
  369. *       (Geen)
  370. * OUTPUT
  371. *       nil
  372. *--------------------------------------------------------------------------
  373. STATIC FUNCTION DeCompAll
  374.  
  375. LOCAL    aCmpFil  := {}            && Array with compressed files
  376.  
  377. *-- Place all the by RCmpLib compressed files in the array <aCmpFil>
  378. AEval ( Directory ( '*.*' ), ;
  379.         { |dir| ;
  380.           IF (R_IsRCmp ( dir [F_NAME] ), AAdd ( aCmpFil, dir ), nil ) } )
  381.  
  382. IF Len ( aCmpFil ) < 1
  383.    *-- No files found ...
  384.  
  385.    Alert ( 'There are no compressed files in the current directory ...' )
  386.  
  387. ELSE
  388.  
  389.    DeCompArr ( aCmpFil )
  390.  
  391. ENDIF
  392.  
  393. RETURN nil
  394.  
  395.  
  396. *--------------------------------------------------------------------------
  397. *
  398. *                               CompList ()
  399. *
  400. *--------------------------------------------------------------------------
  401. * Displays a list of all compressed files in the current directory.
  402. * Some additional information about the files is given.
  403. *
  404. * INPUT
  405. *       (Geen)
  406. * OUTPUT
  407. *       nil
  408. *--------------------------------------------------------------------------
  409. STATIC FUNCTION CompList
  410.  
  411. LOCAL    aFiles   := Directory ( '*.*' )    && All files in current directory
  412. LOCAL    nFiles   := Len ( aFiles )    && Number of files in the array
  413. LOCAL    i                && Counter
  414. LOCAL    aComp    := {}            && Output array
  415. LOCAL    cOrgName            && Original file name
  416. LOCAL    nOrgSize            && Original file size
  417. LOCAL    nCmpFact            && Compression factor
  418. LOCAL    nTotFact := 0            && Total compression factor (v1.0a)
  419.  
  420.  
  421. *-- Note :
  422. *-- The FOR ... NEXT LOOP can be nicely replaced by the AEval() function !
  423.  
  424. FOR i := 1 TO nFiles
  425.  
  426.    IF R_IsRCmp ( aFiles [i,F_NAME] )
  427.       *-- File is compressed by RCmpLib !
  428.  
  429.       *-- Determine the original file name
  430.       cOrgName := R_CPName ( aFiles [i,F_NAME] )
  431.  
  432.       *-- Determine the original file size
  433.       nOrgSize := R_CPSize ( aFiles [i,F_NAME] )
  434.  
  435.       *-- Calculate the compression factor
  436.       *--    aFiles [i,F_SIZE] = size of the compressed file
  437.       nCmpFact := 100 * ( ( nOrgSize - aFiles [i,F_SIZE] ) / nOrgSize )
  438.  
  439.       nTotFact += nCmpFact
  440.  
  441.       *-- Format the information and add a line to the output array
  442.       AAdd ( aComp, ;
  443.          PadR ( cOrgName, 12 ) + ' │ ' + ;
  444.          Str ( nOrgSize, 8 ) + ' ║ ' + ;
  445.          PadR ( aFiles [i,F_NAME], 12 ) + ' │ ' + ;
  446.          Str ( aFiles [i,F_SIZE], 8 ) + ' ║ ' + ;
  447.          Str ( nCmpFact, 8, 2 ) + ' % ' )
  448.  
  449.    ENDIF
  450.  
  451. NEXT
  452.  
  453. IF Len ( aComp ) < 1
  454.    *-- No files found
  455.  
  456.    Alert ( 'There are no compressed file in this directory ...' )
  457.  
  458. ELSE
  459.    *-- Sort the array on file name
  460.    aComp := ASort ( aComp )
  461.  
  462.    *-- Display header lines for report
  463.    DevPos (5,7)
  464.    DevOut ('╔═════════════════════════╦═════════════════════════╦════════════╗')
  465.    DevPos (6,7)
  466.    DevOut ('║ ORIGINAL FILE           ║ COMPRESSED FILE         ║ COMPRESSION║')
  467.    DevPos (7,7)
  468.    DevOut ('╠══════════════╤══════════╬══════════════╤══════════╣     FACTOR ║')
  469.    DevPos (8,7)
  470.    DevOut ('║ FILE NAME    │     SIZE ║ FILE NAME    │     SIZE ║            ║')
  471.    DevPos (9,7)
  472.    DevOut ('╚══════════════╪══════════╬══════════════╪══════════╬════════════╝')
  473.  
  474.    DevPos ( MaxRow ()-1, 0 )
  475.    DevOut ( 'Average compression factor : ' + ;
  476.       Str ( nTotFact / Len ( aComp ), 7, 2 ) + ' % ' )
  477.  
  478.    DevPos ( MaxRow (), 0 )
  479.    DevOut ( 'Press <Esc> to return to the main menu ...' )    && v1.0a
  480.  
  481.    *-- Display the array with file info
  482.    AChoice ( 10, 9, 17, 70, aComp )
  483.  
  484. ENDIF
  485.  
  486. RETURN nil
  487.  
  488.  
  489. *--------------------------------------------------------------------------
  490. *
  491. *                               MultiDir ()
  492. *
  493. *--------------------------------------------------------------------------
  494. *
  495. * MultiDir creates a directory array with all files that match one of the
  496. * specified directory specifications.
  497. *
  498. * For example :
  499. * aFiles := MultiDir ( { 'R*.DBF', '*.NXT' } )
  500. *
  501. * Results :
  502. * The array <aFiles> containing all files that match the specification
  503. * R*.DBF and/or *.NTX.
  504. *
  505. * INPUT
  506. *       aDirSpec
  507. *        Array with directory specifications
  508. * OUTPUT
  509. *       aDirectory
  510. *        Multi dimensional array with file info.
  511. *        The array has the same structure as the array that is
  512. *        returned by the Clipper Directory() function.
  513. *--------------------------------------------------------------------------
  514. STATIC FUNCTION MultiDir ( aDirSpec )
  515.  
  516. LOCAL    aDirectory := {}        && Return array
  517. LOCAL    aTemp      := {}        && Temporary array
  518.  
  519. *-- This is a nice example of the use of the AEval() function !
  520.  
  521. AEval ( aDirSpec, ;
  522.    { |spec| aTemp := Directory ( spec ), ;
  523.      AEval ( aTemp, { |temp| AAdd ( aDirectory, temp ) } ) } )
  524.  
  525. RETURN aDirectory
  526. *
  527. * EOF RCmpDemo.PRG ========================================================