0

我编写了以下程序，该程序读取和解析 .ged 文件（家谱数据）并将其存储在 SQLite 数据库中。该程序有效，但是当加载一个大文件时，我得到一个“内存不足异常”。我是 Visual Basic 的新手，但似乎创建的每个对象都存储在内存中，直到程序结束，因为随着程序的运行，内存使用量增加到 4 gig。

我已经搜索了所有但找不到解决方案。帮助！

我在每个服务器类中都有一个类似的 Family 和 Child 类和 subs。

人物类：

Public Class Person

Public Property ID As String
Public Property personID As String
Public Property surName As String
Public Property givenName As String
Public Property sex As String
Public Property birthDate As String
Public Property birthYear As String
Public Property birthPlace As String
Public Property deathDate As String
Public Property deathYear As String
Public Property deathPlace As String
Public Property famC As String

End Class

服务器：

Public Sub AddPerson(p As Person)
    Dim addPersonquery As String = "INSERT INTO Person(
                                         ID,
                                         PersonID,
                                         SurName,
                                         GivenName,
                                         Sex,
                                         BirthDate,
                                         BirthPlace,
                                         DeathDate,
                                         DeathPlace,
                                         FamC)
                                        VALUES(
                                        @ID,
                                        @pid,
                                        @sn,
                                        @gn,
                                        @se,
                                        @bd,
                                        @bP,
                                        @dd,
                                        @dp,
                                        @fc);"
    Using SqlConn As New SQLiteConnection(AMconnectionString)
        Dim cmd As New SQLiteCommand(addPersonquery, SqlConn)
        cmd.Parameters.AddWithValue("@ID", p.ID)
        cmd.Parameters.AddWithValue("@pid", p.personID)
        cmd.Parameters.AddWithValue("@sn", p.surName)
        cmd.Parameters.AddWithValue("@gn", p.givenName)
        cmd.Parameters.AddWithValue("@se", p.sex)
        cmd.Parameters.AddWithValue("@bd", p.birthDate)
        cmd.Parameters.AddWithValue("@bp", p.birthPlace)
        cmd.Parameters.AddWithValue("@dd", p.deathDate)
        cmd.Parameters.AddWithValue("@dp", p.deathPlace)
        cmd.Parameters.AddWithValue("@fc", p.famC)
        SqlConn.Open()
        cmd.ExecuteNonQuery()
    End Using
End Sub

主程序：

Option Strict On
Public Class GedcomParser
Dim AdamMarsServer As New Server()
Public Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    AdamMarsServer.CreateDatabase()
    Gedcomreader()
    Close()
End Sub

Private Sub Gedcomreader()
    Dim ofdbox As New OpenFileDialog()
    ofdbox.Title = "Select Your FTM Gedcom file"
    ofdbox.Filter = "gedcom Files|*.ged"
    ofdbox.InitialDirectory = (My.Computer.FileSystem.SpecialDirectories.MyDocuments)
    ofdbox.ShowDialog()
    Dim fileReader As System.IO.StreamReader
    fileReader = My.Computer.FileSystem.OpenTextFileReader(ofdbox.FileName)
    Dim stringReader As String
    Dim strRecData As String
    Dim strPlaceHolder As String
    Dim blnIndividual As Boolean
    Dim blnFamily As Boolean

    stringReader = fileReader.ReadLine()
    Do While Not stringReader = ""
        stringReader = fileReader.ReadLine()
        strPlaceHolder = stringReader
        If Strings.Left(strPlaceHolder, 1) = "0" Then
            If Len(strRecData) <> 0 Then
                If blnFamily Or blnIndividual Then
                    ParseRecord(strRecData)
                    'numpeople.Text = ProgressBar2.Value.ToString()
                    'numfam.Text = ProgressBar3.Value.ToString()
                    strRecData = ""
                    blnFamily = False
                    blnIndividual = False
                End If
            End If
            Select Case Strings.Right(strPlaceHolder, 3)
                Case "NDI"
                    blnIndividual = True
                    blnFamily = False
                    strRecData = "IND " & strPlaceHolder
                    'ProgressBar2.Increment(1)
                Case "FAM"
                    blnFamily = True
                    blnIndividual = False
                    strRecData = "FAM " & strPlaceHolder
                    'ProgressBar3.Increment(1)
            End Select

        Else
            If blnIndividual Or blnFamily Then
                strRecData = strRecData & vbCr & strPlaceHolder
            End If
        End If
    Loop
    fileReader.Close()
    MessageBox.Show("Done")
