<%[@ IncludeFile "Code/Util.vbs" ]%> <%[@ IncludeFile "Code/Lang.vbs"]%> <%[InitGlobalVariables]%> Initialize Report Generator

This file initializes various data structures for this report.  You are welcome to remove this file from the configuration file if feel you don't need it, or write extra code to include new features to your report.  This file is never copied to the destination report, so here is a good place to include your comments and personal notes while you are designing your report.

To view the code, please use a normal text editor such as Notepad or switch to the "HTML Code" view.

 

<%[ ' The idea of the file Init.htm is to show how to use of the Session object. ' The presence of the Init.htm file is a good example of structured programming ' by having initialization code in a common place. strTitle = ReportGenerator.document.Title If (strTitle = "") Then Report.LogWarning "Title Missing! Click on the ""Document"" tab to set a title to your genealogy report." ' Use the default title from the language dictionary strTitle = Dic("Title") End If Session("Title") = strTitle ' Store the report title in the session variable, so it can be accessed from anywhere. ' The following code generates a complete list of all the individuals ' found in the report. If an individual has an empty name, then ' its href value is set to an empty string so the report generator ' can skip those individuals. ' The list of all individuals is stored in an "ObjectRepertory". ' The first level is the letter of the alphabet, the second level ' is the last name, and finally the individuals. ' This repertory is stored in the Session object so it can be ' accessed by other pages. Set oRepertoryIndividuals = Util.NewObjectRepertory ' Global repertory ' Store the repertory into the Session object Session("oRepertoryIndividuals") = oRepertoryIndividuals Set oRepertoryNoLastName = Util.NewObjectRepertory ' Repertory for the individuals without a last name Session("oRepertoryNoLastName") = oRepertoryNoLastName ' Use a string dictionary to count the number of individuals starting with a given letter of the alphabet ' A string dictionary is much faster and takes less memory than the object repertory Set oStringDictionaryFirstChar = Util.NewStringDictionary() Session("oStringDictionaryFirstChar") = oStringDictionaryFirstChar ' Use a string dictionary to count the frequency of each last name. ' A string dictionary is much faster than the object repertory for counting strings Set oStringDictionaryNames = Util.NewStringDictionary() Session("oStringDictionaryNames") = oStringDictionaryNames Set collectionIndividuals = Util.NewDataSorter() Dim cnt, strLast, oDate cnt = 0 For Each i in Individuals strLast = i.Name.Last If strLast = "" Then strLast = i.Name.Last2 End If Set oDate = i.Birth.Date If oDate.ToStringNarrative = "" Then Set oDate = i.Birth.Baptism.Date collectionIndividuals.Add i, Util.StrStripAccentsUCase(Util.StrStripPunctuation(Trim(strLast))), i.Name.First, i.Name.Middle, oDate.Year, oDate.Month, oDate.Day Next collectionIndividuals.SortByKey For Each i In collectionIndividuals.ToGenoCollection ' Keep only the individuals having a name and some data (ie, DataLevel > 1) strName = i.Name 'If (strName <> "" AND i.DataLevel > 1) Then If (strName <> "") Then iCount = iCount + 1 strNameLast = i.Name.Last If isPrivate(i) Then strTemp = i.Href i.Href = g_strPrivateFolder & strTemp End If If strNameLast = "" Then strNameLast = i.Name.Last2 If (strNameLast <> "") Then oStringDictionaryNames.Add strNameLast End If ' Get the first letter of the individual strFirstChar = Util.StrGetFirstChar(Util.StrStripAccentsUCase(Util.StrStripPunctuation(Trim(strNameLast)))) oStringDictionaryFirstChar.Add strFirstChar If (strFirstChar <> "") Then Set oRepertoryFirstChar = oRepertoryIndividuals.AddObjectRepertory(strFirstChar) oRepertoryFirstChar.Add strNameLast, i Else ' Add the individual to this special repertory oRepertoryNoLastName.Add strName, i End If Else ' Prevent any hyperlink to this individual because it has no name or not enough data i.Href = "" End If Next Session("IndividualsCount") = iCount ' Now, loop through each letter of the alphabet to determine how many individuals are present ' under each letter of the alphabet ' Store the formatted string in the second key (o.Object(1)) For Each o In oRepertoryIndividuals strFirstChar = o.Key Set oRepertoryFamilies = o.Object(0) o.Add Util.FormatString("({}, {})", Dic.PlurialCount("Family", oRepertoryFamilies.Count), Dic.PlurialCount("Individual", oStringDictionaryFirstChar.KeyCounter(strFirstChar))) Next ' Sort the dictionary from the largest to the smallest number. This dictionary is used to generate ' the meta description and display the most popular family names oStringDictionaryNames.SortByCounter oStringDictionaryNames.Reverse ' Create ObjectRepertory for rings/chains of Hyperlinks Set oHyperlinkRings = Util.NewObjectRepertory Session("oHyperlinkRings") = oHyperlinkRings ' Create index for entries in the above Repertory Set oHyperlinkRingIndex = Util.NewStringDictionary() Session("oHyperlinkRingIndex")=oHyperlinkRingIndex ' now build the Repertory and Index For Each o In AllIndividuals ' include hyperlinks If o.hyperlink.internal ="Y" Then If o.IndividualInternalHyperlink.ID <> "" Then ' its the link only oHyperlinkRings.Add o.IndividualInternalHyperlink.ID, o oHyperlinkRingIndex.Add o.ID, oHyperlinkRings.KeyCounter(o.IndividualInternalHyperlink.ID)-1 Else ' it's the source oHyperlinkRings.Add o.ID, o oHyperlinkRingIndex.Add o.ID, oHyperlinkRings.KeyCounter(o.ID)-1 End If End If Next ' Create object repertories to hold Social Relationships indexed by Individual. Set oRepertoryEntity1 = Util.NewObjectRepertory ' key is source entity Session("oRepertoryEntity1") = oRepertoryEntity1 Set oRepertoryEntity2 = Util.NewObjectRepertory ' key is target entity Session("oRepertoryEntity2") = oRepertoryEntity2 For Each r in SocialRelationships if r.entity1.Class = "Individual" Then oRepertoryEntity1.Add r.entity1.ID, r if r.entity2.Class = "Individual" Then oRepertoryEntity2.Add r.entity2.ID, r Next For Each r in EmotionalRelationships if r.Entity1.Class = "Individual" Then oRepertoryEntity1.Add r.Entity1.ID, r if r.Entity2.Class = "Individual" Then oRepertoryEntity2.Add r.Entity2.ID, r Next ' now create an ObjectRepertory with Dictionaries of each set of Custom Tags present together ' with the 'DialogLayout' groupings of each by accessing the GenoPro XML data via MS XMLDOM Set oCustomTagRepertory = Util.NewObjectRepertory on error resume next Dim strXmlDom, strVersion strXmlDom = Array("Msxml2.DOMDocument.6.0","msxml2.DOMDocument.5.0","msxml2.DOMDocument.4.0","msxml2.DOMDocument.3.0","msxml2.DOMDocument", "Microsoft.XMLDOM") On Error Resume Next For Each strVersion in strXmlDom Set oXmlDoc = CreateObject(strVersion) If Err.Number=0 Then Exit For Err.Clear Next If Err.Number <> 0 Then Report.LogError "Unable to load an ActiveX control for MS XML Parser. " & Err.Number & ": " & Err.Description On Error Goto 0 oXmlDoc.loadXml ReportGenerator.document.GetTextXml oXmlDoc.setProperty "SelectionLanguage", "XPath" ' Set oCustomTags = oXmlDoc.selectnodes("/GenoPro/Global/Tags[@ID='Individual']/TagData") Set oTags = oXmlDoc.selectnodes("/GenoPro/Global/Tags") Session("Global") = oXmlDoc.selectSingleNode("/GenoPro/Global") Dim Layout, strDesc, strTags, strPrivate strPrivate = Dic("Private") ' allows some tags to be excluded from the report. ' build the Custom Tag Repertory. ' ------------------------------- ' The key of each entry is the object class, e.g. Individual, Family, Place etc. ' the 1st object, object(0), is a string dictionary that provides a lookup of tag description from the custom tag name, i.e. the TagData elements ' the 2nd & subsequent objects are string arrays that hold Custom Tag 'Dialog Layout' information as follows: ' element 0 of each array is the name of the 'Dialog Layout' i.e. 'name' attribute ' element 1 of each array is the description of the 'Dialog Layout' i.e. 'description' element ' element 2 onwards are the Custom Tag names in that 'Dialog Layout' i.e. 'tags' element For Each oTag In oTags oId = oTag.GetAttribute("ID") Set oTagData = oTag.selectnodes("TagData") Set oCustomTagDictionary = Util.NewStringDictionary() For Each oTagDatum In oTagData oCustomTagDictionary.Add oTagDatum.GetAttribute("Name"), oTagDatum.selectsinglenode("DisplayName").firstChild.text Next ' add the tag dictionary to the repertory entry for this class of GenoPro objects oCustomTagRepertory.Add oId, oCustomTagDictionary ' now add the DiaglogLayouts Set oLayouts = oTag.selectnodes("DialogLayout") For Each oLayout In oLayouts Set oTemp = oLayout.selectsinglenode("Description") If Not oTemp Is Nothing Then strDesc = oTemp.firstChild.text Set oTemp = oLayout.selectsinglenode("Tags") If Not oTemp Is Nothing Then strTags = oTemp.firstChild.text If Left(strDesc,1) <> "_" And (strPrivate = "" Or Instr(strDesc, strPrivate) <> 1) Then Layout = split(oLayout.GetAttribute("Name") & "," & strDesc &"," & strTags,",") For i = 2 to Ubound(Layout) strCustomTagDesc = oCustomTagDictionary.KeyValue(Layout(i)) If strPrivate <> "" And Instr(strCustomTagDesc, strPrivate) = 1 Then Layout(i) = "" ' blank if private Report.LogWarning "Custom Tag '" & strCustomTagDesc & "' in Layout '" & strDesc & "' is marked as private and has been excluded" End If Next oCustomTagRepertory.Add oId, Layout Erase Layout Else Report.LogWarning "Custom Tag Layout '" & strDesc & "' is marked as private and has been excluded" End If strDesc = "" strTags = "" Next Next Set oXmlDoc = nothing Session("oCustomTagRepertory") = oCustomTagRepertory ' Create a Twin 'lookup' repertory Dim t, s, f, oRepertoryTwins Set oRepertoryTwins = Util.NewObjectRepertory Session("oRepertoryTwins") = oRepertoryTwins For Each t in Twins oRepertoryTwins.Add "T" & t.ID, t ' add twin object For each s in t.Siblings oRepertoryTwins.Add "I" & s.ID, "T" & t.ID ' add lookup from each sibling Next If Not Util.IsNothing(t.Family) Then ' t.Family.ID is broken at present (GenoPro 2.0 beta 18c), it returns twin link id instead of family id ' oRepertoryTwins.Add "F" & t.Family.ID, "T" & t.ID ' add lookup from family ' so use this instead oRepertoryTwins.Add "F" & t.Siblings(0).Family.ID, "T" & t.ID ' add lookup from each sibling End If Next ' Create an 'adopted/fostered child' lookup repertory Dim l, oRepertoryNonBio Set oRepertoryNonBio = Util.NewObjectRepertory Session("oRepertoryNonBio") = oRepertoryNonBio For Each l in PedigreeLinks strLink = l.PedigreeLink.ID If strLink = "Adopted" Or strLink = "Foster" And Not l.Child.IsLabel = True Then oRepertoryNonBio.Add UCase(Left(strLink,1)) & l.Family.ID, l oRepertoryNonBio.Add "I" & l.Child.ID, l oRepertoryNonBio.Add "I" & l.Child.ID & "F" & l.Family.ID, l If Not Util.IsNothing(l.Child.Family) Then oRepertoryNonBio.Add "B" & l.Child.Family.ID, l End If Next ' Get a fresh copy of the individuals in order to find the 20 most popular names, ' but this time exclude any names that are private. ' As before, use string dictionaries when appropriate rather than object repertories. iCount = 0 Set oStringDictionaryFirstCharPublic = Util.NewStringDictionary() Set oStringDictionaryNamesPublic = Util.NewStringDictionary() Set oRepertoryIndividualsPublic = Util.NewObjectRepertory Set oRepertoryNoLastNamePublic = Util.NewObjectRepertory Session("oStringDictionaryFirstCharPublic") = oStringDictionaryFirstCharPublic Session("oStringDictionaryNamesPublic") = oStringDictionaryNamesPublic Session("oRepertoryIndividualsPublic") = oRepertoryIndividualsPublic Session("oRepertoryNoLastNamePublic") = oRepertoryNoLastNamePublic For Each i In collectionIndividuals.ToGenoCollection strName = i.Name If (i.Href <> "" And Not isPrivate(i)) Then iCount = iCount + 1 strNameLast = i.Name.Last If strNameLast = "" Then strNameLast = i.Name.Last2 If (strNameLast <> "") Then strNameLast = Ucase(Left(strNameLast,1)) & Lcase(Mid(strNameLast,2)) If Left(strNameLast,2) = "Mc" Then strNameLast = "Mc" & Ucase(Mid(strNameLast,3,1)) & Lcase(Mid(strNameLast,4)) oStringDictionaryNamesPublic.Add strNameLast End If strFirstChar = Util.StrGetFirstChar(Util.StrStripAccentsUCase(Util.StrStripPunctuation(Trim(strNameLast)))) oStringDictionaryFirstCharPublic.Add strFirstChar If (strFirstChar <> "") Then Set oRepertoryFirstCharPublic = oRepertoryIndividualsPublic.AddObjectRepertory(strFirstChar) oRepertoryFirstCharPublic.Add strNameLast, i Else oRepertoryNoLastNamePublic.Add strName, i End If End If Next Session("IndividualsCountPublic") = iCount For Each o In oRepertoryIndividualsPublic strFirstChar = o.Key Set oRepertoryFamilies = o.Object(0) o.Add Util.FormatString("({}, {})", Dic.PlurialCount("Family", oRepertoryFamilies.Count), _ Dic.PlurialCount("Individual", oStringDictionaryFirstChar.KeyCounter(strFirstChar))) Next oStringDictionaryNamesPublic.SortByCounter oStringDictionaryNamesPublic.Reverse For Each f In Families If (f.Name <> "" And Not f.IsLabel) Then strHref = f.Href If strHref <> "" And isPrivate(f) Then f.Href = g_strPrivateFolder & strHref End If End If Next ' Create mapping array for Pedigree Ancestor Charts Dim ChartMap Set ChartMap = Util.NewObjectrepertory ' 0=index position of anscestor marker, 1-(0)=format tags ChartMap.Add 0, Array(6,"" ,"" ,"" ,"" ,"T" ,"fffff") ChartMap.Add 1, Array(5,"" ,"" ,"" ,"T" ,"ffff","" ) ChartMap.Add 2, Array(6,"" ,"" ,"" ,"I" ,"L" ,"ffffm") ChartMap.Add 3, Array(4,"" ,"" ,"T" ,"fff","" ,"" ) ChartMap.Add 4, Array(6,"" ,"" ,"I" ,"I" ,"T" ,"fffmf") ChartMap.Add 5, Array(5,"" ,"" ,"I" ,"L" ,"fffm","" ) ChartMap.Add 6, Array(6,"" ,"" ,"I" ,"" ,"L" ,"fffmm") ChartMap.Add 7, Array(3,"" ,"T","ff","" ,"" ,"" ) ChartMap.Add 8, Array(6,"" ,"I","I" ,"" ,"T" ,"ffmff") ChartMap.Add 9, Array(5,"" ,"I","I" ,"T" ,"ffmf","" ) ChartMap.Add 10, Array(6,"" ,"I","I" ,"I" ,"L" ,"ffmfm") ChartMap.Add 11, Array(4,"" ,"I","L" ,"ffm","" ,"" ) ChartMap.Add 12, Array(6,"" ,"I","" ,"I" ,"T" ,"ffmmf") ChartMap.Add 13, Array(5,"" ,"I","" ,"L" ,"ffmm","" ) ChartMap.Add 14, Array(6,"" ,"I","" ,"" ,"L" ,"ffmmm") ChartMap.Add 15, Array(2,"T","f","" ,"" ,"" ,"" ) ChartMap.Add 16, Array(6,"I","I","" ,"" ,"T" ,"fmfff") ChartMap.Add 17, Array(5,"I","I","" ,"T" , "fmff","" ) ChartMap.Add 18, Array(6,"I","I","" ,"I" ,"L" ,"fmffm") ChartMap.Add 19, Array(4,"I","I","T" ,"fmf","" ,"" ) ChartMap.Add 20, Array(6,"I","I","I" ,"I" ,"T" ,"fmfmf") ChartMap.Add 21, Array(5,"I","I","I" ,"L" ,"fmfm","" ) ChartMap.Add 22, Array(6,"I","I","I" ,"" ,"L" ,"fmfmm") ChartMap.Add 23, Array(3,"I","L","fm","" ,"" ,"" ) ChartMap.Add 24, Array(6,"I","" ,"I" , "" ,"T" ,"fmmff") ChartMap.Add 25, Array(5,"I","" ,"I" ,"T" ,"fmmf","" ) ChartMap.Add 26, Array(6,"I","" ,"I" ,"I" ,"L" ,"fmmfm") ChartMap.Add 27, Array(4,"I","" ,"L" ,"fmm","" ,"" ) ChartMap.Add 28, Array(6,"I","" ,"" ,"I" ,"T" ,"fmmmf") ChartMap.Add 29, Array(5,"I","" ,"" ,"L" ,"fmmm","" ) ChartMap.Add 30, Array(6,"I","" ,"" ,"" ,"L" ,"fmmmm") ChartMap.Add 31, Array(1,"i","" ,"" ,"" ,"" ,"" ) ChartMap.Add 32, Array(6,"I","" ,"" ,"" ,"T" ,"mffff") ChartMap.Add 33, Array(5,"I","" ,"" ,"T" ,"mfff","" ) ChartMap.Add 34, Array(6,"I","" ,"" ,"I" ,"L" ,"mfffm") ChartMap.Add 35, Array(4,"I","" ,"T" ,"mff","" ,"" ) ChartMap.Add 36, Array(6,"I","" ,"I" ,"I" ,"T" ,"mffmf") ChartMap.Add 37, Array(5,"I","" ,"I" ,"L" ,"mffm","" ) ChartMap.Add 38, Array(6,"I","" ,"I" ,"" ,"L" ,"mffmm") ChartMap.Add 39, Array(3,"I","T","mf","" ,"" ,"" ) ChartMap.Add 40, Array(6,"I","I","I" ,"" ,"T" ,"mfmff") ChartMap.Add 41, Array(5,"I","I","I" ,"T" ,"mfmf","" ) ChartMap.Add 42, Array(6,"I","I","I" ,"I" ,"L" ,"mfmfm") ChartMap.Add 43, Array(4,"I","I","L" ,"mfm","" ,"" ) ChartMap.Add 44, Array(6,"I","I","" ,"I" ,"T" ,"mfmmf") ChartMap.Add 45, Array(5,"I","I","" ,"L" ,"mfmm","" ) ChartMap.Add 46, Array(6,"I","I","" ,"" ,"L" ,"mfmmm") ChartMap.Add 47, Array(2,"L","m","" ,"" ,"" ,"" ) ChartMap.Add 48, Array(6,"" ,"I","" ,"" ,"T" ,"mmfff") ChartMap.Add 49, Array(5,"" ,"I","" ,"T" ,"mmff","" ) ChartMap.Add 50, Array(6,"" ,"I","" ,"I" ,"L" ,"mmffm") ChartMap.Add 51, Array(4,"" ,"I","T" ,"mmf","" ,"" ) ChartMap.Add 52, Array(6,"" ,"I","I" ,"I" ,"T" ,"mmfmf") ChartMap.Add 53, Array(5,"" ,"I","I" ,"L" ,"mmfm","" ) ChartMap.Add 54, Array(6,"" ,"I","I" ,"" ,"L" ,"mmfmm") ChartMap.Add 55, Array(3,"" ,"L","mm","" ,"" ,"" ) ChartMap.Add 56, Array(6,"" ,"" ,"I" ,"" ,"T" ,"mmmff") ChartMap.Add 57, Array(5,"" ,"" ,"I" ,"T" ,"mmmf","" ) ChartMap.Add 58, Array(6,"" ,"" ,"I" ,"I" ,"L" ,"mmmfm") ChartMap.Add 59, Array(4,"" ,"" ,"L" ,"mmm","" ,"" ) ChartMap.Add 60, Array(6,"" ,"" ,"" ,"I" ,"T" ,"mmmmf") ChartMap.Add 61, Array(5,"" ,"" ,"" ,"L" ,"mmmm","" ) ChartMap.Add 62, Array(6,"" ,"" ,"" ,"" ,"L" ,"mmmmm") Session("ChartMap")=ChartMap ' Finally, the method AbortPage does prevent the file Init.htm to be written ' to the destination report. The AbortPage method does not display ' any error to the user. Report.AbortPage ]%>