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