Базы данных

Вопрос

Как програмно создавать базы данных .DBF формата 3 или 4?

Ответ

Вот как создать DBF-файл. Просто вызовите процедуру CreateDBF и в качестве первого параметра укажите имя файла, а в качестве второго параметра имя, длину и тип полей, например:

CreateDBF("C:\Temp\base.dbf", "NAME-C-20|NUM-N-5|DATE-D|FLAG-L|MEMO-M|"

В этом примере будет создан DBF-файл с полями: NAME, NUM, DATE, FLAG и MEMO. Тип C — string, N — integer, D — date, L — boolean, M — memo. Т.е. формат такой:

ИМЯ_ПОЛЯ-ТИП_ПОЛЯ-ДЛИНА_ПОЛЯ.

Option Explicit

Public Sub CreateDBF(FileName As String, Fields As String)

Dim FileNum As Integer
Dim FieldName As String
Dim FieldPos As Integer
Dim FieldsCount As Integer
Dim Field As String
Dim Sym As String * 1
Dim Pos As Long
Dim i As Integer
Dim B As Byte
Dim S As String
Dim L As Integer

FileNum = FreeFile
Open FileName For Output As FileNum
Close #FileNum
FileNum = FreeFile
Open FileName For Binary As FileNum
L = 0
Do While True
L = InStr(L + 1, Fields, "|")
If L = 0 Then Exit Do
FieldsCount = FieldsCount + 1
Loop
If Right(Fields, 1) <> "|" Then Fields = Fields + "|"
If FieldsCount > 255 Then FieldsCount = 255
S = String((B + 1) * 32, Chr(0))
Put #FileNum, 1, S
FieldPos = 1
L = 0
For i = 1 To FieldsCount
Pos = i * 32 + 1
Fields = Mid(Fields, L + 1)
L = InStr(1, Fields, "|")
S = Left(Fields, L — 1)
B = InStr(1, S, "-")
If B = 0 Then Exit For
FieldName = Left(S, B — 1)
Sym = UCase(Mid(S, B + 1, 1))
Select Case Sym
   Case "C", "N"
     B = InStr(B + 1, S, "-")
     B = Val(Mid(Fields, B + 1))
     If B = 0 Then Exit For
   Case "D"
     B = 8
   Case "L"
     B = 1
   Case "M"
     B = 10
   Case Else
     Exit For
End Select
Put #FileNum, Pos, FieldName
Put #FileNum, Pos + 11, Sym
Put #FileNum, , FieldPos
Put #FileNum, Pos + 16, B
FieldPos = FieldPos + B
Next
If i < FieldsCount + 1 Then
MsgBox "I?eia?u caaaiey iiey:" + Chr(13) + Chr(13) + _
" NAME-C-20|" + Chr(13) + _
" NUM-N-5|" + Chr(13) + _
" DATE-D|" + Chr(13) + _
" FLAG-L|" + Chr(13) + _
" MEMO-M|", _
  vbExclamation, "Ioeaea i?e caaaiee iiey" + Str(i)
Exit Sub
End If
Put #FileNum, 11, FieldPos
B = 3
Put #FileNum, 1, B
B = Year(Now) Mod 100
Put #FileNum, , B
B = Month(Now)
Put #FileNum, , B
B = Day(Now)
Put #FileNum, , B
L = (FieldsCount + 1) * 32 + 1
Put #FileNum, 9, L
B = 13
Put #FileNum, L, B
Close #FileNum

End Sub

Rutshtein Alex