I have written the following program that reads and parses a .ged file (genealogy data) and stores it in an SQLite database. The program works, however when a large file is loaded, I get an "out of memory exception". I'm new to Visual Basic, but it appears that every object that is created is stored in memory until the program ends, as memory usage increases up to 4 gigs as the program runs.
I've searched all over but cannot find a solution. Help!
I have a similar Family and Child class and subs in the server class for each.
Person Class:
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
Server:
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
Main Program:
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
End Class
This was addapted from this VBA Program:
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
Am I missing this part in my code? If so, what do I need to replace it with?
rstData.Close
Set rstData = Nothing
conGen.Close
Set conGen = Nothing
Memory problems can be the result of not using Using...End Using. Variables in .net are garbage collected. This is managed code - read managed memory. Problems arise when an object uses unmanaged resources. To clean up these resources these objects implement IDisposable so they will have a Dispose() method. If we fail to call the Dispose() method than the unmanaged resources can pile up and cause "Out of Memory". A simple way to handle this is to use Using...End Using.
Because of this, the Using block guarantees disposal of the resources, no matter how you exit the block. This is true even in the case of an unhandled exception, except SO Exception
(from ms docs)
You place the Using in place of the Dim statement.
Using cn as New SqlConnection("Your connection string")
Then, when your are finished using the connection,...
End Using
One caveat, this is a code block and anything declared inside it will not be visible outside. Declare and initialize any variables that you need before the block.