End Sub

Private Sub ParseRecord(strRecord As String)

    Dim childs As New child()
    Dim persons As New Person()
    Dim mfamily As New Family()
    Dim intPosition As Integer = 6
    Dim strData As String
    Dim strSubType As String

    Select Case Strings.Left(strRecord, 3)
        Case "IND"
            Do While intPosition <> 0
                intPosition = 1
                intPosition = InStr(intPosition, strRecord, Chr(13))

                If intPosition = 0 And Len(strRecord) > 0 Then
                    strData = strRecord
                Else
                    strData = Strings.Left(strRecord, intPosition)
                End If
                strRecord = Strings.Right(strRecord, Len(strRecord) - intPosition)

                If String.Compare(strData, 0, "IND", 0, 3) = 0 Then
                    persons.personID = Mid(strData, InStr(1, strData, "@") + 1,
                                               InStrRev(strData, "@") - InStr(1, strData, "@") - 1)

                    childs.PersonID = Mid(strData, InStr(1, strData, "@") + 1,
                                               InStrRev(strData, "@") - InStr(1, strData, "@") - 1)
                Else

                    Select Case Strings.Left(strData, 1)
                        Case "1"
                            Select Case Mid(strData, 3, 4)
                                Case "NAME"
                                    If Len(strData) = 7 Then
                                        persons.surName = ""
                                        persons.givenName = ""
                                    Else

                                        persons.surName = Mid(strData, InStr(1, strData, "/") + 1,
                                                              InStrRev(strData, "/") - InStr(1, strData, "/") - 1)
                                        Dim givName = Split(strData, "/")(0)
                                        persons.givenName = givName.Remove(0, 7)
                                    End If
                                Case "BIRT"
                                    strSubType = "BIRTH"
                                Case "DEAT"
                                    strSubType = "DEATH"
                                Case "FAMC"
                                    persons.famC = Mid(strData, InStr(1, strData, "@") + 1,
                                                           InStrRev(strData, "@") - InStr(1, strData, "@") - 1)
                                    childs.familyID = Mid(strData, InStr(1, strData, "@") + 1,
                                                           InStrRev(strData, "@") - InStr(1, strData, "@") - 1)
                                Case "SEX "
                                    persons.sex = Mid(strData, 7, 1)
                                Case Else

                            End Select

                        Case "2"
                            Select Case strSubType
                                Case "BIRTH"
                                    If Mid(strData, 3, 4) = "DATE" Then
                                        persons.birthDate = GetGenData(strData)
                                    ElseIf Mid(strData, 3, 4) = "PLAC" Then
                                        persons.birthPlace = GetGenData(strData)
                                    End If
                                Case "DEATH"
                                    If Mid(strData, 3, 4) = "DATE" Then
                                        persons.deathDate = GetGenData(strData)
                                    ElseIf Mid(strData, 3, 4) = "PLAC" Then
                                        persons.deathPlace = GetGenData(strData)
                                    End If
                                Case Else
                            End Select
                    End Select
                End If
            Loop

            AdamMarsServer.AddPerson(persons)
            AdamMarsServer.Addchild(childs)
        Case "FAM"

            Do While intPosition <> 0
                intPosition = 1
                intPosition = InStr(intPosition, strRecord, Chr(13))
                If intPosition = 0 And Len(strRecord) > 0 Then
                    strData = strRecord
                Else
                    strData = Strings.Left(strRecord, intPosition)
                End If
                strRecord = Strings.Right(strRecord, Len(strRecord) - intPosition)
                If String.Compare(strData, 0, "FAM", 0, 3) = 0 Then
                    mfamily.FamilyID = Mid(strData, InStr(1, strData, "@") + 1,
                                               InStrRev(strData, "@") - InStr(1, strData, "@") - 1)
                Else
                    Select Case Strings.Left(strData, 1)
                        Case "1"
                            Select Case Mid(strData, 3, 4)
                                Case "HUSB"
                                    mfamily.HusbandID = Mid(strData, InStr(1, strData, "@") + 1,
                                                                InStrRev(strData, "@") - InStr(1, strData, "@") - 1)
                                Case "WIFE"
                                    mfamily.WifeID = Mid(strData, InStr(1, strData, "@") + 1,
                                                             InStrRev(strData, "@") - InStr(1, strData, "@") - 1)
                                Case "MARR"
                                    strSubType = "Marriage"
                                Case Else
                            End Select
                        Case "2"
                            Select Case strSubType
                                Case "Marriage"
                                    If Mid(strData, 3, 4) = "DATE" Then
                                        mfamily.MarriageDate = GetGenData(strData)
                                    ElseIf Mid(strData, 3, 4) = "PLAC" Then
                                        mfamily.MarriagePlace = GetGenData(strData)
                                    End If
                                Case Else
                            End Select
                    End Select
                End If
            Loop
            AdamMarsServer.AddFamily(mfamily)

    End Select

