v7: Доступ через vfpoledb.1 к таблице DBF

 * Назначение :     Приведение в соответствие значение количества записей   
 *        в заголовке таблице и реального количества записей  
 * Автор :     Владимир Максимов  
 * Дата :     31.08.2008  
 * Версия FoxPro: Visual FoxPro с 3 по 9  
 *        Возможно, этот код будет работать и в версиях FoxPro 2.x  
 *        если убрать объявления LOCAL и MessageBox()   
 *        Но это не проверялось  
 *********************************************************************  
    

 * для младших версий FoxPro его надо удалить  
  Local lcFileName  
  lcFileName = GetFile("DBF","","",0,"Выбор файла для проверки количества записей")  
  If Empty(m.lcFileName)  
     * Файл не был выбран  
      Return  
  EndIf  
    
 * Открываю файл и запоминаю его дескриптор (идентификатор)  
  Local lnFD  
  lnFD = Fopen(m.lcFileName,12)  
  If m.lnFD < 0  
      MessageBox("Не удалось открыть файл" + Chr(13) + ;  
          m.lcFileName + Chr(13) + ;  
          "Возможно, он открыт другим приложением")  
  EndIf  
    
 * Теоретически, здесь хорошо бы добавить проверку на тот факт,   
 * что данный файл - это DBF-таблица (анализ первого байта)  
 * Но в данном случае предполагается, что пользователь понимает, что он делает  
 * Если, тем не менее, Вы хотите создать универсальную утилиту, то  
 * посмотрите код программы CPZERO.PRG из поставки FoxPro.  
 * Эта программа находится в каталоге TOOLS\CPZERO корневой папки FoxPro  
    
 * Определяю количество записей записанное в заголовке файла  
 * байты с 4 по 7  
  LOCAL lnReccount  
  =FSEEK(m.lnFD,4)  
  lnReccount =    ASC(FREAD(m.lnFD,1)) + ;  
          ASC(FREAD(m.lnFD,1)) * 256 + ;  
          ASC(FREAD(m.lnFD,1)) * 256 * 256 + ;  
          ASC(FREAD(m.lnFD,1)) * 256 * 256 * 256  
                
 * Определяю позицию, с которой начинается собственно данные (первая запись)  
 * байты с 8 по 9  
  LOCAL lnDataStart  
  lnDataStart =     ASC(FREAD(m.lnFD,1)) + ;  
          ASC(FREAD(m.lnFD,1)) * 256  
    
 * Определяю количество символов в одной записи, включая метку на удаление  
 * байты с 10 по 11  
  LOCAL lnRecLength  
  lnRecLength =    ASC(FREAD(m.lnFD,1)) + ;  
          ASC(FREAD(m.lnFD,1)) * 256  
    
 * Определяю общий размер файла, через порядковый номер последнего байта  
  LOCAL lnFileSize  
  =FSEEK(m.lnFD,0,0)  
  lnFileSize = FSEEK(m.lnFD,0,2)  
    
 * Определяю значение самого последнего байта файла  
  LOCAL lnEndByte  
  =FSEEK(m.lnFD,-1,1)  
  lnEndByte = ASC(FREAD(m.lnFD,1))  
    
 * И реальное количество записей в файле  
  LOCAL lnFaktCount  
  DO CASE  
  CASE m.lnFileSize = m.lnDataStart  
     * Т.е. в таблице вообще нет информации  
      lnFaktCount = 0  
  CASE m.lnEndByte = 26  
     * Если последний байт файла имеет ASCII код 26 (0x1A),   
     * то общее число информационных байтов надо уменьшить на 1  
      lnFaktCount = (m.lnFileSize - m.lnDataStart - 1) / m.lnRecLength  
  OTHERWISE  
      lnFaktCount = (m.lnFileSize - m.lnDataStart) / m.lnRecLength  
  ENDCASE  
    
    
  LOCAL lnResult  
 * Анализ полученных результатов  
  DO CASE  
  CASE INT(m.lnFaktCount) <> m.lnFaktCount  
    
     * Есть дробная часть. Т.е. выделить целое количество записей невозможно  
     * повреждения более существенные, чем разница в количестве записей  
     * лучше ничего не трогать  
      lnResult = -1  
      =Fclose(m.lnFD)  
        
      MessageBox("Выделить целое количество записей невозможно"+Chr(13) + ;  
                  "Повреждения более существенные, чем разница в количестве записей")  
    
  CASE m.lnFaktCount <> m.lnReccount  
    
     * Записанное и фактическое количество записей отличаются  
     * корректирую записанное количество записей  
      =FSEEK(m.lnFD,4,0)  
      FOR lnI=1 TO 4  
          =FWRITE(m.lnFD,CHR(MOD(INT(m.lnFaktCount / 256**(m.lnI-1)),256)))  
      ENDFOR  
    
      lnResult = 1  
      =Fclose(m.lnFD)  
    
      MessageBox("Значение количества записей исправлено")  
    
  OTHERWISE  
    
     * Ошибки в определении количества записей не обнаружено  
      lnResult=0  
      =Fclose(m.lnFD)  
    
      MessageBox("Ошибки в количестве записей не обнаружено")  
    
  ENDCASE  
    
 * Результат возвращается на случай, если есть необходимость в подобном анализе  
  RETURN m.lnResult