From d3d855d2c4a4e811350c540120675ede693b30d2 Mon Sep 17 00:00:00 2001 From: yaqubroli Date: Mon, 23 Sep 2024 18:01:21 +0100 Subject: [PATCH] Almost finished --- #*superscratch*# | 1 - #Makefile# | 0 *scratch* | 308 -------------------------------------------------------------------------------- Writeup.docm | 0 Writeup.pdf | 0 cv.docm.bak | 0 cv.docm.bak.2.docm | 0 cv.dotx | 0 cvr1.docm | 0 src.bak/NewMacros.bas | 66 ------------------------------------------------------------------ src.bak/StringTable.bas | 11 ----------- src.bak/YAML.cls | 330 -------------------------------------------------------------------------------- src/#NewMacros.bas# | 10 ---------- src/CV.bas | 6 +++--- src/JsonConverter.bas | 1123 -------------------------------------------------------------------------------- src/Project.ini | 8 ++++---- src/ThisDocument.cls | 13 ------------- src.bak/Class Modules/YAML.cls | 353 -------------------------------------------------------------------------------- src.bak/Modules/NewMacros.bas | 58 ---------------------------------------------------------- src.bak/Modules/YAMLParser_old.bas | 313 -------------------------------------------------------------------------------- 20 files changed, 7 insertions(+), 2593 deletions(-) diff --git a/#*superscratch*# b/#*superscratch*# deleted file mode 100644 index a5ba7c7..0000000 100644 --- a/#*superscratch*# +++ /dev/null @@ -1,1 +1,0 @@ -cvProps("projects")(ID_SELF)(l)("title")(ID_SELF)diff --git a/#Makefile# b/#Makefile# deleted file mode 100644 index e69de29..0000000 100644 --- a/#Makefile# +++ /dev/null diff --git a/*scratch* b/*scratch* deleted file mode 100644 index 28c7895..0000000 100644 --- a/*scratch* +++ /dev/null @@ -1,308 +1,0 @@ -{ - "___type___": "Dictionary", - "name": { - "___type___": "String", - "___self___": "Jacob Walchuk" - }, - "email": { - "___type___": "String", - "___self___": "walchuk2018@icloud.com" - }, - "www": { - "___type___": "String", - "___self___": "jacob.hcol.uk\n" - }, - "phones": { - "___type___": "Array", - "___self___": [ - { - "___type___": "Dictionary", - "cc": { - "___type___": "String", - "___self___": "UK" - }, - "phone": { - "___type___": "String", - "___self___": "+44 7519 615 066" - } - }, - { - "___type___": "Dictionary", - "cc": { - "___type___": "String", - "___self___": "CA" - }, - "phone": { - "___type___": "String", - "___self___": "+1 604 880 4825\n" - } - } - ] - }, - "cv": { - "___type___": "Array", - "___self___": [ - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "Education" - }, - "entries": { - "___type___": "Array", - "___self___": [ - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "Westside School" - }, - "location": { - "___type___": "String", - "___self___": "Vancouver, Canada" - }, - "date": { - "___type___": "String", - "___self___": "2019---2021" - }, - "bullets": { - "___type___": "Array", - "___self___": [ - { - "___type___": "String", - "___self___": "A*A*A*A*A-equivalent marks, per KCL's conversion scale." - } - ] - } - }, - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "Trinity Western University" - }, - "role": { - "___type___": "String", - "___self___": "B.A. in Political Studies" - }, - "location": { - "___type___": "String", - "___self___": "Langley, Canada" - }, - "date": { - "___type___": "String", - "___self___": "2021---2022" - }, - "bullets": { - "___type___": "Array", - "___self___": [ - { - "___type___": "String", - "___self___": "Received a 4.23/4.3 grade average in my first year, before transferring." - } - ] - } - }, - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "University of St. Andrews" - }, - "role": { - "___type___": "String", - "___self___": "M.A. Hons. in Philosophy" - }, - "location": { - "___type___": "String", - "___self___": "St. Andrews, Scotland" - }, - "date": { - "___type___": "String", - "___self___": "2022---2025" - }, - "bullets": { - "___type___": "Array", - "___self___": [ - { - "___type___": "String", - "___self___": "Standing 2:2 Honours, with a focus on symbolic logic and analytic metaphysics." - } - ] - } - } - ] - } - }, - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "Work Experience" - }, - "entries": { - "___type___": "Array", - "___self___": [ - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "Kova Engineering, Ltd." - }, - "role": { - "___type___": "String", - "___self___": "Technical Analyst Intern" - }, - "location": { - "___type___": "String", - "___self___": "Langley, Canada" - }, - "date": { - "___type___": "String", - "___self___": "Summer 2023" - }, - "bullets": { - "___type___": "Array", - "___self___": [ - { - "___type___": "String", - "___self___": "Discovered employee concerns around an improperly-scaled MySQL database with a ColdFusion frontend, and wrote a longform report on the costs and benefits of a full-stack overhaul to PostgreSQL and Next.js." - }, - { - "___type___": "String", - "___self___": "Consulted with the CEO, CTO, and other members of the executive team in discovering their needs." - }, - { - "___type___": "String", - "___self___": "Submitted a code proposal to the lead programmer, which secured and sped up interoperability between the old and new system." - } - ] - } - }, - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "Kova Engineering, Ltd." - }, - "role": { - "___type___": "String", - "___self___": "Assistant I.T. Technician" - }, - "location": { - "___type___": "String", - "___self___": "Langley, Canada" - }, - "date": { - "___type___": "String", - "___self___": "2018---2022" - }, - "bullets": { - "___type___": "Array", - "___self___": [ - { - "___type___": "String", - "___self___": "Deployed laptops and servers running Windows, and iPhones using Apple's Device Enrolment Programme." - }, - { - "___type___": "String", - "___self___": "Onboarded metallurgy technicians with little-to-no IT background." - } - ] - } - }, - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "Free Geek Vancouver" - }, - "role": { - "___type___": "String", - "___self___": "Repair Technician" - }, - "date": { - "___type___": "String", - "___self___": "2017---2018" - }, - "location": { - "___type___": "String", - "___self___": "Vancouver, Canada" - }, - "bullets": { - "___type___": "Array", - "___self___": [ - { - "___type___": "String", - "___self___": "Stress-tested PC components including RAM, CPUs, and GPUs, and performed light component-level board repair.\n" - } - ] - } - } - ] - } - } - ] - }, - "projects": { - "___type___": "Array", - "___self___": [ - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "Book Tracker" - }, - "description": { - "___type___": "String", - "___self___": "Reverse-engineered the SQLite schemas of bibliographic and note-taking software, and wrote a quick Node.js tool to generate progress reports and publish notes to my personal website." - } - }, - { - "___type___": "Dictionary", - "title": { - "___type___": "String", - "___self___": "Homelab" - }, - "description": { - "___type___": "String", - "___self___": "Ran a decommissioned rackmount server at home, deploying KVM on Debian, and later, Xen." - } - } - ] - }, - "skills": { - "___type___": "Array", - "___self___": [ - { - "___type___": "String", - "___self___": "Certifications: CompTIA Linux+, IBM Data Analyst Certificate (Excel, Cognos, and R), IBM Data Science Certificate (Python)." - }, - { - "___type___": "String", - "___self___": "Languages: Mandarin (working proficiency), German (basic)." - }, - { - "___type___": "String", - "___self___": "Proficient in VBA, HTML/CSS/JS, and Emacs LISP." - }, - { - "___type___": "String", - "___self___": "Interests: Linguistics, social and economic history, corporate finance.\n" - } - ] - }, - "footer": { - "___type___": "Array", - "___self___": [ - { - "___type___": "String", - "___self___": "Authorised to work full-time in the UK, without sponsorship." - }, - { - "___type___": "String", - "___self___": "This {{DOCTYPE}} was generated from YAML source using {{LANG}}. For more information, see jacob.hcol.uk/cv.\n" - } - ] - } -} diff --git a/Writeup.docm b/Writeup.docm deleted file mode 100644 index 9600636b3a8d591b163d1daf514c66dec98fb958..0000000000000000000000000000000000000000 100644 Binary files a/Writeup.docm and /dev/null differ diff --git a/Writeup.pdf b/Writeup.pdf deleted file mode 100644 index fa8452fa6c8b816f7182236e63207455079f82ba..0000000000000000000000000000000000000000 100644 Binary files a/Writeup.pdf and /dev/null differ diff --git a/cv.docm.bak b/cv.docm.bak deleted file mode 100644 index 11f919716d083fab8a94909bb2418ce81c57d78c..0000000000000000000000000000000000000000 100644 Binary files a/cv.docm.bak and /dev/null differ diff --git a/cv.docm.bak.2.docm b/cv.docm.bak.2.docm deleted file mode 100644 index 2f2e57df5ad8451ce94a54324f5b170537855f50..0000000000000000000000000000000000000000 100644 Binary files a/cv.docm.bak.2.docm and /dev/null differ diff --git a/cv.dotx b/cv.dotx deleted file mode 100644 index ac1658a3c806aee97981ec683402a448ba6ccf95..0000000000000000000000000000000000000000 100644 Binary files a/cv.dotx and /dev/null differ diff --git a/cvr1.docm b/cvr1.docm deleted file mode 100644 index c3f9537ed316ec1ea3957ba64bbf9d712ea44f70..0000000000000000000000000000000000000000 100644 Binary files a/cvr1.docm and /dev/null differ diff --git a/src.bak/NewMacros.bas b/src.bak/NewMacros.bas deleted file mode 100644 index 9354112..0000000 100644 --- a/src.bak/NewMacros.bas +++ /dev/null @@ -1,66 +1,0 @@ -Attribute VB_Name = "NewMacros" -Option Explicit - -Sub Macro1() -Attribute Macro1.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1" -' -' Macro1 Macro -' -' - Dim cvYAML As Object: Set cvYAML = New YAML - cvYAML.path = "\\Mac\iCloud\Development\cv\cv.yml" - Dim cvProps As Object: Set cvProps = cvYAML.props - Debug.Print cvProps("name")(ID_SELF) - 'Dim cvProps As Dictionary: - - 'Debug.Print cvProps("name")(ID_SELF) - - 'Selection.Style = ActiveDocument.Styles("Title") - 'Selection.TypeText Text:="This is a title" - 'Selection.TypeParagraph - 'Selection.TypeParagraph - 'Selection.Style = ActiveDocument.Styles("Heading 1") - 'Selection.TypeText Text:="Heading 1" - 'Selection.TypeParagraph - 'Selection.Style = ActiveDocument.Styles("No Spacing") - 'Selection.TypeText Text:="Whatababab" - 'Selection.TypeParagraph - 'With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1) - ' .NumberFormat = ChrW(61623) - ' .TrailingCharacter = wdTrailingTab - ' .NumberStyle = wdListNumberStyleBullet - ' .NumberPosition = InchesToPoints(0.25) - ' .Alignment = wdListLevelAlignLeft - ' .TextPosition = InchesToPoints(0.5) - ' .TabPosition = wdUndefined - ' .ResetOnHigher = 0 - ' .StartAt = 1 - ' With .Font - ' .Bold = wdUndefined - ' .Italic = wdUndefined - ' .StrikeThrough = wdUndefined - ' .Subscript = wdUndefined - ' .Superscript = wdUndefined - ' .Shadow = wdUndefined - ' .Outline = wdUndefined - ' .Emboss = wdUndefined - ' .Engrave = wdUndefined - ' .AllCaps = wdUndefined - ' .Hidden = wdUndefined - ' .Underline = wdUndefined - ' .Color = wdUndefined - ' .Size = wdUndefined - ' .Animation = wdUndefined - ' .DoubleStrikeThrough = wdUndefined - ' .Name = "Symbol" - ' End With - ' .LinkedStyle = "" - 'End With - 'ListGalleries(wdBulletGallery).ListTemplates(1).Name = "" - 'Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _ - ' ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _ - ' False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _ - ' wdWord10ListBehavior - 'Selection.TypeText Text:="This is a bulletted list created manually" - 'Selection.EscapeKey -End Sub diff --git a/src.bak/StringTable.bas b/src.bak/StringTable.bas deleted file mode 100644 index 9c5803e..0000000 100644 --- a/src.bak/StringTable.bas +++ /dev/null @@ -1,11 +1,0 @@ -Attribute VB_Name = "StringTable" -Option Explicit - -Public Const ID_SELF As String = "___self___" -Public Const ID_TYPE As String = "___type___" - -Public Const MESSAGE_ERROR_GENERIC As String = "YAML Error" -Public Const MESSAGE_MALFORMED_TYPE As String = "Malformed YAML code on line " -Public Const MESSAGE_MALFORMED_YAML As String = "Malformed type error - this is a problem with the internal dictionary" -Public Const MESSAGE_GETPROP_NOT_STR As String = "Your module has tried to use getProp(), which is meant for type String, on a " -Public Const MESSAGE_GETPROP_NOT_FOUND As String = "Property not found." diff --git a/src.bak/YAML.cls b/src.bak/YAML.cls deleted file mode 100644 index 3ca3575..0000000 100644 --- a/src.bak/YAML.cls +++ /dev/null @@ -1,330 +1,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "YAML" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -Option Explicit - -' Const yamlPath As String = "\\Mac\iCloud\Development\cv\cv.yml" - -Public yamlPath As String - -Private Function RemoveEmptyStrings(arr() As String) As String() - Dim tempArray() As String - Dim i As Integer, j As Integer: j = 0 - ReDim tempArray(LBound(arr) To UBound(arr)) - j = 0 - For i = LBound(arr) To UBound(arr) - If Len(arr(i)) > 0 Then - tempArray(j) = arr(i) - j = j + 1 - End If - Next i - ReDim Preserve tempArray(0 To j - 1) - RemoveEmptyStrings = tempArray -End Function - - -Private Function RegexMatch(inputString As String, pattern As String, Optional isGlobal As Boolean = True) As Boolean - ' checks for regex match without instantiating 80 gazillion objects - - ' parameters - ' isGlobal: whether the regex check is global - - Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp") - Regex.pattern = pattern - Regex.Global = isGlobal - RegexMatch = Regex.Test(inputString) -End Function - -Private Function RegexSplit(inputString As String, pattern As String, Optional onlyFirst As Boolean = False, Optional splitBefore As Boolean = False) As String() - ' splits array at any pattern that matches a regex - - ' parameters - ' onlyFirst: if true, only splits the first instance of the match, creating an array of length 2 - ' splitBefore: if true, preserves the actual instance of the match - - Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp") - Dim matches As Object - Dim match As Object - Dim splitParts() As String: ReDim splitParts(0 To 0) - Dim pos As Integer - Dim lastPos As Integer: lastPos = 1 - Dim i As Integer: i = 0 - - ' set regex flags - Regex.Global = True - Regex.IgnoreCase = False - Regex.pattern = pattern - - Set matches = Regex.Execute(inputString) - - ' lastPos = 1 - ' i = 0 - - For Each match In matches - pos = match.FirstIndex + 1 - ReDim Preserve splitParts(i) - splitParts(i) = Mid(inputString, lastPos, pos - lastPos) - If splitBefore Then - lastPos = pos - Else - lastPos = pos + Len(match.Value) - End If - i = i + 1 - If onlyFirst Then Exit For - Next match - - If lastPos <= Len(inputString) Then - ReDim Preserve splitParts(i) - splitParts(i) = Mid(inputString, lastPos) - End If - - ' retvrn - RegexSplit = RemoveEmptyStrings(splitParts) -End Function - -Private Function RegexSubstitute(inputString As String, pattern As String, Optional substitution As String = "") - ' does what it says on the tin - Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp") - Regex.pattern = pattern - Regex.IgnoreCase = False - Regex.Global = True - RegexSubstitute = Regex.Replace(inputString, substitution) -End Function - -' YAML Layer Parser Pseudocode -' ==== -' function GetYAMLLayerAsCollection(String fromYAML) { -' Collection mainDictionary = New Collection(); -' if (fromYAML.containsRegex(/\n[A-Za-z]/)) { -' // is a dictionary -' String[] temporaryArray = fromYAML.split(/\n[A-Za-z]/); -' for each x in temporaryArray { -' x.splitByFirstInstanceOf(':\n'); -' x[1].replaceAllInstancesOf(' -' mainDictionary.add(x[0], x[1]); -' } -' } else if (fromYAML.containsRegex(/\n-/)) { -' // if array, process the array and return it as "self" -' String[] temporaryArray = fromYAML.splitBy('\n-'); -' for each x in temporaryArray { -' x.removeAllInstancesOf('\n- '); -' x.replaceAllInstancesOf('\n ', '\n'); -' mainDictionary.add("self", temporaryArray); -' } -' } else if (fromYAML.startsWith('"')) { -' mainDictionary.add("self", removeQuotes(fromYAML)); -' } else { -' MsgBox("Processing error: neither array, dictionary, nor string"); -' } -' } - - -Private Function GetYAMLLayerAsDictionary(fromYAML As String) As Dictionary - Dim mainDictionary As Dictionary: Set mainDictionary = New Dictionary - ' create regex objects to test for dict, array, and string - - 'Dim regEx_dict As Object: Set regEx_dict = CreateObject("VBScript.RegExp") - 'Dim regEx_arry As Object: Set regEx_arry = CreateObject("VBScript.RegExp") - 'Dim regEx_strn As Object: Set regEx_strn = CreateObject("VBScript.RegExp") - - 'regEx_dict.Global = True: regEx_dict.Pattern = "\n[A-Za-z]" - 'regEx_arry.Global = True: regEx_arry.Pattern = "\n-\s" - 'regEx_strn.Global = False: regEx_strn.Pattern = "^\s*""(.*?)""\s*$" - - Dim parts() As String - - If RegexMatch(fromYAML, "(?:\n|\^)\w+:", True) Then - ' is a dictionary - parts = RegexSplit(fromYAML, "\n\w+:", False, True) - Dim part As Variant ' not sure why it can't be as string but whatever billy gates - Call mainDictionary.Add(ID_TYPE, "Dictionary") ' identify as dict - For Each part In parts - Dim keyValue() As String: keyValue = RegexSplit(CStr(part), ":\s", True) - ' trim trailing \n from category - If UBound(keyValue) > 0 Then - keyValue(0) = RegexSubstitute(keyValue(0), "^\n+") - ' trim 2 spaces off of each line if they're there - keyValue(1) = RegexSubstitute(keyValue(1), "^\s{2}") - keyValue(1) = RegexSubstitute(keyValue(1), "\n\s{2}", vbLf) - Call mainDictionary.Add(keyValue(0), keyValue(1)) - End If - Next part - ElseIf RegexMatch(fromYAML, "^-\s", True) Then - ' is an array - Call mainDictionary.Add(ID_TYPE, "Array") - parts = RegexSplit(fromYAML, "(^|\n)-\s", False) - Dim i As Integer - For i = LBound(parts) To UBound(parts) - parts(i) = RegexSubstitute(parts(i), "\n\s{2}", vbLf) - Next i - Call mainDictionary.Add(ID_SELF, parts) - ElseIf RegexMatch(fromYAML, "^\s*""(.*?)""\s*$", True) Then - ' is a string - Call mainDictionary.Add(ID_TYPE, "String") - Call mainDictionary.Add(ID_SELF, RegexSubstitute(fromYAML, """", "")) - Else - Call mainDictionary.Add(ID_SELF, "") - Debug.Print _ - "Neither array, dictionary, nor string:" & _ - vbCrLf & vbCrLf & fromYAML & vbCrLf & vbCrLf & _ - "Make sure all strings are enclosed in double quotes." ', _ - 'vbOKOnly, "YAML Error") - End If - - Set GetYAMLLayerAsDictionary = mainDictionary -End Function - -' YAML Traverser Pseudocode -' === -' -' function TraverseYAML(String fromYAML) { -' Dictionary mainDictionary = GetYAMLLayerAsDictionary(fromYAML); -' if mainDictionary.___type___ = "Dictionary" { -' for each entry in mainDictionary { -' TraverseYAML(entry) -' } -' return mainDictionary; -' } else if mainDictionary.___type___ = "Array" { -' for each entry in mainDictionary.___self___ { -' TraverseYAML(entry) -' } -' return mainDictionary; -' } else if mainDictionary.___type___ = "String" { -' return mainDictionary; -' } else { -' MsgBox("Internal YAML Error") -' } -' } -Private Function GetYAMLAsDictionary(fromYAML As String) As Dictionary - Dim mainDictionary As Object: Set mainDictionary = GetYAMLLayerAsDictionary(fromYAML) - Dim entry As Variant - If mainDictionary(ID_TYPE) = "Dictionary" Then - For Each entry In mainDictionary - Debug.Print "=== PROCESSING DICTIONARY ENTRY ===" - Debug.Print entry & " => " & mainDictionary(entry) - If entry <> ID_TYPE And entry <> ID_SELF Then - Set mainDictionary(entry) = GetYAMLAsDictionary(mainDictionary(entry)) - End If - Next entry - ElseIf mainDictionary(ID_TYPE) = "Array" Then - Dim i As Integer - Dim subArray() As Object - For i = LBound(mainDictionary(ID_SELF)) To UBound(mainDictionary(ID_SELF)) - Debug.Print "=== PROCESSING ARRAY ENTRY ===" - Debug.Print mainDictionary(ID_SELF)(i) - 'Set subDictionary = GetYAMLAsDictionary(mainDictionary(ID_SELF)(i)) - 'Set mainDictionary(ID_SELF)(i) = subDictionary - ReDim Preserve subArray(i) - Set subArray(i) = GetYAMLAsDictionary(CStr(mainDictionary(ID_SELF)(i))) - Next i - - mainDictionary(ID_SELF) = subArray - ElseIf mainDictionary(ID_TYPE) <> "String" Then - Debug.Print MESSAGE_MALFORMED_TYPE ', vbOKOnly, errIdentifier) - End If - Set GetYAMLAsDictionary = mainDictionary -End Function - -' YAML Cleaner Pseudocode -' ===== -' function YAMLCleaner(Dictionary mainDictionary) { -' for each entry in mainDictionary { -' if entry(ID_TYPE) == "Dictionary" { -' for each secondOrderEntry in entry { -' YAMLCleaner(secondOrderEntry) -' } -' } else if entry(ID_TYPE) == "Array" { -' for each secondOrderEntry in entry(ID_SELF) { -' YAMLCleaner(secondOrderEntry) -' } -' } -' if entry(ID_TYPE) != "Dictionary" { -' mainDictionary(entry) = mainDictionary(entry)(ID_SELF) -' } -' } -' return mainDictionary; -' } - -'Function YAMLCleaner(mainDictionary As Dictionary) As Dictionary -' Dim entry As Variant -' If mainDictionary(ID_TYPE) = "Array" Then ' go through array and yamlclean it -' Dim i As Integer -' Debug.Print JsonConverter.ConvertToJson(mainDictionary) -' For i = LBound(mainDictionary(ID_SELF)) To UBound(mainDictionary(ID_SELF)) -' -' 'If IsObject(mainDictionary(ID_SELF)(i)) Then -' 'Set mainDictionary(ID_SELF)(i) = YAMLCleaner(mainDictionary(ID_SELF)(i)) -' 'Else -' ' Debug.Print "encountered non-object" -' 'End If -' Next i -' End If -' If mainDictionary(ID_TYPE) = "Dictionary" Then 'iterate through dict and yamlclena it -' For Each entry In mainDictionary -' If entry <> ID_TYPE Then -' Set mainDictionary(entry) = YAMLCleaner(mainDictionary(entry)) -' End If -' Next entry -' End If -' -' For Each entry In mainDictionary -' If mainDictionary(ID_TYPE) = "Dictionary" And mainDictionary(entry)(ID_TYPE) <> "Dictionary" And entry <> ID_TYPE And entry <> ID_SELF Then -' Debug.Print "processing " & entry & " which is " & mainDictionary(entry)(ID_TYPE) -' If IsObject(mainDictionary(entry)(ID_SELF)) Then -' Set mainDictionary(entry) = mainDictionary(entry)(ID_SELF) -' Else -' mainDictionary(entry) = mainDictionary(entry)(ID_SELF) -' End If -' End If -' Next entry -' -' ' destroy type identifier? -' Set YAMLCleaner = mainDictionary -'End Function - -Private Function GetFileAsString(filePath As String) As String - ' Dim fileContent As String - Dim line As String - Dim fileNumber As Integer - - 'filePath = "\\Mac\iCloud\Development\cv\cv.yml" - - fileNumber = FreeFile() - - Open filePath For Input As fileNumber - - Do While Not EOF(fileNumber) - Line Input #fileNumber, line - GetFileAsString = GetFileAsString & line & vbCrLf - Loop -End Function - -Public Property Let path(thePath As String) - yamlPath = thePath -End Property - -Public Property Get path() As String - path = yamlPath -End Property - -Public Property Get props() As Dictionary - Set props = GetYAMLAsDictionary(GetFileAsString(yamlPath)) -End Property - -' YAML Indexer Pseudocode [implement later] -' ===== -' function index(string theIndex) { -' Variant[] mainArray = theIndex.split("."); -' Dictionary mainDictionary = yamlProps; -' for each entry in mainArray { -' if entry is { -' -' .... - - diff --git a/src/#NewMacros.bas# b/src/#NewMacros.bas# deleted file mode 100644 index f15f425..0000000 100644 --- a/src/#NewMacros.bas# +++ /dev/null @@ -1,10 +1,0 @@ -Attribute VB_Name = "NewMacros" -Option Explicit - -Sub Macro1() -Attribute Macro1.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1" - Dim cvYAML As Object: Set cvYAML = New YAML - cvYAML.path = "\\Mac\iCloud\Development\cv\cv.yml" - Dim cvProps As Object: Set cvProps = cvYAML.props - Debug.Print cvProps("name")(ID_SELF) -End Sub diff --git a/src/CV.bas b/src/CV.bas index 2304e20..2a557a9 100644 --- a/src/CV.bas +++ a/src/CV.bas @@ -100,12 +100,12 @@ .Bold = True .SmallCaps = True End With - Selection.TypeText Text:="bar" ' theTitles(i) + Selection.TypeText Text:=theTitles(i) With Selection.Font .Bold = False .SmallCaps = False End With - Selection.TypeText Text:=" - baz" ' " " & ChrW(8212) & " " & theDescriptions(i) + Selection.TypeText Text:=" " & ChrW(8212) & " " & theDescriptions(i) Selection.TypeParagraph Next i @@ -188,7 +188,7 @@ For l = LBound(cvProps("projects")(ID_SELF)) To UBound(cvProps("projects")(ID_SELF)) ' Debug.Print JsonConverter.ConvertToJson(cvProps("projects")(ID_SELF)(l), 2) titles(l) = CStr(cvProps("projects")(ID_SELF)(l)("title")(ID_SELF)) - descriptions(l) = CStr(cvProps("projects")(ID_SELF)(l)("title")(ID_SELF)) + descriptions(l) = CStr(cvProps("projects")(ID_SELF)(l)("description")(ID_SELF)) Next l DrawCompoundBulletedList titles, descriptions diff --git a/src/JsonConverter.bas b/src/JsonConverter.bas deleted file mode 100644 index 0767e1d..0000000 100644 --- a/src/JsonConverter.bas +++ /dev/null @@ -1,1123 +1,0 @@ -Attribute VB_Name = "JsonConverter" -'' -' VBA-JSON v2.3.1 -' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON -' -' JSON Converter for VBA -' -' Errors: -' 10001 - JSON parse error -' -' @class JsonConverter -' @author tim.hall.engr@gmail.com -' @license MIT (http://www.opensource.org/licenses/mit-license.php) -'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -' -' Based originally on vba-json (with extensive changes) -' BSD license included below -' -' JSONLib, http://code.google.com/p/vba-json/ -' -' Copyright (c) 2013, Ryo Yokoyama -' All rights reserved. -' -' Redistribution and use in source and binary forms, with or without -' modification, are permitted provided that the following conditions are met: -' * Redistributions of source code must retain the above copyright -' notice, this list of conditions and the following disclaimer. -' * Redistributions in binary form must reproduce the above copyright -' notice, this list of conditions and the following disclaimer in the -' documentation and/or other materials provided with the distribution. -' * Neither the name of the nor the -' names of its contributors may be used to endorse or promote products -' derived from this software without specific prior written permission. -' -' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -' ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -' WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -' DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY -' DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -' (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -' LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -' ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -' (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -' SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' -Option Explicit - -' === VBA-UTC Headers -#If Mac Then - -#If VBA7 Then - -' 64-bit Mac (2016) -Private Declare PtrSafe Function utc_popen Lib "/usr/lib/libc.dylib" Alias "popen" _ - (ByVal utc_Command As String, ByVal utc_Mode As String) As LongPtr -Private Declare PtrSafe Function utc_pclose Lib "/usr/lib/libc.dylib" Alias "pclose" _ - (ByVal utc_File As LongPtr) As LongPtr -Private Declare PtrSafe Function utc_fread Lib "/usr/lib/libc.dylib" Alias "fread" _ - (ByVal utc_Buffer As String, ByVal utc_Size As LongPtr, ByVal utc_Number As LongPtr, ByVal utc_File As LongPtr) As LongPtr -Private Declare PtrSafe Function utc_feof Lib "/usr/lib/libc.dylib" Alias "feof" _ - (ByVal utc_File As LongPtr) As LongPtr - -#Else - -' 32-bit Mac -Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" _ - (ByVal utc_Command As String, ByVal utc_Mode As String) As Long -Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" _ - (ByVal utc_File As Long) As Long -Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" _ - (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long -Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" _ - (ByVal utc_File As Long) As Long - -#End If - -#ElseIf VBA7 Then - -' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724421.aspx -' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724949.aspx -' http://msdn.microsoft.com/en-us/library/windows/desktop/ms725485.aspx -Private Declare PtrSafe Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _ - (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long -Private Declare PtrSafe Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _ - (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long -Private Declare PtrSafe Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _ - (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long - -#Else - -Private Declare Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _ - (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long -Private Declare Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _ - (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long -Private Declare Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _ - (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long - -#End If - -#If Mac Then - -#If VBA7 Then -Private Type utc_ShellResult - utc_Output As String - utc_ExitCode As LongPtr -End Type - -#Else - -Private Type utc_ShellResult - utc_Output As String - utc_ExitCode As Long -End Type - -#End If - -#Else - -Private Type utc_SYSTEMTIME - utc_wYear As Integer - utc_wMonth As Integer - utc_wDayOfWeek As Integer - utc_wDay As Integer - utc_wHour As Integer - utc_wMinute As Integer - utc_wSecond As Integer - utc_wMilliseconds As Integer -End Type - -Private Type utc_TIME_ZONE_INFORMATION - utc_Bias As Long - utc_StandardName(0 To 31) As Integer - utc_StandardDate As utc_SYSTEMTIME - utc_StandardBias As Long - utc_DaylightName(0 To 31) As Integer - utc_DaylightDate As utc_SYSTEMTIME - utc_DaylightBias As Long -End Type - -#End If -' === End VBA-UTC - -Private Type json_Options - ' VBA only stores 15 significant digits, so any numbers larger than that are truncated - ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits - ' See: http://support.microsoft.com/kb/269370 - ' - ' By default, VBA-JSON will use String for numbers longer than 15 characters that contain only digits - ' to override set `JsonConverter.JsonOptions.UseDoubleForLargeNumbers = True` - UseDoubleForLargeNumbers As Boolean - - ' The JSON standard requires object keys to be quoted (" or '), use this option to allow unquoted keys - AllowUnquotedKeys As Boolean - - ' The solidus (/) is not required to be escaped, use this option to escape them as \/ in ConvertToJson - EscapeSolidus As Boolean -End Type -Public JsonOptions As json_Options - -' ============================================= ' -' Public Methods -' ============================================= ' - -'' -' Convert JSON string to object (Dictionary/Collection) -' -' @method ParseJson -' @param {String} json_String -' @return {Object} (Dictionary or Collection) -' @throws 10001 - JSON parse error -'' -Public Function ParseJson(ByVal JsonString As String) As Object - Dim json_Index As Long - json_Index = 1 - - ' Remove vbCr, vbLf, and vbTab from json_String - JsonString = VBA.Replace(VBA.Replace(VBA.Replace(JsonString, VBA.vbCr, ""), VBA.vbLf, ""), VBA.vbTab, "") - - json_SkipSpaces JsonString, json_Index - Select Case VBA.Mid$(JsonString, json_Index, 1) - Case "{" - Set ParseJson = json_ParseObject(JsonString, json_Index) - Case "[" - Set ParseJson = json_ParseArray(JsonString, json_Index) - Case Else - ' Error: Invalid JSON string - Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['") - End Select -End Function - -'' -' Convert object (Dictionary/Collection/Array) to JSON -' -' @method ConvertToJson -' @param {Variant} JsonValue (Dictionary, Collection, or Array) -' @param {Integer|String} Whitespace "Pretty" print json with given number of spaces per indentation (Integer) or given string -' @return {String} -'' -Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitespace As Variant, Optional ByVal json_CurrentIndentation As Long = 0) As String - Dim json_Buffer As String - Dim json_BufferPosition As Long - Dim json_BufferLength As Long - Dim json_Index As Long - Dim json_LBound As Long - Dim json_UBound As Long - Dim json_IsFirstItem As Boolean - Dim json_Index2D As Long - Dim json_LBound2D As Long - Dim json_UBound2D As Long - Dim json_IsFirstItem2D As Boolean - Dim json_Key As Variant - Dim json_Value As Variant - Dim json_DateStr As String - Dim json_Converted As String - Dim json_SkipItem As Boolean - Dim json_PrettyPrint As Boolean - Dim json_Indentation As String - Dim json_InnerIndentation As String - - json_LBound = -1 - json_UBound = -1 - json_IsFirstItem = True - json_LBound2D = -1 - json_UBound2D = -1 - json_IsFirstItem2D = True - json_PrettyPrint = Not IsMissing(Whitespace) - - Select Case VBA.VarType(JsonValue) - Case VBA.vbNull - ConvertToJson = "null" - Case VBA.vbDate - ' Date - json_DateStr = ConvertToIso(VBA.CDate(JsonValue)) - - ConvertToJson = """" & json_DateStr & """" - Case VBA.vbString - ' String (or large number encoded as string) - If Not JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(JsonValue) Then - ConvertToJson = JsonValue - Else - ConvertToJson = """" & json_Encode(JsonValue) & """" - End If - Case VBA.vbBoolean - If JsonValue Then - ConvertToJson = "true" - Else - ConvertToJson = "false" - End If - Case VBA.vbArray To VBA.vbArray + VBA.vbByte - If json_PrettyPrint Then - If VBA.VarType(Whitespace) = VBA.vbString Then - json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace) - json_InnerIndentation = VBA.String$(json_CurrentIndentation + 2, Whitespace) - Else - json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace) - json_InnerIndentation = VBA.Space$((json_CurrentIndentation + 2) * Whitespace) - End If - End If - - ' Array - json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength - - On Error Resume Next - - json_LBound = LBound(JsonValue, 1) - json_UBound = UBound(JsonValue, 1) - json_LBound2D = LBound(JsonValue, 2) - json_UBound2D = UBound(JsonValue, 2) - - If json_LBound >= 0 And json_UBound >= 0 Then - For json_Index = json_LBound To json_UBound - If json_IsFirstItem Then - json_IsFirstItem = False - Else - ' Append comma to previous line - json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength - End If - - If json_LBound2D >= 0 And json_UBound2D >= 0 Then - ' 2D Array - If json_PrettyPrint Then - json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength - End If - json_BufferAppend json_Buffer, json_Indentation & "[", json_BufferPosition, json_BufferLength - - For json_Index2D = json_LBound2D To json_UBound2D - If json_IsFirstItem2D Then - json_IsFirstItem2D = False - Else - json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength - End If - - json_Converted = ConvertToJson(JsonValue(json_Index, json_Index2D), Whitespace, json_CurrentIndentation + 2) - - ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null - If json_Converted = "" Then - ' (nest to only check if converted = "") - If json_IsUndefined(JsonValue(json_Index, json_Index2D)) Then - json_Converted = "null" - End If - End If - - If json_PrettyPrint Then - json_Converted = vbNewLine & json_InnerIndentation & json_Converted - End If - - json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength - Next json_Index2D - - If json_PrettyPrint Then - json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength - End If - - json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength - json_IsFirstItem2D = True - Else - ' 1D Array - json_Converted = ConvertToJson(JsonValue(json_Index), Whitespace, json_CurrentIndentation + 1) - - ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null - If json_Converted = "" Then - ' (nest to only check if converted = "") - If json_IsUndefined(JsonValue(json_Index)) Then - json_Converted = "null" - End If - End If - - If json_PrettyPrint Then - json_Converted = vbNewLine & json_Indentation & json_Converted - End If - - json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength - End If - Next json_Index - End If - - On Error GoTo 0 - - If json_PrettyPrint Then - json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength - - If VBA.VarType(Whitespace) = VBA.vbString Then - json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) - Else - json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace) - End If - End If - - json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength - - ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition) - - ' Dictionary or Collection - Case VBA.vbObject - If json_PrettyPrint Then - If VBA.VarType(Whitespace) = VBA.vbString Then - json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace) - Else - json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace) - End If - End If - - ' Dictionary - If VBA.TypeName(JsonValue) = "Dictionary" Then - json_BufferAppend json_Buffer, "{", json_BufferPosition, json_BufferLength - For Each json_Key In JsonValue.Keys - ' For Objects, undefined (Empty/Nothing) is not added to object - json_Converted = ConvertToJson(JsonValue(json_Key), Whitespace, json_CurrentIndentation + 1) - If json_Converted = "" Then - json_SkipItem = json_IsUndefined(JsonValue(json_Key)) - Else - json_SkipItem = False - End If - - If Not json_SkipItem Then - If json_IsFirstItem Then - json_IsFirstItem = False - Else - json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength - End If - - If json_PrettyPrint Then - json_Converted = vbNewLine & json_Indentation & """" & json_Key & """: " & json_Converted - Else - json_Converted = """" & json_Key & """:" & json_Converted - End If - - json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength - End If - Next json_Key - - If json_PrettyPrint Then - json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength - - If VBA.VarType(Whitespace) = VBA.vbString Then - json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) - Else - json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace) - End If - End If - - json_BufferAppend json_Buffer, json_Indentation & "}", json_BufferPosition, json_BufferLength - - ' Collection - ElseIf VBA.TypeName(JsonValue) = "Collection" Then - json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength - For Each json_Value In JsonValue - If json_IsFirstItem Then - json_IsFirstItem = False - Else - json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength - End If - - json_Converted = ConvertToJson(json_Value, Whitespace, json_CurrentIndentation + 1) - - ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null - If json_Converted = "" Then - ' (nest to only check if converted = "") - If json_IsUndefined(json_Value) Then - json_Converted = "null" - End If - End If - - If json_PrettyPrint Then - json_Converted = vbNewLine & json_Indentation & json_Converted - End If - - json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength - Next json_Value - - If json_PrettyPrint Then - json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength - - If VBA.VarType(Whitespace) = VBA.vbString Then - json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) - Else - json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace) - End If - End If - - json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength - End If - - ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition) - Case VBA.vbInteger, VBA.vbLong, VBA.vbSingle, VBA.vbDouble, VBA.vbCurrency, VBA.vbDecimal - ' Number (use decimals for numbers) - ConvertToJson = VBA.Replace(JsonValue, ",", ".") - Case Else - ' vbEmpty, vbError, vbDataObject, vbByte, vbUserDefinedType - ' Use VBA's built-in to-string - On Error Resume Next - ConvertToJson = JsonValue - On Error GoTo 0 - End Select -End Function - -' ============================================= ' -' Private Functions -' ============================================= ' - -Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Dictionary - Dim json_Key As String - Dim json_NextChar As String - - Set json_ParseObject = New Dictionary - json_SkipSpaces json_String, json_Index - If VBA.Mid$(json_String, json_Index, 1) <> "{" Then - Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '{'") - Else - json_Index = json_Index + 1 - - Do - json_SkipSpaces json_String, json_Index - If VBA.Mid$(json_String, json_Index, 1) = "}" Then - json_Index = json_Index + 1 - Exit Function - ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then - json_Index = json_Index + 1 - json_SkipSpaces json_String, json_Index - End If - - json_Key = json_ParseKey(json_String, json_Index) - json_NextChar = json_Peek(json_String, json_Index) - If json_NextChar = "[" Or json_NextChar = "{" Then - Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index) - Else - json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index) - End If - Loop - End If -End Function - -Private Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection - Set json_ParseArray = New Collection - - json_SkipSpaces json_String, json_Index - If VBA.Mid$(json_String, json_Index, 1) <> "[" Then - Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '['") - Else - json_Index = json_Index + 1 - - Do - json_SkipSpaces json_String, json_Index - If VBA.Mid$(json_String, json_Index, 1) = "]" Then - json_Index = json_Index + 1 - Exit Function - ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then - json_Index = json_Index + 1 - json_SkipSpaces json_String, json_Index - End If - - json_ParseArray.Add json_ParseValue(json_String, json_Index) - Loop - End If -End Function - -Private Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant - json_SkipSpaces json_String, json_Index - Select Case VBA.Mid$(json_String, json_Index, 1) - Case "{" - Set json_ParseValue = json_ParseObject(json_String, json_Index) - Case "[" - Set json_ParseValue = json_ParseArray(json_String, json_Index) - Case """", "'" - json_ParseValue = json_ParseString(json_String, json_Index) - Case Else - If VBA.Mid$(json_String, json_Index, 4) = "true" Then - json_ParseValue = True - json_Index = json_Index + 4 - ElseIf VBA.Mid$(json_String, json_Index, 5) = "false" Then - json_ParseValue = False - json_Index = json_Index + 5 - ElseIf VBA.Mid$(json_String, json_Index, 4) = "null" Then - json_ParseValue = Null - json_Index = json_Index + 4 - ElseIf VBA.InStr("+-0123456789", VBA.Mid$(json_String, json_Index, 1)) Then - json_ParseValue = json_ParseNumber(json_String, json_Index) - Else - Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['") - End If - End Select -End Function - -Private Function json_ParseString(json_String As String, ByRef json_Index As Long) As String - Dim json_Quote As String - Dim json_Char As String - Dim json_Code As String - Dim json_Buffer As String - Dim json_BufferPosition As Long - Dim json_BufferLength As Long - - json_SkipSpaces json_String, json_Index - - ' Store opening quote to look for matching closing quote - json_Quote = VBA.Mid$(json_String, json_Index, 1) - json_Index = json_Index + 1 - - Do While json_Index > 0 And json_Index <= Len(json_String) - json_Char = VBA.Mid$(json_String, json_Index, 1) - - Select Case json_Char - Case "\" - ' Escaped string, \\, or \/ - json_Index = json_Index + 1 - json_Char = VBA.Mid$(json_String, json_Index, 1) - - Select Case json_Char - Case """", "\", "/", "'" - json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength - json_Index = json_Index + 1 - Case "b" - json_BufferAppend json_Buffer, vbBack, json_BufferPosition, json_BufferLength - json_Index = json_Index + 1 - Case "f" - json_BufferAppend json_Buffer, vbFormFeed, json_BufferPosition, json_BufferLength - json_Index = json_Index + 1 - Case "n" - json_BufferAppend json_Buffer, vbCrLf, json_BufferPosition, json_BufferLength - json_Index = json_Index + 1 - Case "r" - json_BufferAppend json_Buffer, vbCr, json_BufferPosition, json_BufferLength - json_Index = json_Index + 1 - Case "t" - json_BufferAppend json_Buffer, vbTab, json_BufferPosition, json_BufferLength - json_Index = json_Index + 1 - Case "u" - ' Unicode character escape (e.g. \u00a9 = Copyright) - json_Index = json_Index + 1 - json_Code = VBA.Mid$(json_String, json_Index, 4) - json_BufferAppend json_Buffer, VBA.ChrW(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength - json_Index = json_Index + 4 - End Select - Case json_Quote - json_ParseString = json_BufferToString(json_Buffer, json_BufferPosition) - json_Index = json_Index + 1 - Exit Function - Case Else - json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength - json_Index = json_Index + 1 - End Select - Loop -End Function - -Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant - Dim json_Char As String - Dim json_Value As String - Dim json_IsLargeNumber As Boolean - - json_SkipSpaces json_String, json_Index - - Do While json_Index > 0 And json_Index <= Len(json_String) - json_Char = VBA.Mid$(json_String, json_Index, 1) - - If VBA.InStr("+-0123456789.eE", json_Char) Then - ' Unlikely to have massive number, so use simple append rather than buffer here - json_Value = json_Value & json_Char - json_Index = json_Index + 1 - Else - ' Excel only stores 15 significant digits, so any numbers larger than that are truncated - ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits - ' See: http://support.microsoft.com/kb/269370 - ' - ' Fix: Parse -> String, Convert -> String longer than 15/16 characters containing only numbers and decimal points -> Number - ' (decimal doesn't factor into significant digit count, so if present check for 15 digits + decimal = 16) - json_IsLargeNumber = IIf(InStr(json_Value, "."), Len(json_Value) >= 17, Len(json_Value) >= 16) - If Not JsonOptions.UseDoubleForLargeNumbers And json_IsLargeNumber Then - json_ParseNumber = json_Value - Else - ' VBA.Val does not use regional settings, so guard for comma is not needed - json_ParseNumber = VBA.Val(json_Value) - End If - Exit Function - End If - Loop -End Function - -Private Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String - ' Parse key with single or double quotes - If VBA.Mid$(json_String, json_Index, 1) = """" Or VBA.Mid$(json_String, json_Index, 1) = "'" Then - json_ParseKey = json_ParseString(json_String, json_Index) - ElseIf JsonOptions.AllowUnquotedKeys Then - Dim json_Char As String - Do While json_Index > 0 And json_Index <= Len(json_String) - json_Char = VBA.Mid$(json_String, json_Index, 1) - If (json_Char <> " ") And (json_Char <> ":") Then - json_ParseKey = json_ParseKey & json_Char - json_Index = json_Index + 1 - Else - Exit Do - End If - Loop - Else - Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '""' or '''") - End If - - ' Check for colon and skip if present or throw if not present - json_SkipSpaces json_String, json_Index - If VBA.Mid$(json_String, json_Index, 1) <> ":" Then - Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting ':'") - Else - json_Index = json_Index + 1 - End If -End Function - -Private Function json_IsUndefined(ByVal json_Value As Variant) As Boolean - ' Empty / Nothing -> undefined - Select Case VBA.VarType(json_Value) - Case VBA.vbEmpty - json_IsUndefined = True - Case VBA.vbObject - Select Case VBA.TypeName(json_Value) - Case "Empty", "Nothing" - json_IsUndefined = True - End Select - End Select -End Function - -Private Function json_Encode(ByVal json_Text As Variant) As String - ' Reference: http://www.ietf.org/rfc/rfc4627.txt - ' Escape: ", \, /, backspace, form feed, line feed, carriage return, tab - Dim json_Index As Long - Dim json_Char As String - Dim json_AscCode As Long - Dim json_Buffer As String - Dim json_BufferPosition As Long - Dim json_BufferLength As Long - - For json_Index = 1 To VBA.Len(json_Text) - json_Char = VBA.Mid$(json_Text, json_Index, 1) - json_AscCode = VBA.AscW(json_Char) - - ' When AscW returns a negative number, it returns the twos complement form of that number. - ' To convert the twos complement notation into normal binary notation, add 0xFFF to the return result. - ' https://support.microsoft.com/en-us/kb/272138 - If json_AscCode < 0 Then - json_AscCode = json_AscCode + 65536 - End If - - ' From spec, ", \, and control characters must be escaped (solidus is optional) - - Select Case json_AscCode - Case 34 - ' " -> 34 -> \" - json_Char = "\""" - Case 92 - ' \ -> 92 -> \\ - json_Char = "\\" - Case 47 - ' / -> 47 -> \/ (optional) - If JsonOptions.EscapeSolidus Then - json_Char = "\/" - End If - Case 8 - ' backspace -> 8 -> \b - json_Char = "\b" - Case 12 - ' form feed -> 12 -> \f - json_Char = "\f" - Case 10 - ' line feed -> 10 -> \n - json_Char = "\n" - Case 13 - ' carriage return -> 13 -> \r - json_Char = "\r" - Case 9 - ' tab -> 9 -> \t - json_Char = "\t" - Case 0 To 31, 127 To 65535 - ' Non-ascii characters -> convert to 4-digit hex - json_Char = "\u" & VBA.Right$("0000" & VBA.Hex$(json_AscCode), 4) - End Select - - json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength - Next json_Index - - json_Encode = json_BufferToString(json_Buffer, json_BufferPosition) -End Function - -Private Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String - ' "Peek" at the next number of characters without incrementing json_Index (ByVal instead of ByRef) - json_SkipSpaces json_String, json_Index - json_Peek = VBA.Mid$(json_String, json_Index, json_NumberOfCharacters) -End Function - -Private Sub json_SkipSpaces(json_String As String, ByRef json_Index As Long) - ' Increment index to skip over spaces - Do While json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = " " - json_Index = json_Index + 1 - Loop -End Sub - -Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean - ' Check if the given string is considered a "large number" - ' (See json_ParseNumber) - - Dim json_Length As Long - Dim json_CharIndex As Long - json_Length = VBA.Len(json_String) - - ' Length with be at least 16 characters and assume will be less than 100 characters - If json_Length >= 16 And json_Length <= 100 Then - Dim json_CharCode As String - - json_StringIsLargeNumber = True - - For json_CharIndex = 1 To json_Length - json_CharCode = VBA.Asc(VBA.Mid$(json_String, json_CharIndex, 1)) - Select Case json_CharCode - ' Look for .|0-9|E|e - Case 46, 48 To 57, 69, 101 - ' Continue through characters - Case Else - json_StringIsLargeNumber = False - Exit Function - End Select - Next json_CharIndex - End If -End Function - -Private Function json_ParseErrorMessage(json_String As String, ByRef json_Index As Long, ErrorMessage As String) - ' Provide detailed parse error message, including details of where and what occurred - ' - ' Example: - ' Error parsing JSON: - ' {"abcde":True} - ' ^ - ' Expecting 'STRING', 'NUMBER', null, true, false, '{', or '[' - - Dim json_StartIndex As Long - Dim json_StopIndex As Long - - ' Include 10 characters before and after error (if possible) - json_StartIndex = json_Index - 10 - json_StopIndex = json_Index + 10 - If json_StartIndex <= 0 Then - json_StartIndex = 1 - End If - If json_StopIndex > VBA.Len(json_String) Then - json_StopIndex = VBA.Len(json_String) - End If - - json_ParseErrorMessage = "Error parsing JSON:" & VBA.vbNewLine & _ - VBA.Mid$(json_String, json_StartIndex, json_StopIndex - json_StartIndex + 1) & VBA.vbNewLine & _ - VBA.Space$(json_Index - json_StartIndex) & "^" & VBA.vbNewLine & _ - ErrorMessage -End Function - -Private Sub json_BufferAppend(ByRef json_Buffer As String, _ - ByRef json_Append As Variant, _ - ByRef json_BufferPosition As Long, _ - ByRef json_BufferLength As Long) - ' VBA can be slow to append strings due to allocating a new string for each append - ' Instead of using the traditional append, allocate a large empty string and then copy string at append position - ' - ' Example: - ' Buffer: "abc " - ' Append: "def" - ' Buffer Position: 3 - ' Buffer Length: 5 - ' - ' Buffer position + Append length > Buffer length -> Append chunk of blank space to buffer - ' Buffer: "abc " - ' Buffer Length: 10 - ' - ' Put "def" into buffer at position 3 (0-based) - ' Buffer: "abcdef " - ' - ' Approach based on cStringBuilder from vbAccelerator - ' http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.asp - ' - ' and clsStringAppend from Philip Swannell - ' https://github.com/VBA-tools/VBA-JSON/pull/82 - - Dim json_AppendLength As Long - Dim json_LengthPlusPosition As Long - - json_AppendLength = VBA.Len(json_Append) - json_LengthPlusPosition = json_AppendLength + json_BufferPosition - - If json_LengthPlusPosition > json_BufferLength Then - ' Appending would overflow buffer, add chunk - ' (double buffer length or append length, whichever is bigger) - Dim json_AddedLength As Long - json_AddedLength = IIf(json_AppendLength > json_BufferLength, json_AppendLength, json_BufferLength) - - json_Buffer = json_Buffer & VBA.Space$(json_AddedLength) - json_BufferLength = json_BufferLength + json_AddedLength - End If - - ' Note: Namespacing with VBA.Mid$ doesn't work properly here, throwing compile error: - ' Function call on left-hand side of assignment must return Variant or Object - Mid$(json_Buffer, json_BufferPosition + 1, json_AppendLength) = CStr(json_Append) - json_BufferPosition = json_BufferPosition + json_AppendLength -End Sub - -Private Function json_BufferToString(ByRef json_Buffer As String, ByVal json_BufferPosition As Long) As String - If json_BufferPosition > 0 Then - json_BufferToString = VBA.Left$(json_Buffer, json_BufferPosition) - End If -End Function - -'' -' VBA-UTC v1.0.6 -' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter -' -' UTC/ISO 8601 Converter for VBA -' -' Errors: -' 10011 - UTC parsing error -' 10012 - UTC conversion error -' 10013 - ISO 8601 parsing error -' 10014 - ISO 8601 conversion error -' -' @module UtcConverter -' @author tim.hall.engr@gmail.com -' @license MIT (http://www.opensource.org/licenses/mit-license.php) -'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' - -' (Declarations moved to top) - -' ============================================= ' -' Public Methods -' ============================================= ' - -'' -' Parse UTC date to local date -' -' @method ParseUtc -' @param {Date} UtcDate -' @return {Date} Local date -' @throws 10011 - UTC parsing error -'' -Public Function ParseUtc(utc_UtcDate As Date) As Date - On Error GoTo utc_ErrorHandling - -#If Mac Then - ParseUtc = utc_ConvertDate(utc_UtcDate) -#Else - Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION - Dim utc_LocalDate As utc_SYSTEMTIME - - utc_GetTimeZoneInformation utc_TimeZoneInfo - utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate - - ParseUtc = utc_SystemTimeToDate(utc_LocalDate) -#End If - - Exit Function - -utc_ErrorHandling: - Err.Raise 10011, "UtcConverter.ParseUtc", "UTC parsing error: " & Err.Number & " - " & Err.Description -End Function - -'' -' Convert local date to UTC date -' -' @method ConvertToUrc -' @param {Date} utc_LocalDate -' @return {Date} UTC date -' @throws 10012 - UTC conversion error -'' -Public Function ConvertToUtc(utc_LocalDate As Date) As Date - On Error GoTo utc_ErrorHandling - -#If Mac Then - ConvertToUtc = utc_ConvertDate(utc_LocalDate, utc_ConvertToUtc:=True) -#Else - Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION - Dim utc_UtcDate As utc_SYSTEMTIME - - utc_GetTimeZoneInformation utc_TimeZoneInfo - utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate - - ConvertToUtc = utc_SystemTimeToDate(utc_UtcDate) -#End If - - Exit Function - -utc_ErrorHandling: - Err.Raise 10012, "UtcConverter.ConvertToUtc", "UTC conversion error: " & Err.Number & " - " & Err.Description -End Function - -'' -' Parse ISO 8601 date string to local date -' -' @method ParseIso -' @param {Date} utc_IsoString -' @return {Date} Local date -' @throws 10013 - ISO 8601 parsing error -'' -Public Function ParseIso(utc_IsoString As String) As Date - On Error GoTo utc_ErrorHandling - - Dim utc_Parts() As String - Dim utc_DateParts() As String - Dim utc_TimeParts() As String - Dim utc_OffsetIndex As Long - Dim utc_HasOffset As Boolean - Dim utc_NegativeOffset As Boolean - Dim utc_OffsetParts() As String - Dim utc_Offset As Date - - utc_Parts = VBA.Split(utc_IsoString, "T") - utc_DateParts = VBA.Split(utc_Parts(0), "-") - ParseIso = VBA.DateSerial(VBA.CInt(utc_DateParts(0)), VBA.CInt(utc_DateParts(1)), VBA.CInt(utc_DateParts(2))) - - If UBound(utc_Parts) > 0 Then - If VBA.InStr(utc_Parts(1), "Z") Then - utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", ""), ":") - Else - utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "+") - If utc_OffsetIndex = 0 Then - utc_NegativeOffset = True - utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "-") - End If - - If utc_OffsetIndex > 0 Then - utc_HasOffset = True - utc_TimeParts = VBA.Split(VBA.Left$(utc_Parts(1), utc_OffsetIndex - 1), ":") - utc_OffsetParts = VBA.Split(VBA.Right$(utc_Parts(1), Len(utc_Parts(1)) - utc_OffsetIndex), ":") - - Select Case UBound(utc_OffsetParts) - Case 0 - utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), 0, 0) - Case 1 - utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0) - Case 2 - ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues - utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2)))) - End Select - - If utc_NegativeOffset Then: utc_Offset = -utc_Offset - Else - utc_TimeParts = VBA.Split(utc_Parts(1), ":") - End If - End If - - Select Case UBound(utc_TimeParts) - Case 0 - ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), 0, 0) - Case 1 - ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0) - Case 2 - ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues - ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2)))) - End Select - - ParseIso = ParseUtc(ParseIso) - - If utc_HasOffset Then - ParseIso = ParseIso - utc_Offset - End If - End If - - Exit Function - -utc_ErrorHandling: - Err.Raise 10013, "UtcConverter.ParseIso", "ISO 8601 parsing error for " & utc_IsoString & ": " & Err.Number & " - " & Err.Description -End Function - -'' -' Convert local date to ISO 8601 string -' -' @method ConvertToIso -' @param {Date} utc_LocalDate -' @return {Date} ISO 8601 string -' @throws 10014 - ISO 8601 conversion error -'' -Public Function ConvertToIso(utc_LocalDate As Date) As String - On Error GoTo utc_ErrorHandling - - ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z") - - Exit Function - -utc_ErrorHandling: - Err.Raise 10014, "UtcConverter.ConvertToIso", "ISO 8601 conversion error: " & Err.Number & " - " & Err.Description -End Function - -' ============================================= ' -' Private Functions -' ============================================= ' - -#If Mac Then - -Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As Boolean = False) As Date - Dim utc_ShellCommand As String - Dim utc_Result As utc_ShellResult - Dim utc_Parts() As String - Dim utc_DateParts() As String - Dim utc_TimeParts() As String - - If utc_ConvertToUtc Then - utc_ShellCommand = "date -ur `date -jf '%Y-%m-%d %H:%M:%S' " & _ - "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & "' " & _ - " +'%s'` +'%Y-%m-%d %H:%M:%S'" - Else - utc_ShellCommand = "date -jf '%Y-%m-%d %H:%M:%S %z' " & _ - "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & " +0000' " & _ - "+'%Y-%m-%d %H:%M:%S'" - End If - - utc_Result = utc_ExecuteInShell(utc_ShellCommand) - - If utc_Result.utc_Output = "" Then - Err.Raise 10015, "UtcConverter.utc_ConvertDate", "'date' command failed" - Else - utc_Parts = Split(utc_Result.utc_Output, " ") - utc_DateParts = Split(utc_Parts(0), "-") - utc_TimeParts = Split(utc_Parts(1), ":") - - utc_ConvertDate = DateSerial(utc_DateParts(0), utc_DateParts(1), utc_DateParts(2)) + _ - TimeSerial(utc_TimeParts(0), utc_TimeParts(1), utc_TimeParts(2)) - End If -End Function - -Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult -#If VBA7 Then - Dim utc_File As LongPtr - Dim utc_Read As LongPtr -#Else - Dim utc_File As Long - Dim utc_Read As Long -#End If - - Dim utc_Chunk As String - - On Error GoTo utc_ErrorHandling - utc_File = utc_popen(utc_ShellCommand, "r") - - If utc_File = 0 Then: Exit Function - - Do While utc_feof(utc_File) = 0 - utc_Chunk = VBA.Space$(50) - utc_Read = CLng(utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File)) - If utc_Read > 0 Then - utc_Chunk = VBA.Left$(utc_Chunk, CLng(utc_Read)) - utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk - End If - Loop - -utc_ErrorHandling: - utc_ExecuteInShell.utc_ExitCode = CLng(utc_pclose(utc_File)) -End Function - -#Else - -Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME - utc_DateToSystemTime.utc_wYear = VBA.Year(utc_Value) - utc_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value) - utc_DateToSystemTime.utc_wDay = VBA.Day(utc_Value) - utc_DateToSystemTime.utc_wHour = VBA.Hour(utc_Value) - utc_DateToSystemTime.utc_wMinute = VBA.Minute(utc_Value) - utc_DateToSystemTime.utc_wSecond = VBA.Second(utc_Value) - utc_DateToSystemTime.utc_wMilliseconds = 0 -End Function - -Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date - utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _ - TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond) -End Function - -#End If diff --git a/src/Project.ini b/src/Project.ini index d3c84c5..5eff77e 100644 --- a/src/Project.ini +++ a/src/Project.ini @@ -1,13 +1,13 @@ CodePage=1252 SysKind=3 Version=1761683227.9 -ID="{0F3D9E32-5905-4E2D-8044-5C70D59D067F}" +ID="{A53BBDAC-3550-48F5-958E-E0945EBB4062}" Name="Project" HelpContextID="0" VersionCompatible32="393222000" -CMG="7476B23FB646BA46BA46BA46BA" -DPB="7775B138B738BB39BB39BB" -GC="7A78BC3DBE3EBE3E41" +CMG="5052BC3AC03AC03AC03AC0" +DPB="BFBD53C6AD5A1D5B1D5B1D" +GC="2E2CC2775E89CC8ACC8A33" [Host Extender Info] &H00000001={3832D640-CF90-11CF-8E43-00A0C911005A};VBE;&H00000000 diff --git a/src/ThisDocument.cls b/src/ThisDocument.cls deleted file mode 100644 index 3b55701..0000000 100644 --- a/src/ThisDocument.cls +++ /dev/null @@ -1,13 +1,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "ThisDocument" -Attribute VB_Base = "1TemplateProject.ThisDocument" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = True -Attribute VB_Exposed = True -Attribute VB_TemplateDerived = True -Attribute VB_Customizable = True -Option Explicit diff --git a/src.bak/Class Modules/YAML.cls b/src.bak/Class Modules/YAML.cls deleted file mode 100644 index 92b84ad..0000000 100644 --- a/src.bak/Class Modules/YAML.cls +++ /dev/null @@ -1,353 +1,0 @@ -VERSION 1.0 CLASS -BEGIN - MultiUse = -1 'True -END -Attribute VB_Name = "YAML" -Attribute VB_GlobalNameSpace = False -Attribute VB_Creatable = False -Attribute VB_PredeclaredId = False -Attribute VB_Exposed = False -Option Explicit - -' Const yamlPath As String = "\\Mac\iCloud\Development\cv\cv.yml" - -' enums - -Public yamlPath As String -Public yamlSerialised As Dictionary - -Private Const ID_SELF As String = "___self___" -Private Const ID_TYPE As String = "___type___" - -Private Const MESSAGE_ERROR_GENERIC As String = "YAML Error in " & yamlPath -Private Const MESSAGE_MALFORMED_TYPE As String = "Malformed YAML code at " & yamlPath & " on line " -Private Const MESSAGE_MALFORMED_YAML As String = "Malformed type error - this is a problem with the internal dictionary" -Private Const MESSAGE_GETPROP_NOT_STR As String = "Your module has tried to use getProp(), which is meant for type String, on a " -Private Const MESSAGE_GETPROP_NOT_FOUND As String = "Property not found." - -Private Function RemoveEmptyStrings(arr() As String) As String() - Dim tempArray() As String - Dim i As Integer, j As Integer: j = 0 - ReDim tempArray(LBound(arr) To UBound(arr)) - j = 0 - For i = LBound(arr) To UBound(arr) - If Len(arr(i)) > 0 Then - tempArray(j) = arr(i) - j = j + 1 - End If - Next i - ReDim Preserve tempArray(0 To j - 1) - RemoveEmptyStrings = tempArray -End Function - - -Private Function RegexMatch(inputString As String, pattern As String, Optional isGlobal As Boolean = True) As Boolean - ' checks for regex match without instantiating 80 gazillion objects - - ' parameters - ' isGlobal: whether the regex check is global - - Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp") - Regex.pattern = pattern - Regex.Global = isGlobal - RegexMatch = Regex.Test(inputString) -End Function - -Private Function RegexSplit(inputString As String, pattern As String, Optional onlyFirst As Boolean = False, Optional splitBefore As Boolean = False) As String() - ' splits array at any pattern that matches a regex - - ' parameters - ' onlyFirst: if true, only splits the first instance of the match, creating an array of length 2 - ' splitBefore: if true, preserves the actual instance of the match - - Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp") - Dim matches As Object - Dim match As Object - Dim splitParts() As String: ReDim splitParts(0 To 0) - Dim pos As Integer - Dim lastPos As Integer: lastPos = 1 - Dim i As Integer: i = 0 - - ' set regex flags - Regex.Global = True - Regex.IgnoreCase = False - Regex.pattern = pattern - - Set matches = Regex.Execute(inputString) - - ' lastPos = 1 - ' i = 0 - - For Each match In matches - pos = match.FirstIndex + 1 - ReDim Preserve splitParts(i) - splitParts(i) = Mid(inputString, lastPos, pos - lastPos) - If splitBefore Then - lastPos = pos - Else - lastPos = pos + Len(match.Value) - End If - i = i + 1 - If onlyFirst Then Exit For - Next match - - If lastPos <= Len(inputString) Then - ReDim Preserve splitParts(i) - splitParts(i) = Mid(inputString, lastPos) - End If - - ' retvrn - RegexSplit = RemoveEmptyStrings(splitParts) -End Function - -Private Function RegexSubstitute(inputString As String, pattern As String, Optional substitution As String = "") - ' does what it says on the tin - Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp") - Regex.pattern = pattern - Regex.IgnoreCase = False - Regex.Global = True - RegexSubstitute = Regex.Replace(inputString, substitution) -End Function - -' YAML Layer Parser Pseudocode -' ==== -' function GetYAMLLayerAsCollection(String fromYAML) { -' Collection mainDictionary = New Collection(); -' if (fromYAML.containsRegex(/\n[A-Za-z]/)) { -' // is a dictionary -' String[] temporaryArray = fromYAML.split(/\n[A-Za-z]/); -' for each x in temporaryArray { -' x.splitByFirstInstanceOf(':\n'); -' x[1].replaceAllInstancesOf(' -' mainDictionary.add(x[0], x[1]); -' } -' } else if (fromYAML.containsRegex(/\n-/)) { -' // if array, process the array and return it as "self" -' String[] temporaryArray = fromYAML.splitBy('\n-'); -' for each x in temporaryArray { -' x.removeAllInstancesOf('\n- '); -' x.replaceAllInstancesOf('\n ', '\n'); -' mainDictionary.add("self", temporaryArray); -' } -' } else if (fromYAML.startsWith('"')) { -' mainDictionary.add("self", removeQuotes(fromYAML)); -' } else { -' MsgBox("Processing error: neither array, dictionary, nor string"); -' } -' } - - -Private Function GetYAMLLayerAsDictionary(fromYAML As String) As Dictionary - Dim mainDictionary As Dictionary: Set mainDictionary = New Dictionary - ' create regex objects to test for dict, array, and string - - 'Dim regEx_dict As Object: Set regEx_dict = CreateObject("VBScript.RegExp") - 'Dim regEx_arry As Object: Set regEx_arry = CreateObject("VBScript.RegExp") - 'Dim regEx_strn As Object: Set regEx_strn = CreateObject("VBScript.RegExp") - - 'regEx_dict.Global = True: regEx_dict.Pattern = "\n[A-Za-z]" - 'regEx_arry.Global = True: regEx_arry.Pattern = "\n-\s" - 'regEx_strn.Global = False: regEx_strn.Pattern = "^\s*""(.*?)""\s*$" - - Dim parts() As String - - If RegexMatch(fromYAML, "(?:\n|\^)\w+:", True) Then - ' is a dictionary - parts = RegexSplit(fromYAML, "\n\w+:", False, True) - Dim part As Variant ' not sure why it can't be as string but whatever billy gates - Call mainDictionary.Add(typeIdentifier, "Dictionary") ' identify as dict - For Each part In parts - Dim keyValue() As String: keyValue = RegexSplit(CStr(part), ":\s", True) - ' trim trailing \n from category - If UBound(keyValue) > 0 Then - keyValue(0) = RegexSubstitute(keyValue(0), "^\n+") - ' trim 2 spaces off of each line if they're there - keyValue(1) = RegexSubstitute(keyValue(1), "^\s{2}") - keyValue(1) = RegexSubstitute(keyValue(1), "\n\s{2}", vbLf) - Call mainDictionary.Add(keyValue(0), keyValue(1)) - End If - Next part - ElseIf RegexMatch(fromYAML, "^-\s", True) Then - ' is an array - Call mainDictionary.Add(typeIdentifier, "Array") - parts = RegexSplit(fromYAML, "(^|\n)-\s", False) - Dim i As Integer - For i = LBound(parts) To UBound(parts) - parts(i) = RegexSubstitute(parts(i), "\n\s{2}", vbLf) - Next i - Call mainDictionary.Add(selfIdentifier, parts) - ElseIf RegexMatch(fromYAML, "^\s*""(.*?)""\s*$", True) Then - ' is a string - Call mainDictionary.Add(typeIdentifier, "String") - Call mainDictionary.Add(selfIdentifier, RegexSubstitute(fromYAML, """", "")) - Else - Call mainDictionary.Add(selfIdentifier, "") - Debug.Print _ - "Neither array, dictionary, nor string:" & _ - vbCrLf & vbCrLf & fromYAML & vbCrLf & vbCrLf & _ - "Make sure all strings are enclosed in double quotes." ', _ - 'vbOKOnly, "YAML Error") - End If - - Set GetYAMLLayerAsDictionary = mainDictionary -End Function - -' YAML Traverser Pseudocode -' === -' -' function TraverseYAML(String fromYAML) { -' Dictionary mainDictionary = GetYAMLLayerAsDictionary(fromYAML); -' if mainDictionary.___type___ = "Dictionary" { -' for each entry in mainDictionary { -' TraverseYAML(entry) -' } -' return mainDictionary; -' } else if mainDictionary.___type___ = "Array" { -' for each entry in mainDictionary.___self___ { -' TraverseYAML(entry) -' } -' return mainDictionary; -' } else if mainDictionary.___type___ = "String" { -' return mainDictionary; -' } else { -' MsgBox("Internal YAML Error") -' } -' } -Private Function GetYAMLAsDictionary(fromYAML As String) As Dictionary - Dim mainDictionary As Object: Set mainDictionary = GetYAMLLayerAsDictionary(fromYAML) - Dim entry As Variant - If mainDictionary(typeIdentifier) = "Dictionary" Then - For Each entry In mainDictionary - Debug.Print "=== PROCESSING DICTIONARY ENTRY ===" - Debug.Print entry & " => " & mainDictionary(entry) - If entry <> typeIdentifier And entry <> selfIdentifier Then - Set mainDictionary(entry) = GetYAMLAsDictionary(mainDictionary(entry)) - End If - Next entry - ElseIf mainDictionary(typeIdentifier) = "Array" Then - Dim i As Integer - Dim subArray() As Object - For i = LBound(mainDictionary(selfIdentifier)) To UBound(mainDictionary(selfIdentifier)) - Debug.Print "=== PROCESSING ARRAY ENTRY ===" - Debug.Print mainDictionary(selfIdentifier)(i) - 'Set subDictionary = GetYAMLAsDictionary(mainDictionary(selfIdentifier)(i)) - 'Set mainDictionary(selfIdentifier)(i) = subDictionary - ReDim Preserve subArray(i) - Set subArray(i) = GetYAMLAsDictionary(CStr(mainDictionary(selfIdentifier)(i))) - Next i - - mainDictionary(selfIdentifier) = subArray - ElseIf mainDictionary(typeIdentifier) <> "String" Then - Debug.Print malformedTypeError ', vbOKOnly, errIdentifier) - End If - Set GetYAMLAsDictionary = mainDictionary -End Function - -' YAML Cleaner Pseudocode -' ===== -' function YAMLCleaner(Dictionary mainDictionary) { -' for each entry in mainDictionary { -' if entry(typeIdentifier) == "Dictionary" { -' for each secondOrderEntry in entry { -' YAMLCleaner(secondOrderEntry) -' } -' } else if entry(typeIdentifier) == "Array" { -' for each secondOrderEntry in entry(selfIdentifier) { -' YAMLCleaner(secondOrderEntry) -' } -' } -' if entry(typeIdentifier) != "Dictionary" { -' mainDictionary(entry) = mainDictionary(entry)(selfIdentifier) -' } -' } -' return mainDictionary; -' } - -'Function YAMLCleaner(mainDictionary As Dictionary) As Dictionary -' Dim entry As Variant -' If mainDictionary(typeIdentifier) = "Array" Then ' go through array and yamlclean it -' Dim i As Integer -' Debug.Print JsonConverter.ConvertToJson(mainDictionary) -' For i = LBound(mainDictionary(selfIdentifier)) To UBound(mainDictionary(selfIdentifier)) -' -' 'If IsObject(mainDictionary(selfIdentifier)(i)) Then -' 'Set mainDictionary(selfIdentifier)(i) = YAMLCleaner(mainDictionary(selfIdentifier)(i)) -' 'Else -' ' Debug.Print "encountered non-object" -' 'End If -' Next i -' End If -' If mainDictionary(typeIdentifier) = "Dictionary" Then 'iterate through dict and yamlclena it -' For Each entry In mainDictionary -' If entry <> typeIdentifier Then -' Set mainDictionary(entry) = YAMLCleaner(mainDictionary(entry)) -' End If -' Next entry -' End If -' -' For Each entry In mainDictionary -' If mainDictionary(typeIdentifier) = "Dictionary" And mainDictionary(entry)(typeIdentifier) <> "Dictionary" And entry <> typeIdentifier And entry <> selfIdentifier Then -' Debug.Print "processing " & entry & " which is " & mainDictionary(entry)(typeIdentifier) -' If IsObject(mainDictionary(entry)(selfIdentifier)) Then -' Set mainDictionary(entry) = mainDictionary(entry)(selfIdentifier) -' Else -' mainDictionary(entry) = mainDictionary(entry)(selfIdentifier) -' End If -' End If -' Next entry -' -' ' destroy type identifier? -' Set YAMLCleaner = mainDictionary -'End Function - -Private Function GetFileAsString(filePath As String) As String - ' Dim fileContent As String - Dim line As String - Dim fileNumber As Integer - - 'filePath = "\\Mac\iCloud\Development\cv\cv.yml" - - fileNumber = FreeFile() - - Open filePath For Input As fileNumber - - Do While Not EOF(fileNumber) - Line Input #fileNumber, line - GetFileAsString = GetFileAsString & line & vbCrLf - Loop -End Function - -Public Property Let path(thePath As String) - yamlPath = thePath -End Property - -Public Property Get path() As String - path = yamlPath -End Property - -Public Property Get props() As Dictionary - Set props = GetYAMLAsDictionary(GetFileAsString(yamlPath)) -End Property - -' YAML Indexer Pseudocode [implement later] -' ===== -' function index(string theIndex) { -' Variant[] mainArray = theIndex.split("."); -' Dictionary mainDictionary = yamlProps; -' for each entry in mainArray { -' if entry is { -' -' .... - - -'Public Sub TryFunction() -' Dim fileString As String: fileString = GetFileAsString("\\Mac\iCloud\Development\cv\cv.yml") -' Dim yamlLayer As Object -' Set yamlLayer = GetYAMLLayerAsDictionary(fileString) -' Dim yamlWholeDict As Object: Set yamlWholeDict = GetYAMLAsDictionary(fileString) -' 'Debug.Print JsonConverter.ConvertToJson(yamlWholeDict, 2, 2) -' Dim yamlCleanDict As Object: Set yamlCleanDict = YAMLCleaner(yamlWholeDict) -' Debug.Print JsonConverter.ConvertToJson(yamlCleanDict, 2, 2) -'End Sub - - diff --git a/src.bak/Modules/NewMacros.bas b/src.bak/Modules/NewMacros.bas deleted file mode 100644 index 96f47ca..0000000 100644 --- a/src.bak/Modules/NewMacros.bas +++ /dev/null @@ -1,58 +1,0 @@ -Attribute VB_Name = "NewMacros" -Option Explicit - -Sub Macro1() -Attribute Macro1.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1" -' -' Macro1 Macro -' -' - Selection.Style = ActiveDocument.Styles("Title") - Selection.TypeText Text:="This is a title" - Selection.TypeParagraph - Selection.TypeParagraph - Selection.Style = ActiveDocument.Styles("Heading 1") - Selection.TypeText Text:="Heading 1" - Selection.TypeParagraph - Selection.Style = ActiveDocument.Styles("No Spacing") - Selection.TypeText Text:="Whatababab" - Selection.TypeParagraph - With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1) - .NumberFormat = ChrW(61623) - .TrailingCharacter = wdTrailingTab - .NumberStyle = wdListNumberStyleBullet - .NumberPosition = InchesToPoints(0.25) - .Alignment = wdListLevelAlignLeft - .TextPosition = InchesToPoints(0.5) - .TabPosition = wdUndefined - .ResetOnHigher = 0 - .StartAt = 1 - With .Font - .Bold = wdUndefined - .Italic = wdUndefined - .StrikeThrough = wdUndefined - .Subscript = wdUndefined - .Superscript = wdUndefined - .Shadow = wdUndefined - .Outline = wdUndefined - .Emboss = wdUndefined - .Engrave = wdUndefined - .AllCaps = wdUndefined - .Hidden = wdUndefined - .Underline = wdUndefined - .Color = wdUndefined - .Size = wdUndefined - .Animation = wdUndefined - .DoubleStrikeThrough = wdUndefined - .Name = "Symbol" - End With - .LinkedStyle = "" - End With - ListGalleries(wdBulletGallery).ListTemplates(1).Name = "" - Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _ - ListGalleries(wdBulletGallery).ListTemplates(1), ContinuePreviousList:= _ - False, ApplyTo:=wdListApplyToWholeList, DefaultListBehavior:= _ - wdWord10ListBehavior - Selection.TypeText Text:="This is a bulletted list created manually" - Selection.EscapeKey -End Sub diff --git a/src.bak/Modules/YAMLParser_old.bas b/src.bak/Modules/YAMLParser_old.bas deleted file mode 100644 index cfcd417..0000000 100644 --- a/src.bak/Modules/YAMLParser_old.bas +++ /dev/null @@ -1,313 +1,0 @@ -Attribute VB_Name = "YAMLParser_old" -Option Explicit - -Const yamlPath As String = "\\Mac\iCloud\Development\cv\cv.yml" - -Const selfIdentifier As String = "___self___" -Const typeIdentifier As String = "___type___" -Const errIdentifier As String = "YAML Error in " & yamlPath - -Const malformedTypeError As String = "Malformed YAML code at " & yamlPath & " on line " -Const malformedYAMLError As String = "Malformed type error - this is a problem with the internal dictionary" - -Function RemoveEmptyStrings(arr() As String) As String() - Dim tempArray() As String - Dim i As Integer, j As Integer: j = 0 - ReDim tempArray(LBound(arr) To UBound(arr)) - j = 0 - For i = LBound(arr) To UBound(arr) - If Len(arr(i)) > 0 Then - tempArray(j) = arr(i) - j = j + 1 - End If - Next i - ReDim Preserve tempArray(0 To j - 1) - RemoveEmptyStrings = tempArray -End Function - - -Function RegexMatch(inputString As String, pattern As String, Optional isGlobal As Boolean = True) As Boolean - ' checks for regex match without instantiating 80 gazillion objects - - ' parameters - ' isGlobal: whether the regex check is global - - Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp") - Regex.pattern = pattern - Regex.Global = isGlobal - RegexMatch = Regex.Test(inputString) -End Function - -Function RegexSplit(inputString As String, pattern As String, Optional onlyFirst As Boolean = False, Optional splitBefore As Boolean = False) As String() - ' splits array at any pattern that matches a regex - - ' parameters - ' onlyFirst: if true, only splits the first instance of the match, creating an array of length 2 - ' splitBefore: if true, preserves the actual instance of the match - - Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp") - Dim matches As Object - Dim match As Object - Dim splitParts() As String: ReDim splitParts(0 To 0) - Dim pos As Integer - Dim lastPos As Integer: lastPos = 1 - Dim i As Integer: i = 0 - - ' set regex flags - Regex.Global = True - Regex.IgnoreCase = False - Regex.pattern = pattern - - Set matches = Regex.Execute(inputString) - - ' lastPos = 1 - ' i = 0 - - For Each match In matches - pos = match.FirstIndex + 1 - ReDim Preserve splitParts(i) - splitParts(i) = Mid(inputString, lastPos, pos - lastPos) - If splitBefore Then - lastPos = pos - Else - lastPos = pos + Len(match.Value) - End If - i = i + 1 - If onlyFirst Then Exit For - Next match - - If lastPos <= Len(inputString) Then - ReDim Preserve splitParts(i) - splitParts(i) = Mid(inputString, lastPos) - End If - - ' retvrn - RegexSplit = RemoveEmptyStrings(splitParts) -End Function - -Function RegexSubstitute(inputString As String, pattern As String, Optional substitution As String = "") - ' does what it says on the tin - Dim Regex As Object: Set Regex = CreateObject("VBScript.RegExp") - Regex.pattern = pattern - Regex.IgnoreCase = False - Regex.Global = True - RegexSubstitute = Regex.Replace(inputString, substitution) -End Function - -' YAML Layer Parser Pseudocode -' ==== -' function GetYAMLLayerAsCollection(String fromYAML) { -' Collection mainDictionary = New Collection(); -' if (fromYAML.containsRegex(/\n[A-Za-z]/)) { -' // is a dictionary -' String[] temporaryArray = fromYAML.split(/\n[A-Za-z]/); -' for each x in temporaryArray { -' x.splitByFirstInstanceOf(':\n'); -' x[1].replaceAllInstancesOf(' -' mainDictionary.add(x[0], x[1]); -' } -' } else if (fromYAML.containsRegex(/\n-/)) { -' // if array, process the array and return it as "self" -' String[] temporaryArray = fromYAML.splitBy('\n-'); -' for each x in temporaryArray { -' x.removeAllInstancesOf('\n- '); -' x.replaceAllInstancesOf('\n ', '\n'); -' mainDictionary.add("self", temporaryArray); -' } -' } else if (fromYAML.startsWith('"')) { -' mainDictionary.add("self", removeQuotes(fromYAML)); -' } else { -' MsgBox("Processing error: neither array, dictionary, nor string"); -' } -' } - - -Function GetYAMLLayerAsDictionary(fromYAML As String) As Dictionary - Dim mainDictionary As Dictionary: Set mainDictionary = New Dictionary - ' create regex objects to test for dict, array, and string - - 'Dim regEx_dict As Object: Set regEx_dict = CreateObject("VBScript.RegExp") - 'Dim regEx_arry As Object: Set regEx_arry = CreateObject("VBScript.RegExp") - 'Dim regEx_strn As Object: Set regEx_strn = CreateObject("VBScript.RegExp") - - 'regEx_dict.Global = True: regEx_dict.Pattern = "\n[A-Za-z]" - 'regEx_arry.Global = True: regEx_arry.Pattern = "\n-\s" - 'regEx_strn.Global = False: regEx_strn.Pattern = "^\s*""(.*?)""\s*$" - - Dim parts() As String - - If RegexMatch(fromYAML, "(?:\n|\^)\w+:", True) Then - ' is a dictionary - parts = RegexSplit(fromYAML, "\n\w+:", False, True) - Dim part As Variant ' not sure why it can't be as string but whatever billy gates - Call mainDictionary.Add(typeIdentifier, "Dictionary") ' identify as dict - For Each part In parts - Dim keyValue() As String: keyValue = RegexSplit(CStr(part), ":\s", True) - ' trim trailing \n from category - If UBound(keyValue) > 0 Then - keyValue(0) = RegexSubstitute(keyValue(0), "^\n+") - ' trim 2 spaces off of each line if they're there - keyValue(1) = RegexSubstitute(keyValue(1), "^\s{2}") - keyValue(1) = RegexSubstitute(keyValue(1), "\n\s{2}", vbLf) - Call mainDictionary.Add(keyValue(0), keyValue(1)) - End If - Next part - ElseIf RegexMatch(fromYAML, "^-\s", True) Then - ' is an array - Call mainDictionary.Add(typeIdentifier, "Array") - parts = RegexSplit(fromYAML, "(^|\n)-\s", False) - Dim i As Integer - For i = LBound(parts) To UBound(parts) - parts(i) = RegexSubstitute(parts(i), "\n\s{2}", vbLf) - Next i - Call mainDictionary.Add(selfIdentifier, parts) - ElseIf RegexMatch(fromYAML, "^\s*""(.*?)""\s*$", True) Then - ' is a string - Call mainDictionary.Add(typeIdentifier, "String") - Call mainDictionary.Add(selfIdentifier, RegexSubstitute(fromYAML, """", "")) - Else - Call mainDictionary.Add(selfIdentifier, "") - Debug.Print _ - "Neither array, dictionary, nor string:" & _ - vbCrLf & vbCrLf & fromYAML & vbCrLf & vbCrLf & _ - "Make sure all strings are enclosed in double quotes." ', _ - 'vbOKOnly, "YAML Error") - End If - - Set GetYAMLLayerAsDictionary = mainDictionary -End Function - -' YAML Traverser Pseudocode -' === -' -' function TraverseYAML(String fromYAML) { -' Dictionary mainDictionary = GetYAMLLayerAsDictionary(fromYAML); -' if mainDictionary.___type___ = "Dictionary" { -' for each entry in mainDictionary { -' TraverseYAML(entry) -' } -' return mainDictionary; -' } else if mainDictionary.___type___ = "Array" { -' for each entry in mainDictionary.___self___ { -' TraverseYAML(entry) -' } -' return mainDictionary; -' } else if mainDictionary.___type___ = "String" { -' return mainDictionary; -' } else { -' MsgBox("Internal YAML Error") -' } -' } -Function GetYAMLAsDictionary(fromYAML As String) As Dictionary - Dim mainDictionary As Object: Set mainDictionary = GetYAMLLayerAsDictionary(fromYAML) - Dim entry As Variant - If mainDictionary(typeIdentifier) = "Dictionary" Then - For Each entry In mainDictionary - Debug.Print "=== PROCESSING DICTIONARY ENTRY ===" - Debug.Print entry & " => " & mainDictionary(entry) - If entry <> typeIdentifier And entry <> selfIdentifier Then - Set mainDictionary(entry) = GetYAMLAsDictionary(mainDictionary(entry)) - End If - Next entry - ElseIf mainDictionary(typeIdentifier) = "Array" Then - Dim i As Integer - Dim subArray() As Object - For i = LBound(mainDictionary(selfIdentifier)) To UBound(mainDictionary(selfIdentifier)) - Debug.Print "=== PROCESSING ARRAY ENTRY ===" - Debug.Print mainDictionary(selfIdentifier)(i) - 'Set subDictionary = GetYAMLAsDictionary(mainDictionary(selfIdentifier)(i)) - 'Set mainDictionary(selfIdentifier)(i) = subDictionary - ReDim Preserve subArray(i) - Set subArray(i) = GetYAMLAsDictionary(CStr(mainDictionary(selfIdentifier)(i))) - Next i - - mainDictionary(selfIdentifier) = subArray - ElseIf mainDictionary(typeIdentifier) <> "String" Then - Debug.Print malformedTypeError ', vbOKOnly, errIdentifier) - End If - Set GetYAMLAsDictionary = mainDictionary -End Function - -' YAML Cleaner Pseudocode -' ===== -' function YAMLCleaner(Dictionary mainDictionary) { -' for each entry in mainDictionary { -' if entry(typeIdentifier) == "Dictionary" { -' for each secondOrderEntry in entry { -' YAMLCleaner(secondOrderEntry) -' } -' } else if entry(typeIdentifier) == "Array" { -' for each secondOrderEntry in entry(selfIdentifier) { -' YAMLCleaner(secondOrderEntry) -' } -' } -' if entry(typeIdentifier) != "Dictionary" { -' mainDictionary(entry) = mainDictionary(entry)(selfIdentifier) -' } -' } -' return mainDictionary; -' } - -Function YAMLCleaner(mainDictionary As Dictionary) As Dictionary - Dim entry As Variant - If mainDictionary(typeIdentifier) = "Array" Then ' go through array and yamlclean it - Dim i As Integer - Debug.Print JsonConverter.ConvertToJson(mainDictionary) - For i = LBound(mainDictionary(selfIdentifier)) To UBound(mainDictionary(selfIdentifier)) - - 'If IsObject(mainDictionary(selfIdentifier)(i)) Then - 'Set mainDictionary(selfIdentifier)(i) = YAMLCleaner(mainDictionary(selfIdentifier)(i)) - 'Else - ' Debug.Print "encountered non-object" - 'End If - Next i - End If - If mainDictionary(typeIdentifier) = "Dictionary" Then 'iterate through dict and yamlclena it - For Each entry In mainDictionary - If entry <> typeIdentifier Then - Set mainDictionary(entry) = YAMLCleaner(mainDictionary(entry)) - End If - Next entry - End If - - For Each entry In mainDictionary - If mainDictionary(typeIdentifier) = "Dictionary" And mainDictionary(entry)(typeIdentifier) <> "Dictionary" And entry <> typeIdentifier And entry <> selfIdentifier Then - Debug.Print "processing " & entry & " which is " & mainDictionary(entry)(typeIdentifier) - If IsObject(mainDictionary(entry)(selfIdentifier)) Then - Set mainDictionary(entry) = mainDictionary(entry)(selfIdentifier) - Else - mainDictionary(entry) = mainDictionary(entry)(selfIdentifier) - End If - End If - Next entry - - ' destroy type identifier? - Set YAMLCleaner = mainDictionary -End Function - -Function GetFileAsString(filePath As String) As String - ' Dim fileContent As String - Dim line As String - Dim fileNumber As Integer - - 'filePath = "\\Mac\iCloud\Development\cv\cv.yml" - - fileNumber = FreeFile() - - Open filePath For Input As fileNumber - - Do While Not EOF(fileNumber) - Line Input #fileNumber, line - GetFileAsString = GetFileAsString & line & vbCrLf - Loop -End Function - -Sub TryFunction() - Dim fileString As String: fileString = GetFileAsString("\\Mac\iCloud\Development\cv\cv.yml") - Dim yamlLayer As Object - Set yamlLayer = GetYAMLLayerAsDictionary(fileString) - Dim yamlWholeDict As Object: Set yamlWholeDict = GetYAMLAsDictionary(fileString) - 'Debug.Print JsonConverter.ConvertToJson(yamlWholeDict, 2, 2) - Dim yamlCleanDict As Object: Set yamlCleanDict = YAMLCleaner(yamlWholeDict) - Debug.Print JsonConverter.ConvertToJson(yamlCleanDict, 2, 2) -End Sub -- rgit 0.1.5