Прямой доступ к DBF файлам - История изменений

SYSDBA в 09:29, 3 мая 2016

2016-05-03T09:29:47Z

SYSDBA в 09:17, 3 мая 2016

2016-05-03T09:17:46Z

SYSDBA в 09:14, 3 мая 2016

2016-05-03T09:14:05Z

SYSDBA в 09:09, 3 мая 2016

2016-05-03T09:09:28Z

Внесённые изменения

SYSDBA: Новая страница: «Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверо…»

2016-05-03T09:02:07Z

Новая страница: «Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверо…»

Новая страница

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

<syntaxhighlight lang="vbnet">
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
</syntaxhighlight>

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

<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

...
</syntaxhighlight>

← Предыдущая		Версия 09:29, 3 мая 2016
Строка 1:		Строка 1:
−	Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверов осуществляется с помощью класса '''TDBF''' (наследник '''TDataSet'''). Для упрощения работы с которым создан VBScript класс '''TvbDBF''':	+	Прямой доступ к DBF файлам без использования внешних библиотек и дополнительных драйверов осуществляется с помощью класса '''[http://tdbf.sourceforge.net/index.php TDBF]''' (наследник '''TDataSet'''). Для упрощения работы с которым создан VBScript класс '''TvbDBF''':

	<syntaxhighlight lang="vbnet">		<syntaxhighlight lang="vbnet">

@@ Строка 3: / Строка 3: @@
 <syntaxhighlight lang="vbnet">
    Class TvbDBF
-     private DBFFieldDefs
+     Private DBFFieldDefs
-     public DBF
+     Public Sub OpenTable(Path, NameTable)
-−
-    public sub OpenTable(Path, NameTable)
        DBF.Close
        DBF.FilePath = Path
        DBF.TableName = NameTable
        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.NativeFieldType = FieldType
        F.Size = Size
        F.Precision = Precision
        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.FilePath = Path
        DBF.TableName = NameTable
        DBF.TableLevel = TableLevel
-       if LangID > 0 then
+       If LangID > 0 Then
          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)
-       if AutoOpen then DBF.Open
-     end sub
+       If AutoOpen Then DBF.Open
      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
      Private Sub Class_Terminate
-    'Setup Terminate event.
+      Designer.DestroyObject(DBF)
-       Designer.DestroyObject(DBF)
+      Designer.DestroyObject(DBFFieldDefs)
-       Designer.DestroyObject(DBFFieldDefs)
      End Sub
    End Class
@@ Строка 63: / Строка 60: @@
 <syntaxhighlight lang="vbnet">
    ...
    Dim vbDbf
    Set vbdbf = New TvbDBF
@@ Строка 114: / Строка 112: @@
 <syntaxhighlight lang="vbnet">
    Dim vbDbf, dbf, Path, NameTable
-   Path = ... ' Путь к папке с файлами базы данных
+   Path =      "Путь к папке с файлами базы данных"
-   NameTable = ... ' Имя файла (таблицы)
+   NameTable = "Имя файла (таблицы)"
    Set vbDbf = New TvbDBF
-   call vbDbf.OpenTable(Path, NameTable)
+   Call vbDbf.OpenTable(Path, NameTable)
    Set dbf = vbDbf.dbf
-   while not dbf.eof
+   While Not dbf.eof
      MsgBox dbf.FieldByName("имя_поля_для_отображения").AsString
      dbf.next
-   wend
+   WEnd
    dbf.Close

@@ Строка 101: / Строка 101: @@
      dbf.FieldByName("time").AsString = ConvertTime(m_IBSQL.FieldByName("TM").AsDateTime)
      dbf.Post
      m_IBSQL.Next