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

Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверов осуществляется с помощью класса TDBF. Для упрощения работы с которым создан VBScript класс TvbDBF:

        Option Explicit
        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

Пример создания таблицы и заполнения ее данными из SQL запроса (сам запрос в примере не приведен):

            ...
            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
 
            ...