* 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=.f.
 tcfile=''
*private all
*if type('m.tcFile') != 'C'
_Screen.Visible=.T.

     tcFile = getfile("DBF", "Выбор таблицы","Открыть", 0 )
     if empty(m.tcFile)
          return
     endif
*endif

lnFile = fopen(m.tcFile, FA_READWRITE)
if m.lnFile = - 1 

     =MessageBox("Не могу открыть "+m.tcFile,  16 , "Ошибка")
     return
ENDIF
SET STEP ON 
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("Этот файл " + m.tcFile + " не DBF",  16 , "Ошибка")
     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 ) + "Восстановить заголовок?",  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

   ct1= "Восстановление заголовка для "+alltrim(m.tcFile)
   ct2= replicate("=",  80 )
   ct3= "Объем="+STR(m.lnSize)
   ct4= "Начало данных "+STR(m.lnDataStart)
   ct5= "Объем данных = Объем - начало данных = "+STR(m.lnSize)+ "  -"+STR(m.lnDataStart)+ " = "+STR(m.lnDataSize)
   ct6= "Длина записи="+STR(m.lnRecLength)
   ct7= "Число записей в заголовке="+STR(m.lnRecCount)
   ct8= "Фактическое число записей = Объем данных / Длина записи = "+Str(m.lnDataSize)+ "/"+STR(m.lnRecLength)+ "="+STR(m.lnFactRecCount)
     if m.lnFactRecCount = m.lnRecCount
        ct9= "Не надо восстанавливать"
     else
        ct9= iif(m.lnAnswer ==  6 , "Восстановлено", "Восстановление пропущено")
     ENDIF
    =MESSAGEBOX(ct1+ chr( 13 )+ct2+ chr( 13 )+ct3+ chr( 13 )+ct4+ chr( 13 )+ct5+ chr( 13 )+ct6+ chr( 13 )+ct7+ chr( 13 )+ct8+ chr( 13 )+ct9, 64 )
endif
return m.lnAnswer ==  6