Documents & code‎ > ‎

dBASE IV FileReader [O]

Дата подачи: 01.10.2009 

Info: 

[интерес представляет в контексте предыдущей темы

Заполнение DataSet данными напрямую из *.dbf файла [dBASE IV] , без какого-либо высокоуровневого провайдера данных. Очень полезно в ситуации, когда имеется только дескриптор открытого монопольно *.dbf`а, т.е. прочитать который стандартно через к примеру ODBC нет никакой возможности. Прямой разбор файла – решает все проблемы. Особенно полезно в сочетании с MDAC API (по крайней мере, при необходимости различного рода SQL-выборок) 


Детально описанные структуры dBASE III, dBASE IV, dBASE 5.0 и dBASE 7 тут: 

<urlhttp://www.delphisources.ru/pages/faq/base/dbf_file_Structure.html > 

<urlhttp://www.autopark.ru/ASBProgrammerGuide/DBFSTRUC.HTM > 




Sub ProcessingIT1(ByVal Path As [String]) 
    ' 
    Dim Idata() As [Byte] _ 
    , IDataTable As DataTable _ 
    = New DataTable() 
    ' 
    Idata = File.ReadAllBytes(Path) 
    ' 
    '--------------------------- 
    ' получаем заголовок 
    ' [IdBASEIV_HEADER]: 
    '--------------------------- 
    Dim IHeader As New IdBASEIV_HEADER 
    ' 
    Dim ptr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(IHeader)) 
    ' 
    Marshal.Copy(Idata, 0, ptr, Marshal.SizeOf(IHeader)) 
    ' 
    IHeader = Marshal.PtrToStructure(ptr, IHeader.GetType) 
    ' 
    Marshal.FreeHGlobal(ptr) 
    ' 
    For As Integer = 32 To IHeader.HeaderSize - 2 Step 32 
        ' 
        Dim IName As String _ 
        = Encoding.ASCII.GetString(Idata, i, 10).Split(vbNullString)(0) _ 
        , IType As String _ 
        = Encoding.ASCII.GetString(Idata, i + 11, 1) _ 
        ' 
        Select Case IType 
            Case "C" : IType = "System.String" 
            Case "D" : IType = "System.String" 
            Case "M" : IType = "System.String" 
            Case "F" : IType = "System.Int32" 
            Case "N" : IType = "System.Int32" 
            Case "L" : IType = "System.Boolean" 
        End Select 
        ' 
        Using IDataColumn As New DataColumn 
            IDataColumn.DataType = System.Type.GetType(IType) 
            IDataColumn.ColumnName = String.Concat(IName) 
            IDataColumn.ReadOnly = False 
            IDataColumn.Unique = False 
            IDataTable.Columns.Add(IDataColumn) 
            IDataColumn.Caption _ 
            = BitConverter.GetBytes(BitConverter.ToInt32(Idata, i + 16))(0) 
        End Using 
        ' 
    Next 
    ' 
    '------------------------- 
    ' работаем с данными, 
    ' заполняя(DataGrid) 
    '------------------------- 
    Dim IDataRow As DataRow 
    ' 
    For iRow As Integer = IHeader.HeaderSize To Idata.Length - 2 Step IHeader.RowSize 
        ' 
        Dim ofs As Integer = iRow + 1 
        ' 
        IDataRow = IDataTable.NewRow() 
        ' 
        For Icol As Integer = 0 To IDataTable.Columns.Count - 1 
            ' 
            Select Case IDataTable.Columns(Icol).DataType.GUID 
                Case GetType(String).GUID 
                    IDataRow(Icol) = String.Concat(Encoding.Default.GetString(Idata, ofs _ 
                    , CInt(IDataTable.Columns(Icol).Caption))) 
                    ' 
                Case Else 
                    IDataRow(Icol) = CInt(Encoding.ASCII.GetString(Idata, ofs _ 
                    , CInt(IDataTable.Columns(Icol).Caption))) 
                    ' 
            End Select 
            ' 
            ofs = ofs + CInt(IDataTable.Columns(Icol).Caption) 
            ' 
        Next 
        ' 
        IDataTable.Rows.Add(IDataRow) 
        ' 
    Next 
    ' 
    With DGrid 
        .AutoGenerateColumns = True 
        .DataSource = IDataTable 
    End With 
    ' 
End Sub 


Private Sub ClickMe(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TSMItem_1.Click 
    ' 
    With New OpenFileDialog 
        ' 
        .Filter = "dBASEIV files (*.dbf)I*.dbf" 
        ' 
        .InitialDirectory = Environment.SpecialFolder.System.ToString 
        ' 
        .ShowDialog() 
        ' 
        If Not (.FileName.Trim.Length = 0) Then 
            ' 
            ProcessingIT1(.FileName) 
            ' 
        End If 
        ' 
    End With 
    ' 
End Sub 






<SuppressUnmanagedCodeSecurity()> _ 
Public NotInheritable Class IdBASEIV 

    '------------------------ 
    'I Структура заголовка файла данных 
    'I для таблицы dBASE IV: 
    'I-----I 
    'I- 1 -I 
    'I-----I 
    <StructLayout(LayoutKind.Sequential, Size:=32)> _ 
    Public Structure IdBASEIV_HEADER 
        Dim [DATA] As IdBASEIV_DATA _ 
        , [T1] As Integer _ 
        , HeaderSize, RowSize As Int16 
        ' 
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=16)> _ 
        Public [T2]() As Byte 
        ' 
        Dim [T3], [T4] _ 
        , [T5], [T6] As Byte 
        ' 
    End Structure 

    '----------- 
    'I DATA 
    '----------- 
    <StructLayout(LayoutKind.Sequential, Size:=3)> _ 
    Public Structure IdBASEIV_DATA 
        Dim [YY] _ 
        , [MM] _ 
        , [DD] As Byte 
    End Structure 

End Class 





Пример::читаем справочник сотрудники [1С:: демонстрационная база

 



THE END. 
ċ
dB4_2.rar
(26k)
DMITRY MENSHOV,
Sep 4, 2013, 8:25 AM
Comments