home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / TEMPLGEN / AP1PACK.INC < prev    next >
Encoding:
Text File  |  1988-02-11  |  2.9 KB  |  125 lines
  1. <<* APPPACK.INC *>>
  2.  
  3. <<procedure GenPackBody>>
  4. <<begin>>
  5. PARAMETER row,origFILE,tempFILE,origINDEX,IsFileOK
  6. PRIVATE origMEMO,tempMEMO,undelrecs
  7. *
  8. * ---Build MEMO filenames.
  9. origMEMO = TRIM( SUBSTR( origFILE,1,AT(".",origFILE)-1 ) ) + ".DBT"
  10. tempMEMO = TRIM( SUBSTR( tempFILE,1,AT(".",tempFILE)-1 ) ) + ".DBT"
  11. *
  12. * ---Delete old temporary file if it exists.
  13. IF FILE( tempFILE )
  14.    DELETE FILE &tempFILE
  15.    IF FILE( tempMEMO )
  16.       DELETE FILE &tempMEMO
  17.    ENDIF
  18. ENDIF
  19. *
  20. * ---Open original file and "PACK".
  21. USE &origFILE
  22. IF "" <> TRIM(origINDEX)
  23.    SET INDEX TO &origINDEX
  24. ENDIF
  25. @ row,0 CLEAR
  26. @ row,0 SAY [Copying "] + origFILE + ["...]
  27. * ---Copy undeleted records in order of index.
  28. * ---The new database will be "SORTed" in index order.
  29. SET DELETED ON
  30. SET TALK ON
  31. COPY TO &tempFILE
  32. SET TALK OFF
  33. SET DELETED OFF
  34. * ---Turn off the index and count the number of undeleted records.
  35. SET INDEX TO
  36. COUNT FOR .NOT. DELETED() TO undelrecs
  37. * ---Close original file.
  38. USE
  39. *
  40. * ---Was COPY TO temporary file successful?
  41. IsFileOK = .F.
  42. IF FILE( tempFILE )
  43.    USE &tempFILE
  44.    * ---The undeleted records in both files must match.
  45.    IF EOF()
  46.       IsFileOK = (undelrecs = 0)
  47.    ELSE
  48.       GOTO BOTTOM
  49.       IsFileOK = (undelrecs = RECNO())
  50.    ENDIF
  51.    USE
  52. ENDIF
  53. IF .NOT. IsFileOK
  54.    * ---"tempFILE" was not created or has an incorrect record count.
  55.    @ row,0 CLEAR
  56.    @ row,0 SAY "The file could not be packed."
  57.    WAIT
  58.    * ---Delete original index and have calling program recreate it.
  59.    DELETE FILE &origINDEX
  60.    RETURN
  61. ENDIF
  62. *
  63. * ---Delete the original file, and
  64. * ---RENAME temporary to original.
  65. DELETE FILE &origFILE
  66. RENAME &tempFILE TO &origFILE
  67. IF FILE( origMEMO )
  68.    DELETE FILE &origMEMO
  69.    RENAME &tempMEMO TO &origMEMO
  70. ENDIF
  71. <<end>> <<*GenPackBody*>>
  72.  
  73.  
  74. <<procedure GenPackItBody>>
  75. <<begin>>
  76. PARAMETER row
  77. PRIVATE IsFileOK,filename
  78. @ row,0 SAY "NOT UNDOABLE! - Remove all *DELETED* records? (y/n)"
  79. DO GetKey WITH choice,"YN"+Returnkey
  80. @ row,0 CLEAR
  81. IF choice <> "Y"
  82.    RETURN
  83. ENDIF
  84. CLOSE DATABASES
  85. @ row,0 SAY "Removing all *DELETED* records..."
  86. IsFileOK = .T.
  87. filename = ""
  88. IF NdxOrder > "0"
  89.    filename = NDXnam&NdxOrder
  90. ENDIF
  91. DO {fileprefix}_APAC WITH row,DBFname,DBFtemp,filename,IsFileOK
  92. IF IsFileOK
  93.    * ---USE new original and recreate index files.
  94.    USE &DBFname
  95.    @ row,0 CLEAR
  96.    @ row,0 SAY "Recreating index files..."
  97.    SET TALK ON
  98. <<if ismultials>>
  99.    DO CASE
  100.   <<forall databases>>
  101.    CASE dbfarea = {"}{dbfcount}{"}
  102.     <<if ndxtotal = 0>>
  103.       * ---<None>.
  104.     <<else>>
  105.       <<forall indexes>>
  106.       INDEX ON &NDXkey{ndxcount} TO &NDXnam{ndxcount}
  107.       <<endfor>>
  108.     <<endif>>
  109.   <<endfor>>
  110.    ENDCASE
  111. <<else>>
  112.   <<select database 1>>
  113.   <<forall indexes>>
  114.    INDEX ON &NDXkey{ndxcount} TO &NDXnam{ndxcount}
  115.   <<endfor>>
  116. <<endif>>
  117.    SET TALK OFF
  118.    * ---Close the datafile and index.
  119.    USE
  120. ENDIF
  121. DO {fileprefix}_OPEN
  122. <<end>> <<*GenPackItBody*>>
  123.  
  124. <<* EOF: APPPACK.INC *>>
  125.