Прямой доступ к DBF файлам

  Class TvbDBF
    private DBFFieldDefs
 
    public DBF
 
    public sub OpenTable(Path, NameTable)
      DBF.Close
      DBF.FilePath = Path
      DBF.TableName = NameTable
      DBF.Open
    end sub
 
    private sub AddField(FieldName, FieldType, Size, Precision, Required)
      dim F
 
      set F = DBFFieldDefs.AddFieldDefs
      F.FieldName = FieldName
      F.NativeFieldType = FieldType
      F.Size = Size
      F.Precision = Precision
      F.Required = Required
 
    end sub
 
    public sub CreateTable(Path, NameTable, TableLevel, LangID, Fields, AutoOpen)
      dim i
      DBF.Close
      DBF.FilePath = Path
      DBF.TableName = NameTable
      DBF.TableLevel = TableLevel
      if LangID > 0 then
        DBF.LanguageID = LangID
      end if
 
      for i = LBound(Fields, 1) to UBound(Fields, 1)
        call AddField(Fields(i)(0), Fields(i)(1), Fields(i)(2), Fields(i)(3), Fields(i)(4))
      next
 
      DBF.CreateTableEx(DBFFieldDefs)
      if AutoOpen then DBF.Open
    end sub
 
    Private Sub Class_Initialize
    'Setup Initialize event.
      set DBF = Designer.CreateObject(NULL, "TDBF", "")
      set DBFFieldDefs = Designer.CreateObject(DBF, "TDBFFieldDefs", "")
 
    End Sub
 
    Private Sub Class_Terminate
    'Setup Terminate event.
       Designer.DestroyObject(DBF)
       Designer.DestroyObject(DBFFieldDefs)
    End Sub
  End Class

  ...
  Dim vbDbf
  Set vbdbf = New TvbDBF
  Call vbDbf.CreateTable(TmpDir, TableName & ".dbf", 4, 101, _
  Array(Array("cashid", "C", 6, 0, False), _
        Array("zid", "C", 6, 0, False), _
        Array("checkid", "C", 6, 0, False), _
        Array("id", "C", 6, 0, False), _
        Array("date", "D", 8, 0, False), _
        Array("articul", "C", 4, 0, False), _
        Array("quantity", "N", 16, 6, False), _
        Array("pricerub", "N", 16, 2, False), _
        Array("totalrub", "N", 16, 2, False), _
        Array("casher", "C", 4, 0, False), _
        Array("operation", "N", 6, 0, False), _
        Array("card", "C", 10, 0, False), _
        Array("tn", "C", 6, 0, False), _
        Array("time", "C", 4, 0, False)), True)
 
  Dim dbf
  Set dbf = vbDbf.dbf
 
  While Not m_IBSQL.Eof
    dbf.Append
    dbf.FieldByName("cashid").AsString = m_IBSQL.FieldByName("USR$CASHNUMBER").AsString
    dbf.FieldByName("zid").AsString = m_IBSQL.FieldByName("USR$SHIFTNUMBER").AsString
    dbf.FieldByName("checkid").AsString = m_IBSQL.FieldByName("OrderNumber").AsString
    dbf.FieldByName("id").AsString = "1"
    dbf.FieldByName("date").AsDateTime = m_IBSQL.FieldByName("USR$LOGICDATE").AsDateTime
    dbf.FieldByName("articul").AsString = ""
    dbf.FieldByName("quantity").AsCurrency = 0
    dbf.FieldByName("pricerub").AsCurrency = 0
    dbf.FieldByName("totalrub").AsCurrency = 0
    dbf.FieldByName("casher").AsString = ""
    dbf.FieldByName("operation").AsInteger = 5
    dbf.FieldByName("card").AsString = ""
    dbf.FieldByName("tn").AsString = m_IBSQL.FieldByName("StaffTabNum").AsString
    dbf.FieldByName("time").AsString = ConvertTime(m_IBSQL.FieldByName("TM").AsDateTime)
    dbf.Post
 
    If Not IsSilentMode Then
      m_ProgressBar.Note = _
        "Выгружено позиций " & m_ProgressBar.Position & " из " & m_ProgressBar.Max
      m_ProgressBar.StepIt
 
      If m_ProgressBar.Canceled Then
        m_ProgressBar.Close
        AtlantLog.FileName = "Export"
        AtlantLog.RecordType = "Выгрузка"
        AtlantLog.RecordInfo = ExportName
        AtlantLog.Description = "Прервано пользователем"
        AtlantLog.Result = 1
        AtlantLog.Add
 
        If Transaction.InTransaction Then Transaction.Rollback
        Exit Sub
      End If
    End If
 
    m_IBSQL.Next
  Wend
 
  dbf.Close
 
  ...

  Dim vbDbf, dbf, Path, NameTable
  Path = ... ' Путь к папке с файлами базы данных
  NameTable = ... ' Имя файла (таблицы)
 
  Set vbDbf = New TvbDBF
  call vbDbf.OpenTable(Path, NameTable)
 
  Set dbf = vbDbf.dbf     
 
  while not dbf.eof
 
    MsgBox dbf.FieldByName("имя_поля_для_отображения").AsString
 
    dbf.next
  wend
 
  dbf.Close