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

Материал из GedeminWiki
(Различия между версиями)
Перейти к: навигация, поиск
(Новая страница: «Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверо…»)
 
 
(не показаны 3 промежуточные версии 1 участника)
Строка 1: Строка 1:
−
Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверов осуществляется с помощью класса TDBF. Для упрощения работы с которым создан VBScript класс TvbDBF:
+
Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверов осуществляется с помощью класса '''[http://tdbf.sourceforge.net/index.php TDBF]''' (наследник '''TDataSet'''). Для упрощения работы с которым создан VBScript класс '''TvbDBF''':
  
 
<syntaxhighlight lang="vbnet">
 
<syntaxhighlight lang="vbnet">
−
        Option Explicit
+
  Class TvbDBF
−
        Class TvbDBF
+
    Private DBFFieldDefs
−
          private DBFFieldDefs
+
    Public DBF
−
         
+
   
−
          public DBF
+
    Public Sub OpenTable(Path, NameTable)
−
         
+
      DBF.Close
−
          public sub OpenTable(Path, NameTable)
+
      DBF.FilePath = Path
−
            DBF.Close
+
      DBF.TableName = NameTable
−
            DBF.FilePath = Path
+
      DBF.Open
−
            DBF.TableName = NameTable
+
    End Sub
−
            DBF.Open
+
   
−
          end sub
+
    Private Sub AddField(FieldName, FieldType, Size, Precision, Required)
−
         
+
      Dim F
−
          private sub AddField(FieldName, FieldType, Size, Precision, Required)
+
     
−
            dim F
+
      Set F = DBFFieldDefs.AddFieldDefs
−
           
+
      F.FieldName = FieldName
−
            set F = DBFFieldDefs.AddFieldDefs
+
      F.NativeFieldType = FieldType
−
            F.FieldName = FieldName
+
      F.Size = Size
−
            F.NativeFieldType = FieldType
+
      F.Precision = Precision
−
            F.Size = Size
+
      F.Required = Required    
−
            F.Precision = Precision
+
    End Sub
−
            F.Required = Required
+
   
−
           
+
    Public Sub CreateTable(Path, NameTable, TableLevel, LangID, Fields, AutoOpen)
−
          end sub
+
      Dim i
−
         
+
 
−
          public sub CreateTable(Path, NameTable, TableLevel, LangID, Fields, AutoOpen)
+
      DBF.Close
−
            dim i
+
      DBF.FilePath = Path
−
            DBF.Close
+
      DBF.TableName = NameTable
−
            DBF.FilePath = Path
+
      DBF.TableLevel = TableLevel
−
            DBF.TableName = NameTable
+
      If LangID > 0 Then
−
            DBF.TableLevel = TableLevel
+
        DBF.LanguageID = LangID
−
            if LangID > 0 then
+
      End If
−
              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))
−
            for i = LBound(Fields, 1) to UBound(Fields, 1)
+
      Next
−
              call AddField(Fields(i)(0), Fields(i)(1), Fields(i)(2), Fields(i)(3), Fields(i)(4))
+
     
−
            next
+
      DBF.CreateTableEx(DBFFieldDefs)
−
           
+
 
−
            DBF.CreateTableEx(DBFFieldDefs)
+
      If AutoOpen Then DBF.Open
−
            if AutoOpen then DBF.Open
+
    End Sub
−
          end sub
+
   
−
         
+
    Private Sub Class_Initialize
−
          Private Sub Class_Initialize
+
      Set DBF = Designer.CreateObject(NULL, "TDBF", "")
−
          'Setup Initialize event.
+
      Set DBFFieldDefs = Designer.CreateObject(DBF, "TDBFFieldDefs", "")
−
            set DBF = Designer.CreateObject(NULL, "TDBF", "")
+
    End Sub
−
            set DBFFieldDefs = Designer.CreateObject(DBF, "TDBFFieldDefs", "")
+
 
−
           
+
    Private Sub Class_Terminate
−
          End Sub
+
      Designer.DestroyObject(DBF)
−
       
+
      Designer.DestroyObject(DBFFieldDefs)
−
          Private Sub Class_Terminate
+
    End Sub
−
          'Setup Terminate event.
+
  End Class
−
            Designer.DestroyObject(DBF)
+
−
            Designer.DestroyObject(DBFFieldDefs)
+
−
          End Sub
+
−
        End Class
+
 
</syntaxhighlight>
 
</syntaxhighlight>
  
Строка 63: Строка 59:
  
 
<syntaxhighlight lang="vbnet">
 
<syntaxhighlight lang="vbnet">
−
            ...
+
  ...
−
            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
 +
  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
 +
 
 +
    m_IBSQL.Next
 +
  Wend
 +
 
 +
  dbf.Close
 +
 
 +
  ...  
 
</syntaxhighlight>
 
</syntaxhighlight>
 +
 +
Пример чтения DBF файла:
 +
 +
<syntaxhighlight lang="vbnet">
 +
  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
 +
</syntaxhighlight>
 +
 +
[[Category:VBScript]]
 +
[[Category:Учебный курс]]
 +
[[Category:Импорт/экспорт данных]]

Текущая версия на 12:29, 3 мая 2016

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

  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
      Set DBF = Designer.CreateObject(NULL, "TDBF", "")
      Set DBFFieldDefs = Designer.CreateObject(DBF, "TDBFFieldDefs", "")
    End Sub
 
    Private Sub Class_Terminate
      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
 
    m_IBSQL.Next
  Wend
 
  dbf.Close
 
  ...

Пример чтения DBF файла: 

  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
Источник — «https://gsbelarus.com:80/gs/wiki/index.php?title=%D0%9F%D1%80%D1%8F%D0%BC%D0%BE%D0%B9_%D0%B4%D0%BE%D1%81%D1%82%D1%83%D0%BF_%D0%BA_DBF_%D1%84%D0%B0%D0%B9%D0%BB%D0%B0%D0%BC&oldid=6878»
Персональные инструменты
Пространства имён

Варианты
Действия
Навигация
Инструменты