home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a046 / 5.img / TEMPLATE / SSBPACK.INC < prev    next >
Encoding:
Text File  |  1992-04-01  |  3.0 KB  |  130 lines
  1. <<* SSBPACK.INC *>>
  2. <<* (C) 1991 SHEN YANG WHITE HORSE SOFTWART COMPANY  *>>
  3.  
  4.  
  5. <<procedure GenPackBody>>
  6. <<begin>>
  7. PARAMETER row,origFILE,tempFILE,origINDEX,IsFileOK
  8. PRIVATE origMEMO,tempMEMO,undelrecs
  9.  
  10. <<GENLINE>>
  11. *
  12. * ---Build MEMO filenames.
  13. origMEMO = TRIM( SUBSTR( origFILE,1,AT(".",origFILE)-1 ) ) + ".DBT"
  14. tempMEMO = TRIM( SUBSTR( tempFILE,1,AT(".",tempFILE)-1 ) ) + ".DBT"
  15. *
  16. * ---Delete old temporary file if it exists.
  17. IF FILE( tempFILE )
  18.    DELETE FILE &tempFILE
  19.    IF FILE( tempMEMO )
  20.       DELETE FILE &tempMEMO
  21.    ENDIF
  22. ENDIF
  23. *
  24. * ---Open original file and "PACK".
  25. USE &origFILE
  26. IF "" <> TRIM(origINDEX)
  27.    SET INDEX TO &origINDEX
  28. ENDIF
  29. @ row,0 CLEAR
  30. @ row,0 SAY [╒²╘┌┐╜▒┤ "] + origFILE + ["...]
  31. * ---Copy undeleted records in order of index.
  32. * ---The new database will be "SORTed" in index order.
  33. SET DELETED ON
  34. SET TALK ON
  35. COPY TO &tempFILE
  36. SET TALK OFF
  37. SET DELETED OFF
  38. * ---Turn off the index and count the number of undeleted records.
  39. SET INDEX TO
  40. COUNT FOR .NOT. DELETED() TO undelrecs
  41. * ---Close original file.
  42. USE
  43. *
  44. * ---Was COPY TO temporary file successful?
  45. IsFileOK = .F.
  46. IF FILE( tempFILE )
  47.    USE &tempFILE
  48.    * ---The undeleted records in both files must match.
  49.    IF EOF()
  50.       IsFileOK = (undelrecs = 0)
  51.    ELSE
  52.       GOTO BOTTOM
  53.       IsFileOK = (undelrecs = RECNO())
  54.    ENDIF
  55.    USE
  56. ENDIF
  57. IF .NOT. IsFileOK
  58.    * ---"tempFILE" was not created or has an incorrect record count.
  59.    @ row,0 CLEAR
  60.    @ row,0 SAY "    ╕├╬─╝■▓╗─▄▒╗╟σ└φ."
  61.    WAIT
  62.    * ---Delete original index and have calling program recreate it.
  63.    DELETE FILE &origINDEX
  64.    RETURN
  65. ENDIF
  66. *
  67. * ---Delete the original file, and
  68. * ---RENAME temporary to original.
  69. DELETE FILE &origFILE
  70. RENAME &tempFILE TO &origFILE
  71. IF FILE( origMEMO )
  72.    DELETE FILE &origMEMO
  73.    RENAME &tempMEMO TO &origMEMO
  74. ENDIF
  75. <<end>> <<*GenPackBody*>>
  76.  
  77.  
  78. <<procedure GenPackItBody>>
  79. <<begin>>
  80. PARAMETER row
  81. PRIVATE IsFileOK,filename
  82. @ row,0 CLEAR
  83. @ row,0 SAY "╟σ└φ╦∙╙╨╫÷╔╛│²▒Ω╓╛ (*DELETED*) ╡─╝╟┬╝┬≡? (y/n)"
  84. DO GetKey WITH choice,"YN"+Returnkey
  85. @ row,0 CLEAR
  86. IF choice <> "Y"
  87.    RETURN
  88. ENDIF
  89. CLOSE DATABASES
  90. @ row,0 SAY "╒²╘┌╟σ└φ╦∙╙╨╫÷╔╛│²▒Ω╓╛ (*DELETED*) ╡─╝╟┬╝..."
  91. IsFileOK = .T.
  92. filename = ""
  93. IF NdxOrder > "0"
  94.    filename = NDXnam&NdxOrder
  95. ENDIF
  96. DO {fileprefix}N WITH row,DBFname,DBFtemp,filename,IsFileOK
  97. IF IsFileOK
  98.    * ---USE new original and recreate index files.
  99.    USE &DBFname
  100.    @ row,0 CLEAR
  101.    @ row,0 SAY "╓╪╨┬╜¿┴ó╦≈╥²╬─╝■..."
  102.    SET TALK ON
  103. <<if ismultials>>
  104.    DO CASE
  105.   <<forall databases>>
  106.    CASE dbfarea = {"}{dbfcount}{"}
  107.     <<if ndxtotal = 0>>
  108.       * ---<None>.
  109.     <<else>>
  110.       <<forall indexes>>
  111.       INDEX ON &NDXkey{ndxcount} TO &NDXnam{ndxcount}
  112.       <<endfor>>
  113.     <<endif>>
  114.   <<endfor>>
  115.    ENDCASE
  116. <<else>>
  117.   <<select database 1>>
  118.   <<forall indexes>>
  119.    INDEX ON &NDXkey{ndxcount} TO &NDXnam{ndxcount}
  120.   <<endfor>>
  121. <<endif>>
  122.    SET TALK OFF
  123.    * ---Close the datafile and index.
  124.    USE
  125. ENDIF
  126. DO {fileprefix}O
  127. <<end>> <<*GenPackItBody*>>
  128.  
  129. <<* EOF: SSBPACK.INC *>>
  130.