DBF 到 SQL Server

• 下载源代码 - 201.7 KB

引言

我开发这个应用程序是为了帮助我将 DBF 文件迁移到 SQL Server。希望其他人也能觉得这段代码有用。

背景

这个应用程序非常简单：您选择 DBF 数据库文件所在的文件夹，选择要复制表的 SQL Server 数据库，选择要复制的表，然后点击“复制表”。应用程序将在 SQL Server 数据库中创建表并复制数据。如果文件位于网络驱动器上，它还会尝试将文件复制到本地。

Using the Code

该应用程序使用 Microsoft Jet OLEDB 提供程序以 32 位模式读取数据。该提供程序在 64 位下无法工作。这就是为什么它以 32 位模式编译的原因。

DBF 文件可以设置密码保护。该应用程序使用 JET OLEDB 连接字符串属性“Jet OLEDB:Database Password”来设置密码。

    Function GetDbfConnectionString(ByVal sFolderPath As String, ByVal sPassword As String) _
        As String
        If sFolderPath = "" Then
            Return ""
        End If

        If sPassword <> "" Then
            Return "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFolderPath & ";_
            Extended Properties=dbase IV;Jet OLEDB:Database Password=" & sPassword & ";"
        Else
            Return "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sFolderPath & ";_
            Extended Properties=dbase IV;"
        End If
    End Function

函数“GetDbfRecCount”可以快速获取记录数。

    Private Function GetDbfRecCount(ByVal sFolderPath As String, _
                     ByVal sTableName As String) As Integer

        Dim sFilePath As String = IO.Path.Combine(sFolderPath, sTableName & ".dbf")

        If IO.File.Exists(sFilePath) = False Then
            Return 0
        End If

        Try
            Dim oBinaryReader As IO.BinaryReader = _
                        New IO.BinaryReader(IO.File.OpenRead(sFilePath))
            Dim buffer As Byte() = oBinaryReader.ReadBytes(Marshal.SizeOf(GetType(DBFHeader)))
            Dim handle As GCHandle = GCHandle.Alloc(buffer, GCHandleType.Pinned)
            Dim header As DBFHeader = CType(Marshal.PtrToStructure(handle.AddrOfPinnedObject(),_
                                      GetType(DBFHeader)), DBFHeader)
            handle.Free()
            oBinaryReader.Close()
            Return header.numRecords
        Catch ex As Exception
            'MsgBox(ex.Message)
        End Try

        Return 0
    End Function

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi, Pack:=1)>
    Private Structure DBFHeader
        Public version As Byte
        Public updateYear As Byte
        Public updateMonth As Byte
        Public updateDay As Byte
        Public numRecords As Int32
        Public headerLen As Int16
        Public recordLen As Int16
        Public reserved1 As Int16
        Public incompleteTrans As Byte
        Public encryptionFlag As Byte
        Public reserved2 As Int32
        Public reserved3 As Int64
        Public MDX As Byte
        Public language As Byte
        Public reserved4 As Int16
    End Structure

CopyTableJet 函数执行实际的数据复制工作。如果您选择“SQL Server 2008+”，它将一次插入 1000 条记录。

Private Sub CopyTableJet(ByVal sTableName As String, dr As OleDbDataReader, _
                         ByRef cnDst As OleDbConnection)

        Dim oSchemaRows As Data.DataRowCollection = dr.GetSchemaTable.Rows
        Dim sRow As String
        Dim i As Integer
        Dim iRow As Integer = 0
        Dim iRowCount As Integer = 0

        'Get Header
        Dim sHeader As String = ""
        For i = 0 To oSchemaRows.Count - 1
            Dim sColumn As String = oSchemaRows(i)("ColumnName")
            If i <> 0 Then
                sHeader += ", "
            End If
            sHeader += PadSqlColumnName(sColumn)
        Next

        Dim sValues As String = ""

        While dr.Read()
            iRowCount += 1
            sRow = ""

            For i = 0 To oSchemaRows.Count - 1
                If sRow <> "" Then
                    sRow += ", "
                End If

                sRow += GetValueString(dr.GetValue(i))
            Next

            If chkSQL2008.Checked Then
                If sValues <> "" Then sValues += ", "
                sValues += "(" & sRow & ")"

                If iRowCount >= 1000 Then
                    Dim sSql1 As String = "INSERT INTO " & _
                    PadSqlColumnName(sTableName) & " (" & sHeader & ") VALUES " & sValues
                    OpenConnections(cnDst)
                    ExecuteSql(sSql1, cnDst)
                    iRowCount = 0
                    sValues = ""
                End If
            Else
                Dim sSql1 As String = "INSERT INTO " & PadSqlColumnName(sTableName) & _
                                      " (" & sHeader & ") VALUES (" & sRow & ")"
                OpenConnections(cnDst)
                ExecuteSql(sSql1, cnDst)
            End If

            iRow += 1
            ProgressBar1.Value = Math.Min(ProgressBar1.Maximum, iRow)
            lbCount.Text = iRow.ToString()
            lbCount.Refresh()

            'Listen for the user to press Cancel button
            Windows.Forms.Application.DoEvents()
            If bStop Then
                Log("Copied table " & sTableName & " stopped. ")
                Exit While
            End If

        End While

        If chkSQL2008.Checked And sValues <> "" Then
            Dim sSql1 As String = "INSERT INTO " & PadSqlColumnName(sTableName) & _
                                  " (" & sHeader & ") VALUES " & sValues
            ExecuteSql(sSql1, cnDst)
        End If

    End Sub

GetCreateTableSqlFromDbf 函数将在 SQL Server 中创建表（如果该表不存在）。

    Private Function GetCreateTableSqlFromDbf_
        (ByVal sTableName As String, dr As OleDbDataReader) As String

        Dim sb As New System.Text.StringBuilder()
        Dim oSchemaRows As Data.DataRowCollection = dr.GetSchemaTable.Rows
        Dim sKeyColumns As String = ""
        Dim i As Integer = 0

        sb.Append("CREATE TABLE " & PadSqlColumnName(sTableName) & " (" & vbCrLf)

        For iCol As Integer = 0 To oSchemaRows.Count - 1
            Dim sColumn As String = oSchemaRows(iCol).Item("ColumnName").ToString() & ""
            Dim sColumnSize As String = oSchemaRows(iCol).Item("ColumnSize").ToString() & ""
            Dim sDataType As String = oSchemaRows(iCol).Item("DATATYPE").FullName.ToString()
            Dim bAllowDBNull As Boolean = _
                      oSchemaRows(iCol).Item("AllowDBNull")    'Does not always work

            If i > 0 Then
                sb.Append(",")
                sb.Append(vbCrLf)
            End If

            sb.Append(PadSqlColumnName(sColumn))
            sb.Append(" " & PadAccessDataType(sDataType, sColumnSize))

            If bAllowDBNull Then
                sb.Append(" NULL")
            Else
                sb.Append(" NOT NULL")
            End If

            i += 1
        Next

        sb.Append(")")

        If i = 0 Then
            Return ""
        Else
            Return sb.ToString()
        End If

    End Function

历史

• 2019 年 11 月 20 日：初始版本