home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a079 / 1.img / FPDG.LZH / VOL2NUM0 / DOCUMENT / DOCUMENT.PRG < prev    next >
Encoding:
Text File  |  1993-02-01  |  5.1 KB  |  162 lines
  1. *****************************************************************
  2. *     * 01/12/93            DOCUMENT.PRG               12:22:12 *
  3. *****************************************************************
  4. *     * Author's Name: Jeb Long                                 *
  5. *     *                                                         *
  6. *     * Description:                                            *
  7. *     * This program illustrates memo field compression         *
  8. *     * using FOXTOOLS and edilzssa.dll                         *
  9. *     *                                                         *
  10. *     * This program maintains DOCUMENT.DBF which stores        *
  11. *     * documents as compressed database files                  *
  12. *****************************************************************
  13. USE DOCUMENT
  14. SET LIBRARY TO (SYS(2004)+"FOXTOOLS") ADDITIVE
  15. Stopit=.F.
  16. IF RECCOUNT() = 0  && Is file empty?
  17.     DO ADDNEW
  18. ENDIF    
  19. IF RECCOUNT() > 0
  20.     DO DOCUMENT.SPR
  21. ENDIF
  22. CLEAR ALL
  23. RETURN
  24. *****************************************************************
  25. * Procedure ADDMEMO - Compresses document file and adds it to a 
  26. *                    memo field
  27. PROCEDURE ADDNEW
  28. docfile = GETFILE() && Open file dialog box
  29. IF COMPRESS(docfile) 
  30.      APPEND BLANK
  31.      REPL filename with docfile
  32.      REPLACE DATE WITH DATE()
  33.      APPEND MEMO Document FROM crunch.txt
  34.      DELETE FILE crunch.txt
  35. ENDIF
  36. RETURN     
  37. *****************************************************************
  38. * Function: COMPRESS(Source)  - Compresses Source file
  39. *
  40. FUNCTION COMPRESS
  41. PARAMETER NameFile
  42. Regno = RegFN( "LZSSPACKFILE",  "CC", "I", "edilzssa.dll" )
  43. Success = .F.
  44. IF Regno = -1
  45.      WAIT WINDOW "Unable to register edilzssa.dll file"
  46. ELSE
  47. *
  48. * LZSSPackFile(Source, Destination)  - Compresses source file
  49. *                         and writes compressed destination file
  50. *
  51.      DELETE FILE crunch.txt
  52.      ErrCode = CallFN(Regno, NameFile, "crunch.txt" )
  53.      IF ErrCode = 0
  54.          WAIT WINDOW STR(100-(100*FileSize("crunch.txt") ;
  55.                                   /FileSize(NameFile) ),5,2);
  56.                                   +"% Compression" TIMEOUT 10
  57.          Success = .T.
  58.      ELSE
  59.           WAIT WINDOW "Error Number "+LTRIM(STR(ErrCode));
  60.              +"... Compression not performed"
  61.      ENDIF
  62. ENDIF
  63. RETURN Success
  64. *****************************************************************
  65. * Procedure: DECOMP
  66. *  
  67. PROCEDURE DECOMP
  68. PARAMETER Target
  69. *
  70. * LZSSUnPackFile(Source, Destination)  - Decompresses source file
  71. *                                        and writes destination file
  72. *
  73. Regno = RegFN( "LZSSUnPACKFILE",  "CC", "I", "edilzssa.dll" )
  74. IF FILE(Target)
  75.     WAIT WINDOW Target+" already exists."
  76. ELSE
  77.     Regno = RegFN( "LZSSUnPACKFILE",  "CC", "I", "edilzssa.dll" )
  78.     IF Regno = -1
  79.         WAIT WINDOW "Unable to register edilzssa.dll file"
  80.     ELSE
  81.         ErrCode = CallFN(Regno, "crunch.txt", Target )
  82.         IF ErrCode <> 0
  83.             WAIT WINDOW "Error Number "+LTRIM(STR(ErrCode));
  84.                         +" Occurred"
  85.         ENDIF
  86.     ENDIF
  87. ENDIF 
  88. ERASE crunch.txt
  89. RETURN 
  90. ****************************************************************
  91. * File positioning functions
  92. *
  93. ***************
  94. FUNCTION Button
  95. PARAMETER Choice
  96. DO CASE
  97.      CASE Choice = 1  && NEXT
  98.         IF RECNO() < RECCOUNT()
  99.             SKIP
  100.         ENDIF
  101.      CASE Choice = 2  && PREVIOUS 
  102.         IF RECNO()>1
  103.            SKIP -1
  104.         ENDIF
  105.      CASE Choice = 3  && TOP (First record)
  106.         GO TOP
  107.      CASE Choice = 4  && BOTTOM (Last record)
  108.         GO BOTTOM
  109.      CASE Choice = 5  && Add new memo 
  110.         DO ADDNEW
  111.      CASE Choice = 6  && Unpack a memo
  112.         COPY MEMO Document TO crunch.txt
  113.         DO DECOMP WITH Filename
  114.         RETURN .T.
  115.      CASE Choice = 7  && VIEW
  116.         ERASE crunch.txt
  117.         COPY MEMO Document TO crunch.txt
  118.         RELEASE WINDOW VIEW.TMP
  119.         ERASE VIEW.TMP
  120.         DO DECOMP WITH "VIEW.TMP"                
  121.         IF ".BMP"$upper(filename)
  122.           DEFINE WINDOW BITMAP FROM 20,1 TO 40,20 FILL FILE VIEW.TMP
  123.           SHOW WINDOW BITMAP
  124.           WAIT WINDOW
  125.           RELEASE WINDOW BITMAP
  126.         ELSE
  127.           MODI FILE VIEW.TMP NOWAIT
  128.         ENDIF
  129.      CASE Choice = 8
  130.         Stopit = .F.  && EXIT 
  131.         CLEAR READ
  132.         RETURN .T.
  133. ENDCASE
  134. SHOW GETS
  135. @ 1.000,89.200 SAY document.date ;
  136.     SIZE 1.000,9.400 ;
  137.     FONT "MS Sans Serif", 8
  138. RETURN .T.        
  139. ***********************************************************************
  140. * Procedure: FileSize(<file>) - Returns size of <file> in bytes           
  141. *    If you don't pass it any parameters, it returns -2.
  142. *    If the file cannot be found, the UDF returns -1.
  143. *    (This function was derived from FSEEK() HELP example.)
  144. *
  145. PROCEDURE FileSize
  146. PARAMETERS cfile             && File to be checked
  147. PRIVATE mhandle,fsize
  148.  
  149. IF PARAMETERS( ) = 0
  150.     RETURN -2                    && Return -2 if no parameter passed
  151. ELSE
  152.     IF !FILE(cfile)
  153.         RETURN -1                && Return -1 if file does not exist
  154.     ENDIF
  155. ENDIF
  156. mhandle = FOPEN(cfile)        && Open file
  157. fsize = FSEEK(mhandle,0,2)    && Determine file size, assign to fsize
  158. =FCLOSE(mhandle)                && Close file
  159. RETURN fsize                    && Return value
  160.  
  161.   
  162.