在数据库管理领域，经常需要将数据从一个格式迁移到另一个格式。例如，从DBF文件迁移到SQL Server数据库。本文将介绍一个简单的应用程序，它允许用户选择DBF数据库文件所在的文件夹，选择目标SQL Server数据库，并复制所需的表格。应用程序将创建SQL服务器数据库中的表格并复制数据。如果文件位于网络驱动器上，它还会尝试将文件复制到本地。
这个应用程序的工作原理相当简单：用户选择DBF数据库文件所在的文件夹，选择想要复制表格的SQL Server数据库，选择想要复制的表格，然后点击“复制表格”。应用程序将创建SQL服务器数据库中的表格并复制数据。如果文件位于网络驱动器上，它还会尝试将文件复制到本地。
应用程序使用Microsoft Jet OLEDB提供程序以32位模式读取数据。由于该提供程序在64位模式下无法工作，因此应用程序以32位模式编译。
DBF文件可以设置密码保护。应用程序使用JET OLEDB连接字符串属性 "Jet OLEDB:Database Password" 来处理密码。
以下是一些关键的VB.NET函数实现，这些函数使得应用程序能够读取DBF文件并将其数据导入到SQL Server数据库中。
以下是一个名为GetDbfConnectionString的VB.NET函数，它根据提供的文件夹路径和密码生成一个连接字符串。
Function GetDbfConnectionString(ByVal sFolderPath As String, ByVal sPassword As String) As String
If sFolderPath = "" Then Return ""
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
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)
Return 0
End Try
End Function
CopyTableJet函数负责实际的复制工作。如果选择的是"SQL Server2008+"，则会一次插入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 += ", "
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 += ", "
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
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
Wend
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函数将根据DBF文件创建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