End Sub

Function GetGEDNumber(GED As String) As String
    GetGEDNumber = Mid(GED, InStr(1, GED, "@") + 1, InStrRev(GED, "@") - InStr(1, GED, "@") - 1)
End Function

Function GetGenData(Data As String) As String
    GetGenData = Replace(Replace(Strings.Right(Data, Len(Data) - 7), Chr(13), ""), Chr(10), "")
End Function

结束类

这是从这个 VBA 程序中添加的：

Sub ImportGED(strFullFileName As String)
Dim fso As New Scripting.FileSystemObject
Dim filGED As Scripting.File
Dim txsGED As Scripting.TextStream
Dim strLine As String
Dim strRecData As String
Dim strPlaceHolder As String
Dim blnIndividual As Boolean
Dim blnFamily As Boolean
Dim strSubType As String

Screen.MousePointer = ccHourglass
Set filGED = fso.GetFile(strFullFileName)
Set txsGED = filGED.OpenAsTextStream(ForReading, TristateUseDefault)

Do While Not txsGED.AtEndOfStream
If Form_GetGEDFile.ProgressBar2.Value < 25 Then
    Form_GetGEDFile.ProgressBar2.Value = Form_GetGEDFile.ProgressBar2.Value + 1
Else
    Form_GetGEDFile.ProgressBar2.Value = 1
End If
Form_GetGEDFile.Repaint
Form_GetGEDFile.Refresh

strPlaceHolder = txsGED.ReadLine
If Left(strPlaceHolder, 1) = "0" Then

    If Len(strRecData) <> 0 Then
        If blnFamily Or blnIndividual Then
            ParseRecord strRecData
            strRecData = ""
            blnFamily = False
            blnIndividual = False
        End If
    End If

    Select Case Right(strPlaceHolder, 3)
        Case "NDI"
            blnIndividual = True
            blnFamily = False
            strRecData = "IND " & strPlaceHolder
        Case "FAM"
            blnFamily = True
            blnIndividual = False
            strRecData = "FAM " & strPlaceHolder
    End Select

Else
    If blnIndividual Or blnFamily Then
        strRecData = strRecData & vbCr & strPlaceHolder
    End If
End If
Loop
Form_GetGEDFile.ProgressBar2.Value = 25
txsGED.Close
Screen.MousePointer = ccDefault

End Sub

Sub ParseRecord(strRecord As String)
Dim conGen As New ADODB.Connection
Dim rstData As New ADODB.Recordset
Dim rstQuery As New ADODB.Recordset
Dim intPosition As Integer
Dim blnInSub As Boolean
Dim strData As String

intPosition = 1
conGen.Open Application.CurrentProject.BaseConnectionString


Select Case Left(strRecord, 3)
Case "IND"
    rstData.Open "Select * FROM Individuals", conGen, adOpenKeyset, adLockPessimistic
    rstData.AddNew
    Do While intPosition <> 0
        intPosition = 1
        intPosition = InStr(intPosition, strRecord, Chr(13))

        If intPosition = 0 And Len(strRecord) > 0 Then
            strData = strRecord
        Else
            strData = Left(strRecord, intPosition)
        End If
        strRecord = Right(strRecord, Len(strRecord) - intPosition)

        If Left(strData, 3) = "IND" Then
            rstData![GED ID] = Mid(strData, InStr(1, strData, "@") + 1, InStrRev(strData, "@") - InStr(1, strData, "@") - 1)
        Else
            Select Case Left(strData, 1)
                Case 1
                    Select Case Mid(strData, 3, 4)
                        Case "NAME"
                            rstData![Full Name] = Replace(GetGenData(strData), "/", "")
                            strSubType = "NAME"
                        Case "BIRT"
                            strSubType = "BIRTH"
                        Case "DEAT"
                            strSubType = "DEATH"
                        Case "FAMC"
                            rstData!Parents = GetGEDNumber(strData)
                        Case "SEX "
                            rstData!Sex = Mid(strData, 7, 1)
                    End Select
                Case 2
                    Select Case strSubType
                        Case "Name"
                            If Mid(strData, 3, 4) = "GIVN" Then
                                rstData![Given Name] = GetGenData(strData)
                            ElseIf Mid(strData, 3, 4) = "SURN" Then
                                rstData!Surname = GetGenData(strData)
                            End If
                        Case "BIRTH"
                            If Mid(strData, 3, 4) = "DATE" Then
                                rstData![Birth Date] = GetGenData(strData)
                            ElseIf Mid(strData, 3, 4) = "PLAC" Then
                                rstData![Birth Location] = GetGenData(strData)
                            End If
                        Case "DEATH"
                            If Mid(strData, 3, 4) = "DATE" Then
                                rstData![Death Date] = GetGenData(strData)
                            ElseIf Mid(strData, 3, 4) = "PLAC" Then
                                rstData![Death Location] = GetGenData(strData)
                            End If
                    End Select
            End Select
        End If
    Loop
    rstData.Update

