Работа с данными

***************************************************************
* fixreccount.prg
*
* Title:
*     Check and fix header record counter of a table
*
* Author(s): 
*     Shirokov A.V.
*
* Syntax:
*     do fixreccount [with tcTableName[, tlNeedInfo = .f.]]
*
* Parameters:
*     tcTableName - a table name
*     tlNeedInfo - flag "need debug info". Default .f.
*
* Example:
*     set printer to log.txt
*     set printer on
*     do fixreccount with "test.dbf", .t.
*     set printer off
*     set printer to
*
***************************************************************
* FOPEN's constants
*
*     0     (Default) Read Only     Buffered
#define FA_READONLY 0
*     1     Write-Only     Buffered
#define FA_WRITEONLY 1
*     2     Read and Write     Buffered
#define FA_READWRITE 2
*     10     Read-Only     Unbuffered
#define FA_READONLY_DIRECT 10
*     11     Write-Only     Unbuffered
#define FA_WRITEONLY_DIRECT 11
*     12     Read and Write     Unbuffered
#define FA_READWRITE_DIRECT 12
* FSEEK's constants
*
*     0     (Default) The beginning of the file.
#define FS_BEGIN 0
*     1     The current file pointer position
#define FS_CURRENT 1
*     2     The end of the file
#define FS_END 2
lparam tcFile, tlNeedInfo
private all
if type('m.tcFile') != 'C'
     tcFile = getfile("DBF", "Browse table")
     if empty(m.tcFile)
          return
     endif
endif
lnFile = fopen(m.tcFile, FA_READWRITE)
if m.lnFile = -1
     =MessageBox("Could not open "+m.tcFile, 16, "Error")
     return
endif
lnByte = asc(fread(m.lnFile, 1))
if not inlist(m.lnByte, ;
     0*16+2,      ; &&     FoxBASE
     0*16+3,      ; &&     FoxBASE+/dBASE III PLUS, no memo
     3*16+0,      ; &&     Visual FoxPro
     4*16+3,          ; &&     dBASE IV SQL table files, no memo
     6*16+3,      ; &&     dBASE IV SQL system files, no memo
     8*16+3,          ; &&     FoxBASE+/dBASE III PLUS, with memo
     8*16+11,      ; &&     dBASE IV with memo
     12*16+11,     ; &&     dBASE IV SQL table files, with memo
     15*16+5,      ; &&     FoxPro 2.x (or earlier) with memo
     15*16+11     ; &&     FoxBASE
     )

     =MessageBox("The file '" + m.tcFile + "' is not DBF", 16, "Error")
     fclose(m.lnFile)
     return
endif
=fseek(m.lnFile, 0, FS_BEGIN)
lnSize = fseek(m.lnFile, 0, FS_END)
lnRecCount = 0
fseek(m.lnFile, 4, FS_BEGIN) 
for lnIndex = 1 to 4
   lnByte = asc(fread(m.lnFile, 1))
   lnRecCount = bitor(m.lnRecCount, bitlshift(m.lnByte, 8*(m.lnIndex-1)))
endfor   
lnDataStart = 0
for lnIndex = 1 to 2
   lnByte = asc(fread(m.lnFile, 1))
   lnDataStart = bitor(m.lnDataStart, bitlshift(m.lnByte, 8*(m.lnIndex-1)))
endfor   
lnRecLength = 0
for lnIndex = 1 to 2
   lnByte = asc(fread(m.lnFile, 1))
   lnRecLength = bitor(m.lnRecLength, bitlshift(m.lnByte, 8*(m.lnIndex-1)))
endfor   
lnDataSize = m.lnSize - m.lnDataStart
lnFactRecCount = int(m.lnDataSize/m.lnRecLength)
lnAnswer = 0
if m.lnFactRecCount != m.lnRecCount
     lnAnswer = MessageBox(m.tcFile + chr(13) + "Do fix record counter?", 3+32, "Question")
     if m.lnAnswer == 6
          fseek(m.lnFile, 4, FS_BEGIN)      
          for lnIndex=1 to 4
               lnByte = bitand(bitrshift(m.lnFactRecCount, 8*(m.lnIndex-1)), 255)
               fwrite(m.lnFile, chr(m.lnByte), 1)
          endfor          
     endif
endif
fclose(m.lnFile)
if m.tlNeedInfo
     ? "FIXRECCOUNT FOR "+alltrim(m.tcFile) 
     ? replicate("=", 80)
     ? "Size", m.lnSize 
     ? "Data Start", m.lnDataStart
     ? "Data Size = Size - Data Start = ", m.lnSize, "-", m.lnDataStart, " = ", m.lnDataSize 
     ? "Record Length", m.lnRecLength
     ? "Header Record Count", m.lnRecCount
     ? "Fact Record Count = Data Size / Record Length = ", m.lnDataSize, "/", m.lnRecLength,
"=",m.lnFactRecCount
     if m.lnFactRecCount = m.lnRecCount
          ? "NO NEED FIX"
     else
          ? iif(m.lnAnswer == 6, "FIXED", "FIX IS SKIPED")
     endif
endif
return m.lnAnswer == 6

Автор публикации

не в сети 22 года

AnatolyS

Комментарии: 0Публикации: 1Регистрация: 21-01-2002