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

Материал из GedeminWiki
(Различия между версиями)
Перейти к: навигация, поиск
 
(не показаны 2 промежуточные версии 1 участника)
Строка 1: Строка 1:
−
Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверов осуществляется с помощью класса '''TDBF''' (наследник '''TDataSet'''). Для упрощения работы с которым создан VBScript класс '''TvbDBF''':
+
Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверов осуществляется с помощью класса '''[http://tdbf.sourceforge.net/index.php TDBF]''' (наследник '''TDataSet'''). Для упрощения работы с которым создан VBScript класс '''TvbDBF''':
  
 
<syntaxhighlight lang="vbnet">
 
<syntaxhighlight lang="vbnet">
 
   Class TvbDBF
 
   Class TvbDBF
−
     private DBFFieldDefs
+
     Private DBFFieldDefs
 +
    Public DBF
 
      
 
      
−
     public DBF
+
     Public Sub OpenTable(Path, NameTable)
−
   
+
−
    public sub OpenTable(Path, NameTable)
+
 
       DBF.Close
 
       DBF.Close
 
       DBF.FilePath = Path
 
       DBF.FilePath = Path
 
       DBF.TableName = NameTable
 
       DBF.TableName = NameTable
 
       DBF.Open
 
       DBF.Open
−
     end sub
+
     End Sub
 
      
 
      
−
     private sub AddField(FieldName, FieldType, Size, Precision, Required)
+
     Private Sub AddField(FieldName, FieldType, Size, Precision, Required)
−
       dim F
+
       Dim F
 
        
 
        
−
       set F = DBFFieldDefs.AddFieldDefs
+
       Set F = DBFFieldDefs.AddFieldDefs
 
       F.FieldName = FieldName
 
       F.FieldName = FieldName
 
       F.NativeFieldType = FieldType
 
       F.NativeFieldType = FieldType
 
       F.Size = Size
 
       F.Size = Size
 
       F.Precision = Precision
 
       F.Precision = Precision
−
       F.Required = Required
+
       F.Required = Required    
−
     
+
     End Sub
−
     end sub
+
 
      
 
      
−
     public sub CreateTable(Path, NameTable, TableLevel, LangID, Fields, AutoOpen)
+
     Public Sub CreateTable(Path, NameTable, TableLevel, LangID, Fields, AutoOpen)
−
       dim i
+
       Dim i
 +
 
 
       DBF.Close
 
       DBF.Close
 
       DBF.FilePath = Path
 
       DBF.FilePath = Path
 
       DBF.TableName = NameTable
 
       DBF.TableName = NameTable
 
       DBF.TableLevel = TableLevel
 
       DBF.TableLevel = TableLevel
−
       if LangID > 0 then
+
       If LangID > 0 Then
 
         DBF.LanguageID = LangID
 
         DBF.LanguageID = LangID
−
       end if
+
       End If
 
    
 
    
−
       for i = LBound(Fields, 1) to UBound(Fields, 1)
+
       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))
+
         Call AddField(Fields(i)(0), Fields(i)(1), Fields(i)(2), Fields(i)(3), Fields(i)(4))
−
       next
+
       Next
 
        
 
        
 
       DBF.CreateTableEx(DBFFieldDefs)
 
       DBF.CreateTableEx(DBFFieldDefs)
−
       if AutoOpen then DBF.Open
+
 
−
     end sub
+
       If AutoOpen Then DBF.Open
 +
     End Sub
 
      
 
      
 
     Private Sub Class_Initialize
 
     Private Sub Class_Initialize
−
    'Setup Initialize event.
+
       Set DBF = Designer.CreateObject(NULL, "TDBF", "")
−
       set DBF = Designer.CreateObject(NULL, "TDBF", "")
+
       Set DBFFieldDefs = Designer.CreateObject(DBF, "TDBFFieldDefs", "")
−
       set DBFFieldDefs = Designer.CreateObject(DBF, "TDBFFieldDefs", "")
+
−
     
+
 
     End Sub
 
     End Sub
 
    
 
    
 
     Private Sub Class_Terminate
 
     Private Sub Class_Terminate
−
    'Setup Terminate event.
+
      Designer.DestroyObject(DBF)
−
      Designer.DestroyObject(DBF)
+
      Designer.DestroyObject(DBFFieldDefs)
−
      Designer.DestroyObject(DBFFieldDefs)
+
 
     End Sub
 
     End Sub
 
   End Class
 
   End Class
Строка 63: Строка 60:
 
<syntaxhighlight lang="vbnet">
 
<syntaxhighlight lang="vbnet">
 
   ...
 
   ...
 +
 
   Dim vbDbf
 
   Dim vbDbf
 
   Set vbdbf = New TvbDBF
 
   Set vbdbf = New TvbDBF
Строка 101: Строка 99:
 
     dbf.FieldByName("time").AsString = ConvertTime(m_IBSQL.FieldByName("TM").AsDateTime)
 
     dbf.FieldByName("time").AsString = ConvertTime(m_IBSQL.FieldByName("TM").AsDateTime)
 
     dbf.Post
 
     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
 
     m_IBSQL.Next
Строка 133: Строка 112:
 
<syntaxhighlight lang="vbnet">
 
<syntaxhighlight lang="vbnet">
 
   Dim vbDbf, dbf, Path, NameTable
 
   Dim vbDbf, dbf, Path, NameTable
−
   Path = ... ' Путь к папке с файлами базы данных
+
   Path =     "Путь к папке с файлами базы данных"
−
   NameTable = ... ' Имя файла (таблицы)
+
   NameTable = "Имя файла (таблицы)"
  
 
   Set vbDbf = New TvbDBF
 
   Set vbDbf = New TvbDBF
−
   call vbDbf.OpenTable(Path, NameTable)
+
   Call vbDbf.OpenTable(Path, NameTable)
  
 
   Set dbf = vbDbf.dbf     
 
   Set dbf = vbDbf.dbf     
 
    
 
    
−
   while not dbf.eof
+
   While Not dbf.eof
  
 
     MsgBox dbf.FieldByName("имя_поля_для_отображения").AsString
 
     MsgBox dbf.FieldByName("имя_поля_для_отображения").AsString
 
      
 
      
 
     dbf.next
 
     dbf.next
−
   wend
+
   WEnd
 
    
 
    
 
   dbf.Close
 
   dbf.Close

Текущая версия на 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»
Персональные инструменты
Пространства имён

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