home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / pack_s87.zip / SAFEPACK.PRG next >
Text File  |  1988-04-02  |  2KB  |  97 lines
  1. * Routine to safely remove deleted records from DBFs under clipper
  2. * Procedure Safepack
  3. *
  4. *                        By:   Walt Morgan
  5. *                              Morgan & Associates
  6. *                              PO Box 353
  7. *                              Lawrenceburg, TN  38464
  8. *                              (615) 762-3300
  9. *
  10. *-- Sample uses of FOPEN, FREAD, and FCLOSE Functions in Clipper '87
  11. *
  12. PARAMETERS MFILE
  13. IF PCOUNT() != 1
  14.    @ 0,0 CLEAR
  15.    ACCEPT "Enter Name of DBF to be Packed:  " to mfile
  16. ELSE
  17.    @ 0,0 CLEAR
  18. ENDIF
  19.  
  20. MFILE = UPPER(LTRIM(TRIM(MFILE)))
  21.  
  22. IF LEN(TRIM(MFILE)) = 0
  23.    RETURN
  24. ENDIF
  25.  
  26. IF AT(".",MFILE) > 0
  27.    MFILE = SUBSTR(MFILE,1,AT(".",MFILE) - 1)
  28. ENDIF
  29.  
  30. MMEMO = MFILE + ".DBT"
  31. MFILE = MFILE + ".DBF"
  32. ? MFILE
  33. *-- TEST FOR ASSOCIATED .DBT FILE (MEMO FIELDS IN DBF)
  34. HANDLE = FOPEN("&MFILE",0)      && OPEN .DBF FILE FOR READ-ONLY
  35. IF FERROR() != 0
  36.    ? 'Cannot open file, DOS Error: '+ LTRIM(TRIM(STR(FERROR())))
  37.    INKEY(0)
  38.    RETURN
  39. ELSE
  40.    ? 'File open...'
  41. ENDIF
  42.  
  43. *-- Determine if file has an associated .DBT file (Memo fields in DBF)
  44. *-- Read in first byte of DBF Header
  45. BLOCK  = 1
  46. BUFFER = SPACE(2)
  47. BYTES = FREAD(HANDLE,@BUFFER,BLOCK)
  48. IF BUFFER = CHR(131)       && â = 83h = Associated .DBT File   = 03h = None
  49.    ?? ' Has an associated .DBT file'
  50. ELSE
  51.    ?? ' Has no associated .DBT file'
  52. ENDIF
  53. FCLOSE(HANDLE)
  54.  
  55. ?? ' ...File closed'
  56.  
  57. IF .NOT. FILE("&MFILE")
  58.    ? MFILE + ' File Not Found...Press Any Key to Continue'
  59.    INKEY(0)
  60.    RETURN
  61. ENDIF
  62.  
  63. IF BUFFER = CHR(131) .AND. .NOT. FILE("&MMEMO")
  64.    ? MMEMO + ' File Not Found...Press Any Key to Continue'
  65.    INKEY(0)
  66.    RETURN
  67. ENDIF
  68. mrow=row()
  69. mcol=col()
  70. MSELECT = SELECT()
  71.  
  72. SELECT 0
  73. @ mrow,mcol say ''
  74. USE &MFILE
  75. ORIGRECS = RECCOUNT()
  76. COUNT FOR DELETED() TO DELERECS
  77. SET DELETED ON
  78. COPY TO _TEMP.TMP
  79. USE _TEMP.TMP
  80. NEWRECS = RECCOUNT()
  81. USE
  82. IF (NEWRECS + DELERECS) = ORIGRECS
  83.    !DEL &MFILE
  84.    !REN _TEMP.TMP &MFILE
  85.    IF FILE ("_TEMP.DBT")
  86.       ! DEL &MMEMO
  87.       ! REN _TEMP.DBT  &MMEMO
  88.    ENDIF
  89.    packmsg = 'File has been sucessfully packed'
  90. ELSE
  91.    packmsg = "File Could Not Be Packed...Press Any Key to Continue"
  92.    INKEY(0)
  93. ENDIF
  94. @ 5,0 say packmsg
  95. SELECT(MSELECT)
  96. RETURN
  97.