From 8eb2b085ec2d4fe877cd09c51c510fe20e8d6108 Mon Sep 17 00:00:00 2001 From: yaqubroli Date: Mon, 23 Sep 2024 17:56:01 +0100 Subject: [PATCH] Code almost finished --- #*superscratch*# | 1 + #Makefile# | 0 *scratch* | 308 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ .#*superscratch* | 1 + Writeup.docm | 0 Writeup.pdf | 0 cv.docm | 0 cv.docm.bak.2.docm | 0 cv.yml | 14 ++++++-------- cvr1.docm | 0 extract.bat | 1 + publish.bat | 1 + ~$cv.docm | 0 ~$cv.dotx | 0 ~$riteup.docm | 0 contents/[Content_Types].xml | 2 -- examples/CV.docx | 0 examples/CV.pdf | 0 examples/Jacob Walchuk CV Rev0.pdf | 0 examples/specimen.docx | 0 examples/specimen.pdf | 0 python_build/compile_vba.py | 27 --------------------------- python_build/extract_vba.py | 32 -------------------------------- src.bak/NewMacros.bas | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src.bak/StringTable.bas | 11 +++++++++++ src.bak/YAML.cls | 330 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/#NewMacros.bas# | 10 ++++++++++ src/CV.bas | 205 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/JsonConverter.bas | 1123 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/Project.ini | 32 ++++++++++++++++++++++++++++++++ src/StringTable.bas | 16 ++++++++++++++++ src/ThisDocument.cls | 13 +++++++++++++ src/YAML.cls | 331 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ contents/_rels/.rels | 2 -- contents/customXml/item1.xml | 1 - contents/customXml/itemProps1.xml | 2 -- contents/docProps/app.xml | 2 -- contents/docProps/core.xml | 2 -- contents/word/document.xml | 2 -- contents/word/fontTable.xml | 2 -- contents/word/numbering.xml | 2 -- contents/word/settings.xml | 2 -- contents/word/styles.xml | 2 -- contents/word/webSettings.xml | 2 -- src.bak/Class Modules/YAML.cls | 353 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src.bak/Modules/NewMacros.bas | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src.bak/Modules/YAMLParser_old.bas | 313 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/Class Modules/YAML.cls | 353 -------------------------------------------------------------------------------- src/Modules/NewMacros.bas | 58 ---------------------------------------------------------- src/Modules/YAMLParser_old.bas | 313 -------------------------------------------------------------------------------- contents/customXml/_rels/item1.xml.rels | 2 -- contents/word/_rels/document.xml.rels | 2 -- contents/word/_rels/numbering.xml.rels | 2 -- contents/word/_rels/settings.xml.rels | 2 -- contents/word/media/image1.png | 0 contents/word/theme/theme1.xml | 2 -- 56 files changed, 3179 insertions(+), 824 deletions(-) diff --git a/#*superscratch*# b/#*superscratch*# new file mode 100644 index 0000000..a5ba7c7 100644 --- /dev/null +++ a/#*superscratch*# @@ -1,0 +1,1 @@ +cvProps("projects")(ID_SELF)(l)("title")(ID_SELF)diff --git a/#Makefile# b/#Makefile# new file mode 100644 index 0000000..e69de29 100644 --- /dev/null +++ a/#Makefile# diff --git a/*scratch* b/*scratch* new file mode 100644 index 0000000..28c7895 100644 --- /dev/null +++ a/*scratch* @@ -1,0 +1,308 @@ +{ + "___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/.#*superscratch* b/.#*superscratch* new file mode 120000 index 0000000..024e403 120000 --- /dev/null +++ a/.#*superscratch* @@ -1,0 +1,1 @@ +yaqub@14comma15.5539diff --git a/Writeup.docm b/Writeup.docm new file mode 100644 index 0000000000000000000000000000000000000000..9600636b3a8d591b163d1daf514c66dec98fb958 100644 Binary files /dev/null and a/Writeup.docm differ diff --git a/Writeup.pdf b/Writeup.pdf new file mode 100644 index 0000000000000000000000000000000000000000..fa8452fa6c8b816f7182236e63207455079f82ba 100644 Binary files /dev/null and a/Writeup.pdf differ diff --git a/cv.docm b/cv.docm index 11f919716d083fab8a94909bb2418ce81c57d78c..d416b5aed90de9e037cdfbc27d6718536fff51fa 100644 Binary files a/cv.docm and a/cv.docm differ diff --git a/cv.docm.bak.2.docm b/cv.docm.bak.2.docm new file mode 100644 index 0000000000000000000000000000000000000000..2f2e57df5ad8451ce94a54324f5b170537855f50 100644 Binary files /dev/null and a/cv.docm.bak.2.docm differ diff --git a/cv.yml b/cv.yml index f17f4ab..80b53e3 100644 --- a/cv.yml +++ a/cv.yml @@ -9,13 +9,13 @@ phone: "+1 604 880 4825" cv: - - title: Education + - title: "Education" entries: - title: "Westside School" location: "Vancouver, Canada" date: "2019---2021" bullets: - - "/A\*A\*A\*A\*A-equivalent marks, per KCL's conversion scale." + - "A*A*A*A*A-equivalent marks, per KCL's conversion scale." - title: "Trinity Western University" role: "B.A. in Political Studies" location: "Langley, Canada" @@ -28,7 +28,7 @@ date: "2022---2025" bullets: - "Standing 2:2 Honours, with a focus on symbolic logic and analytic metaphysics." - - title: Work Experience + - title: "Work Experience" entries: - title: "Kova Engineering, Ltd." role: "Technical Analyst Intern" @@ -54,11 +54,9 @@ projects: - title: "Book Tracker" - bullets: - - "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." + description: "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." - title: "Homelab" - bullets: - - "Ran a decomissioned rackmount server at home, deploying KVM on Debian, and later, Xen." + description: "Ran a decommissioned rackmount server at home, deploying KVM on Debian, and later, Xen." skills: - "Certifications: CompTIA Linux+, IBM Data Analyst Certificate (Excel, Cognos, and R), IBM Data Science Certificate (Python)." - "Languages: Mandarin (working proficiency), German (basic)." @@ -66,5 +64,5 @@ - "Interests: Linguistics, social and economic history, corporate finance." footer: + - "Authorised to work full-time in the UK, without sponsorship." - "This {{DOCTYPE}} was generated from YAML source using {{LANG}}. For more information, see jacob.hcol.uk/cv." - - "Authorised to work full-time in the UK, without sponsorship, via an Ancestry Visa." diff --git a/cvr1.docm b/cvr1.docm new file mode 100644 index 0000000000000000000000000000000000000000..c3f9537ed316ec1ea3957ba64bbf9d712ea44f70 100644 Binary files /dev/null and a/cvr1.docm differ diff --git a/extract.bat b/extract.bat new file mode 100644 index 0000000..9456ede 100644 --- /dev/null +++ a/extract.bat @@ -1,0 +1,1 @@ +"C:\Program Files\VBASync\VBASync.exe" -r -x -f cv.docm -d ./src diff --git a/publish.bat b/publish.bat new file mode 100644 index 0000000..9456ede 100644 --- /dev/null +++ a/publish.bat @@ -1,0 +1,1 @@ +"C:\Program Files\VBASync\VBASync.exe" -r -x -f cv.docm -d ./src diff --git a/~$cv.docm b/~$cv.docm new file mode 100644 index 0000000000000000000000000000000000000000..bd673025144cc4e49b5edb59defc86f2ad1da1ac 100644 Binary files /dev/null and a/~$cv.docm differ diff --git a/~$cv.dotx b/~$cv.dotx new file mode 100644 index 0000000000000000000000000000000000000000..2aa3ec105e3a4389e397b5cbcff3285bd1dd88b6 100644 Binary files /dev/null and a/~$cv.dotx differ diff --git a/~$riteup.docm b/~$riteup.docm new file mode 100644 index 0000000000000000000000000000000000000000..755566eb55fa0f8a176c8572ecfb990e5dc78a8f 100644 Binary files /dev/null and a/~$riteup.docm differ diff --git a/contents/[Content_Types].xml b/contents/[Content_Types].xml deleted file mode 100644 index 942889d..0000000 100644 --- a/contents/[Content_Types].xml +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/examples/CV.docx b/examples/CV.docx deleted file mode 100644 index fa41516f3503c90a6cb22b3881be0e16faa46706..0000000000000000000000000000000000000000 100644 Binary files a/examples/CV.docx and /dev/null differ diff --git a/examples/CV.pdf b/examples/CV.pdf deleted file mode 100644 index abd4a4d473629eb70a70627ead7da8f1cdb965a2..0000000000000000000000000000000000000000 100644 Binary files a/examples/CV.pdf and /dev/null differ diff --git a/examples/Jacob Walchuk CV Rev0.pdf b/examples/Jacob Walchuk CV Rev0.pdf new file mode 100644 index 0000000000000000000000000000000000000000..34b7516856dca014c5da11fe1a5d0c922ab95090 100644 Binary files /dev/null and a/examples/Jacob Walchuk CV Rev0.pdf differ diff --git a/examples/specimen.docx b/examples/specimen.docx new file mode 100644 index 0000000000000000000000000000000000000000..16c56c704dc8e642ca22dea42c3c03340f56e5b4 100644 Binary files /dev/null and a/examples/specimen.docx differ diff --git a/examples/specimen.pdf b/examples/specimen.pdf new file mode 100644 index 0000000000000000000000000000000000000000..abd4a4d473629eb70a70627ead7da8f1cdb965a2 100644 Binary files /dev/null and a/examples/specimen.pdf differ diff --git a/python_build/compile_vba.py b/python_build/compile_vba.py deleted file mode 100644 index 8a41eb8..0000000 100644 --- a/python_build/compile_vba.py +++ /dev/null @@ -1,27 +1,0 @@ -from vbaProjectCompiler.vbaProject import VbaProject -from vbaProjectCompiler.ole_file import OleFile - -def compile_vba(input_dir, docm_file): - # Initialize the VbaProject object - vba_project = VbaProject() - - # Load the VBA project from the extracted directory - vba_project.addDirectory(input_dir) - - # Create the OLE file with the VBA project - ole_file = OleFile(vba_project) - ole_file.writeFile(docm_file) - - print(f"VBA project compiled and saved to {docm_file}") - -if __name__ == "__main__": - import sys - - if len(sys.argv) != 3: - print("Usage: python compile_vba.py ") - sys.exit(1) - - input_dir = sys.argv[1] - docm_file = sys.argv[2] - - compile_vba(input_dir, docm_file) diff --git a/python_build/extract_vba.py b/python_build/extract_vba.py deleted file mode 100644 index 9429ad8..0000000 100644 --- a/python_build/extract_vba.py +++ /dev/null @@ -1,32 +1,0 @@ -from oletools.olevba import VBA_Parser -import os - -def extract_vba(docm_file, output_dir): - # Ensure output directory exists - os.makedirs(output_dir, exist_ok=True) - - # Parse the .docm file to extract VBA code - vba_parser = VBA_Parser(docm_file) - if vba_parser.detect_vba_macros(): - for (filename, stream_path, vba_filename, vba_code) in vba_parser.extract_macros(): - # Save each extracted VBA file to the output directory - output_file_path = os.path.join(output_dir, vba_filename) - with open(output_file_path, 'w') as vba_file: - vba_file.write(vba_code) - print(f"Extracted {vba_filename} to {output_file_path}") - else: - print("No VBA macros found in the document.") - - vba_parser.close() - -if __name__ == "__main__": - import sys - - if len(sys.argv) != 3: - print("Usage: python extract_vba.py ") - sys.exit(1) - - docm_file = sys.argv[1] - output_dir = sys.argv[2] - - extract_vba(docm_file, output_dir) diff --git a/src.bak/NewMacros.bas b/src.bak/NewMacros.bas new file mode 100644 index 0000000..9354112 100644 --- /dev/null +++ a/src.bak/NewMacros.bas @@ -1,0 +1,66 @@ +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 new file mode 100644 index 0000000..9c5803e 100644 --- /dev/null +++ a/src.bak/StringTable.bas @@ -1,0 +1,11 @@ +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 new file mode 100644 index 0000000..3ca3575 100644 --- /dev/null +++ a/src.bak/YAML.cls @@ -1,0 +1,330 @@ +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# new file mode 100644 index 0000000..f15f425 100644 --- /dev/null +++ a/src/#NewMacros.bas# @@ -1,0 +1,10 @@ +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 new file mode 100644 index 0000000..2304e20 100644 --- /dev/null +++ a/src/CV.bas @@ -1,0 +1,205 @@ +Attribute VB_Name = "CV" +Option Explicit + +Function DrawTitle(theTitle As String) + Selection.Style = ActiveDocument.Styles("Title") + Selection.TypeText Text:=theTitle + Selection.TypeParagraph +End Function + +Function DrawSubtitle(theSubtitle As String) + Selection.Style = ActiveDocument.Styles("Heading 1") + Selection.TypeText Text:=theSubtitle + Selection.TypeParagraph +End Function + +Function DrawNormalText(theText As String) + Selection.Style = ActiveDocument.Styles("Normal") + Selection.TypeText Text:=theText +End Function + +Function DrawSmallCaps(theSmallCaps As String) + With Selection.Font + .Bold = True + .SmallCaps = True + End With + Selection.TypeText Text:=theSmallCaps +End Function + +Function DrawTabEntry(theTabEntry As String) + Selection.ParagraphFormat.TabStops.ClearAll + ActiveDocument.DefaultTabStop = InchesToPoints(0.5) + Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(6.5), _ + Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces + Selection.TypeText Text:=vbTab + Selection.Font.Bold = wdToggle + With Selection.Font + .Bold = False + .Italic = False + .SmallCaps = False + .Color = RGB(GREY_VALUE, GREY_VALUE, GREY_VALUE) + End With + Selection.TypeText Text:=theTabEntry + Selection.TypeParagraph + ' reset to normal + Selection.Style = ActiveDocument.Styles("Normal") +End Function + +Function DrawBulletedList(theBulletEntries() As String) + With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1) + .NumberFormat = ChrW(61623) ' Bullet character + .NumberStyle = wdListNumberStyleBullet + .NumberPosition = InchesToPoints(0.25) + .TextPosition = InchesToPoints(0.5) + .Font.Name = "Symbol" + End With + + ' Apply bullet list formatting to the selection + Selection.Range.ListFormat.ApplyListTemplateWithLevel _ + ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), _ + ContinuePreviousList:=False, _ + ApplyTo:=wdListApplyToWholeList, _ + DefaultListBehavior:=wdWord10ListBehavior + + ' Insert each bullet entry + Dim bulletEntry As Variant + For Each bulletEntry In theBulletEntries + Selection.TypeText Text:=bulletEntry + Selection.TypeParagraph + Next bulletEntry + + ' Remove bullet list formatting after the list is complete + Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph + Selection.TypeParagraph +End Function + +Function DrawCompoundBulletedList(theTitles() As String, theDescriptions() As String) + With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1) + .NumberFormat = ChrW(61623) ' Bullet character + .NumberStyle = wdListNumberStyleBullet + .NumberPosition = InchesToPoints(0.25) + .TextPosition = InchesToPoints(0.5) + .Font.Name = "Symbol" + End With + + ' Apply bullet list formatting to the selection + Selection.Range.ListFormat.ApplyListTemplateWithLevel _ + ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), _ + ContinuePreviousList:=False, _ + ApplyTo:=wdListApplyToWholeList, _ + DefaultListBehavior:=wdWord10ListBehavior + + If (UBound(theTitles) - LBound(theTitles)) <> (UBound(theTitles) - LBound(theTitles)) Then + MsgBox "Internal error in projects; this will result in an array bound error." + End If + + ' Insert each bullet entry + Dim i As Integer + For i = LBound(theTitles) To UBound(theTitles) + With Selection.Font + .Bold = True + .SmallCaps = True + End With + Selection.TypeText Text:="bar" ' theTitles(i) + With Selection.Font + .Bold = False + .SmallCaps = False + End With + Selection.TypeText Text:=" - baz" ' " " & ChrW(8212) & " " & theDescriptions(i) + Selection.TypeParagraph + Next i + + ' Remove bullet list formatting after the list is complete + Selection.Range.ListFormat.RemoveNumbers NumberType:=wdNumberParagraph + Selection.TypeParagraph +End Function + +Sub DrawCV() +Attribute DrawCV.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Macro1" + Dim cvYAML As Object: Set cvYAML = New YAML + + ' Q: Why is the business logic so terrible? + ' Why is every area of the dictionary referenced from the root with loads of ID_SELFs? + ' Why not assign it to variables to make it shorter? + + ' A: Because VBA does not permit setting array length at runtime, and also seems + ' to crash with some sort of memory error when assigning subdictionaries to their + ' own variable. + ' + ' If I could go back to the drawing board, I probably would have drafted a better solution + ' (for example not using dictionaries and making the YAML class its own thing) + ' but at this stage of the project the perfect is the enemy of the good. + + cvYAML.path = YAML_PATH + + Dim cvProps As Scripting.Dictionary: Set cvProps = cvYAML.props + + ' read name + + DrawTitle CStr(cvProps("name")(ID_SELF)) + + ' iterate through subheadings of "cv" + + Dim i As Integer: i = 0 + Dim j As Integer: j = 0 + + For i = LBound(cvProps("cv")(ID_SELF)) To UBound(cvProps("cv")(ID_SELF)) + DrawSubtitle CStr(cvProps("cv")(ID_SELF)(i)("title")(ID_SELF)) + ' iterate through entries + For j = _ + LBound(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)) To _ + UBound(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)) + + DrawSmallCaps CStr(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j)("title")(ID_SELF)) + DrawTabEntry CStr(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j)("date")(ID_SELF)) + + If cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j).Exists("role") Then + DrawNormalText CStr(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j)("role")(ID_SELF)) + If cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j).Exists("location") Then + DrawTabEntry CStr(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j)("location")(ID_SELF)) + End If + End If + + ' iterate through the bullets of the respective entry + + Dim k As Integer + Dim bulletedList() As String + + ReDim bulletedList(LBound(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j)("bullets")(ID_SELF)) To _ + UBound(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j)("bullets")(ID_SELF))) + For k = LBound(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j)("bullets")(ID_SELF)) To _ + UBound(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j)("bullets")(ID_SELF)) + bulletedList(k) = CStr(cvProps("cv")(ID_SELF)(i)("entries")(ID_SELF)(j)("bullets")(ID_SELF)(k)(ID_SELF)) + Next k + DrawBulletedList bulletedList + Next j + Next i + + ' iterate through projects + + DrawSubtitle "Projects" + + Dim l As Integer + Dim titles() As String + Dim descriptions() As String + ReDim titles(LBound(cvProps("projects")(ID_SELF)) To UBound(cvProps("projects")(ID_SELF))) + ReDim descriptions(LBound(cvProps("projects")(ID_SELF)) To UBound(cvProps("projects")(ID_SELF))) + + 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)) + Next l + + DrawCompoundBulletedList titles, descriptions + + ' iterate through skills + +End Sub + +Sub JsonTroubleshoot() + Dim cvYAML As Object: Set cvYAML = New YAML + cvYAML.path = YAML_PATH + Dim cvProps As Scripting.Dictionary: Set cvProps = cvYAML.props + DrawNormalText JsonConverter.ConvertToJson(cvProps, 2) +End Sub diff --git a/src/JsonConverter.bas b/src/JsonConverter.bas new file mode 100644 index 0000000..0767e1d 100644 --- /dev/null +++ a/src/JsonConverter.bas @@ -1,0 +1,1123 @@ +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 new file mode 100644 index 0000000..d3c84c5 100644 --- /dev/null +++ a/src/Project.ini @@ -1,0 +1,32 @@ +CodePage=1252 +SysKind=3 +Version=1761683227.9 +ID="{0F3D9E32-5905-4E2D-8044-5C70D59D067F}" +Name="Project" +HelpContextID="0" +VersionCompatible32="393222000" +CMG="7476B23FB646BA46BA46BA46BA" +DPB="7775B138B738BB39BB39BB" +GC="7A78BC3DBE3EBE3E41" + +[Host Extender Info] +&H00000001={3832D640-CF90-11CF-8E43-00A0C911005A};VBE;&H00000000 + +[Constants] + +[Reference Scripting] +LibId=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#C:\Windows\System32\scrrun.dll#Microsoft Scripting Runtime + +[Reference VBScript_RegExp_55] +LibId=*\G{3F4DACA7-160D-11D2-A8E9-00104B365C9F}#5.5#0#C:\Windows\System32\vbscript.dll\3#Microsoft VBScript Regular Expressions 5.5 + +[Reference stdole] +LibId=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\System32\stdole2.tlb#OLE Automation + +[Reference TemplateProject] +LibIdAbsolute=*\C\\Mac\iCloud\Development\cv\cv.dotx +LibIdRelative=*\C\\Mac\iCloud\Development\cv\cv.dotx +Version=1761676241.4 + +[Reference Office] +LibId=*\G{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}#2.0#0#C:\Program Files\Common Files\Microsoft Shared\OFFICE16\MSO.DLL#Microsoft Office 16.0 Object Library diff --git a/src/StringTable.bas b/src/StringTable.bas new file mode 100644 index 0000000..6ed7891 100644 --- /dev/null +++ a/src/StringTable.bas @@ -1,0 +1,16 @@ +Attribute VB_Name = "StringTable" +Option Explicit + +Public Const YAML_PATH As String = "C:\Mac\Home\Library\Mobile Documents\com~apple~CloudDocs\Development\cv\cv.yml" + +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." + +Public Const GREY_VALUE As Integer = 128 +Public Const BLACK_VALUE As Integer = 255 diff --git a/src/ThisDocument.cls b/src/ThisDocument.cls new file mode 100644 index 0000000..3b55701 100644 --- /dev/null +++ a/src/ThisDocument.cls @@ -1,0 +1,13 @@ +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/YAML.cls b/src/YAML.cls new file mode 100644 index 0000000..f53ec30 100644 --- /dev/null +++ a/src/YAML.cls @@ -1,0 +1,331 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "YAML" +Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Attribute VB_TemplateDerived = False +Attribute VB_Customizable = 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 Scripting.Dictionary + Dim mainDictionary As Scripting.Dictionary: Set mainDictionary = New Scripting.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 Scripting.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 Scripting.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/contents/_rels/.rels b/contents/_rels/.rels deleted file mode 100644 index fdd8c4f..0000000 100644 --- a/contents/_rels/.rels +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/customXml/item1.xml b/contents/customXml/item1.xml deleted file mode 100644 index df14848..0000000 100644 --- a/contents/customXml/item1.xml +++ /dev/null @@ -1,1 +1,0 @@ -diff --git a/contents/customXml/itemProps1.xml b/contents/customXml/itemProps1.xml deleted file mode 100644 index 9402714..0000000 100644 --- a/contents/customXml/itemProps1.xml +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/docProps/app.xml b/contents/docProps/app.xml deleted file mode 100644 index 0282abe..0000000 100644 --- a/contents/docProps/app.xml +++ /dev/null @@ -1,2 +1,0 @@ - -496100Microsoft Office Word000falseTitle1false0falsefalse16.0000diff --git a/contents/docProps/core.xml b/contents/docProps/core.xml deleted file mode 100644 index 53ee84d..0000000 100644 --- a/contents/docProps/core.xml +++ /dev/null @@ -1,2 +1,0 @@ - -Jacob WalchukJacob Walchuk12024-08-20T16:37:00Z2024-08-21T00:53:00Zdiff --git a/contents/word/document.xml b/contents/word/document.xml deleted file mode 100644 index 2e8ffdb..0000000 100644 --- a/contents/word/document.xml +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/word/fontTable.xml b/contents/word/fontTable.xml deleted file mode 100644 index a0065f3..0000000 100644 --- a/contents/word/fontTable.xml +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/word/numbering.xml b/contents/word/numbering.xml deleted file mode 100644 index eefd20c..0000000 100644 --- a/contents/word/numbering.xml +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/word/settings.xml b/contents/word/settings.xml deleted file mode 100644 index d51770c..0000000 100644 --- a/contents/word/settings.xml +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/word/styles.xml b/contents/word/styles.xml deleted file mode 100644 index 2d1dcd8..0000000 100644 --- a/contents/word/styles.xml +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/word/webSettings.xml b/contents/word/webSettings.xml deleted file mode 100644 index 74c1519..0000000 100644 --- a/contents/word/webSettings.xml +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/src.bak/Class Modules/YAML.cls b/src.bak/Class Modules/YAML.cls new file mode 100644 index 0000000..92b84ad 100644 --- /dev/null +++ a/src.bak/Class Modules/YAML.cls @@ -1,0 +1,353 @@ +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 new file mode 100644 index 0000000..96f47ca 100644 --- /dev/null +++ a/src.bak/Modules/NewMacros.bas @@ -1,0 +1,58 @@ +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 new file mode 100644 index 0000000..cfcd417 100644 --- /dev/null +++ a/src.bak/Modules/YAMLParser_old.bas @@ -1,0 +1,313 @@ +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 diff --git a/src/Class Modules/YAML.cls b/src/Class Modules/YAML.cls deleted file mode 100644 index 92b84ad..0000000 100644 --- a/src/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/Modules/NewMacros.bas b/src/Modules/NewMacros.bas deleted file mode 100644 index 96f47ca..0000000 100644 --- a/src/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/Modules/YAMLParser_old.bas b/src/Modules/YAMLParser_old.bas deleted file mode 100644 index cfcd417..0000000 100644 --- a/src/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 diff --git a/contents/customXml/_rels/item1.xml.rels b/contents/customXml/_rels/item1.xml.rels deleted file mode 100644 index a9c831d..0000000 100644 --- a/contents/customXml/_rels/item1.xml.rels +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/word/_rels/document.xml.rels b/contents/word/_rels/document.xml.rels deleted file mode 100644 index 94cfc8a..0000000 100644 --- a/contents/word/_rels/document.xml.rels +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/word/_rels/numbering.xml.rels b/contents/word/_rels/numbering.xml.rels deleted file mode 100644 index 7a29daa..0000000 100644 --- a/contents/word/_rels/numbering.xml.rels +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/word/_rels/settings.xml.rels b/contents/word/_rels/settings.xml.rels deleted file mode 100644 index 9c2cfc4..0000000 100644 --- a/contents/word/_rels/settings.xml.rels +++ /dev/null @@ -1,2 +1,0 @@ - -diff --git a/contents/word/media/image1.png b/contents/word/media/image1.png deleted file mode 100644 index f49c18fe5782b85bac4c8e90e8a1e481d1ed87ac..0000000000000000000000000000000000000000 100644 Binary files a/contents/word/media/image1.png and /dev/null differ diff --git a/contents/word/theme/theme1.xml b/contents/word/theme/theme1.xml deleted file mode 100644 index 60a57c2..0000000 100644 --- a/contents/word/theme/theme1.xml +++ /dev/null @@ -1,2 +1,0 @@ - --- rgit 0.1.5