Case "FAM"
    rstData.Open "Families", conGen, adOpenDynamic, adLockPessimistic
    rstData.AddNew
    Do While intPosition <> 0
        intPosition = 1
        intPosition = InStr(intPosition, strRecord, Chr(13))
        If intPosition = 0 And Len(strRecord) > 0 Then
            strData = strRecord
        Else
            strData = Left(strRecord, intPosition)
        End If
        strRecord = Right(strRecord, Len(strRecord) - intPosition)
        If Left(strData, 3) = "FAM" Then
            rstData![GED Family ID] = GetGEDNumber(strData)
        Else
            Select Case Left(strData, 1)
                Case 1
                    Select Case Mid(strData, 3, 4)
                        Case "HUSB"
                            rstQuery.Open "Select ID, [GED ID] FROM Individuals Where [GED ID]='" & GetGEDNumber(strData) & "'", conGen, adOpenStatic, adLockReadOnly
                            rstData![Father ID] = rstQuery!ID
                            rstQuery.Close
                        Case "WIFE"
                            rstQuery.Open "Select ID, [GED ID] FROM Individuals Where [GED ID]='" & GetGEDNumber(strData) & "'", conGen, adOpenStatic, adLockReadOnly
                            rstData![Mother ID] = rstQuery!ID
                            rstQuery.Close
                        Case "MARR"
                            strSubType = "Marriage"
                    End Select
                Case 2
                    Select Case strSubType
                        Case "Marriage"
                            If Mid(strData, 3, 4) = "DATE" Then
                                rstData![Marriage Date] = GetGenData(strData)
                            ElseIf Mid(strData, 3, 4) = "PLAC" Then
                                rstData![Marriage Location] = GetGenData(strData)
                            End If
                    End Select
            End Select
        End If
    Loop
    rstData.Update

End Select
rstData.Close
Set rstData = Nothing
conGen.Close
Set conGen = Nothing
End Sub

Function GetGEDNumber(GED As String) As String
GetGEDNumber = Mid(GED, InStr(1, GED, "@") + 1, InStrRev(GED, "@") - InStr(1, 
GED, "@") - 1)
End Function

Function GetGenData(Data As String) As String
GetGenData = Replace(Replace(Right(Data, Len(Data) - 7), Chr(13), ""), 
Chr(10), "")
End Function

我的代码中是否缺少这部分？如果是这样，我需要用什么替换它？

rstData.Close
Set rstData = Nothing
conGen.Close
Set conGen = Nothing
4

1 回答 1

1

内存问题可能是由于不使用Using...End Using. .net 中的变量是垃圾收集的。这是托管代码 - 读取托管内存。当对象使用非托管资源时会出现问题。为了清理这些资源，这些对象实现了这些资源IDisposable，因此它们将拥有一个Dispose()方法。如果我们未能调用该Dispose()方法，则非托管资源可能会堆积并导致“内存不足”。处理此问题的一种简单方法是使用Using...End Using.

因此，无论您如何退出该块，Using 块都可以保证资源的处置。即使在未处理的异常情况下也是如此，除了 SO Exception

（来自 ms 文档）

您将 Using 代替 Dim 语句。

Using cn as New SqlConnection("Your connection string")

然后，当您完成使用连接时，...

End Using

需要注意的是，这是一个代码块，在其中声明的任何内容都不会在外部可见。在块之前声明并初始化您需要的任何变量。

于 2018-07-21T21:44:31.677 回答