diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 82cc7fd0..4f21708b 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -1,25 +1,27 @@ -Found an Issue? Have an idea? ---------- -The easiest way to contribute is to create a detailed [Issue](https://github.com/joyfullservice/msaccess-vcs-integration/issues). Be sure to include details about the version of OS, Access, and VCS add-in. -If you can, provide a [Minimal Reproducible Example](https://stackoverflow.com/help/minimal-reproducible-example) of the problem. +Found a Problem? Have an Idea? +============= +The easiest way to contribute is to create a detailed [Issue](https://github.com/joyfullservice/msaccess-vcs-integration/issues). Be sure to include details about the version of OS, Access, and VCS add-in. If you can, provide a [Minimal Reproducible Example](https://stackoverflow.com/help/minimal-reproducible-example) of the problem. + +Also be sure to check out the [Project Wiki](https://github.com/joyfullservice/msaccess-vcs-integration/wiki) which contains detailed documentation and other helpful tips for using this add-in. + Development Version --------- If you want the very latest updates since the last published release, you will need to build it from source. Here is how to go from GitHub to git, to Access: -* Make sure you have a fairly recent version of the add-in installed. If not, +* Make sure you have a fairly recent version of the add-in installed. If not: * Download the latest release. - * Install the add-in. (Just open *Version Control.accda*. If the add-in is already installed, you will be dropped into the VBA editor without further comment.) + * Install the add-in. (Just open *Version Control.accda*.) * Clone this repository. * Pull your clone down to your local machine. -* Choose a branch in git. (Typically `master`) +* Choose a branch in git. (Typically `dev`) * Use the add-in to *Build From Source*, selecting the cloned `Version Control.accda.src` folder. * Run the newly compiled *Version Control.accda* file to install the development version. Making your first Pull Request (PR) --------- A *Pull Request* is how you can propose that your code changes be included in the main project. (This project is the work of many people who have donated their efforts to make it better for everyone.) If you followed the steps to get to the Development Version then you can follow these steps to go back from Access to git, back up to GitHub: -* *Optional: For larger changes, you may consider making a branch that describes the changes you are proposing.* +* *Optional: For larger changes, you should consider making a branch that describes the changes you are proposing.* * Open the development copy of *Version Control.accda* from the cloned GitHub project. * Perform testing on your development version. * Make updates to the database project. (This is where the magic happens) @@ -34,6 +36,7 @@ A *Pull Request* is how you can propose that your code changes be included in th * _*When creating the commit, please select only the files that reflect the actual changes you are proposing. It is usually not necessary to include auto-generated files that don't include substantive or intended changes._ * **Push** your branch up to your cloned repository. * Make a **pull request** to the upstream project! Be sure to clearly describe what you did and why in the pull request. This will allow reviewers to better understand why your PR should be merged. +* Pull requests should target the `dev` branch, where most active development takes place. `Master` branch PRs should be mainly limited to Wiki changes. Critical bug fixes can be cherry-picked over to the `master` branch if needed. * *Tip: If you have many different types of changes to propose, please use different pull requests for each of them. That will be easier to review and implement them individually.* -Thank you again for your support for the Microsoft Access development community!! \ No newline at end of file +Thank you again for your support for the Microsoft Access development community!! diff --git a/Testing/Testing.accdb.src/dbs-properties.json b/Testing/Testing.accdb.src/dbs-properties.json index 63080bc0..9d3c26e0 100644 --- a/Testing/Testing.accdb.src/dbs-properties.json +++ b/Testing/Testing.accdb.src/dbs-properties.json @@ -165,7 +165,7 @@ "Type": 1 }, "Theme Resource Name": { - "Value": "Office Theme", + "Value": "Angles", "Type": 10 }, "Themed Form Controls": { diff --git a/Testing/Testing.accdb.src/forms/frmColors.bas b/Testing/Testing.accdb.src/forms/frmColors.bas index a31f5d4c..58dc9e41 100644 --- a/Testing/Testing.accdb.src/forms/frmColors.bas +++ b/Testing/Testing.accdb.src/forms/frmColors.bas @@ -13,16 +13,13 @@ Begin Form Width =14400 DatasheetFontHeight =11 ItemSuffix =50 - Right =19470 + Right =19650 Bottom =12585 RecSrcDt = Begin 0x8b5c5de351a8e540 End - DatasheetFontName ="Calibri" + DatasheetFontName ="Franklin Gothic Book" AllowDatasheetView =0 - AllowPivotTableView =0 - AllowPivotChartView =0 - AllowPivotChartView =0 FilterOnLoad =0 ShowPageMargins =0 DisplayOnSharePointSite =1 @@ -149,12 +146,16 @@ Begin Form Begin Begin Label OverlapFlags =85 + TextFontFamily =0 Left =2880 Top =1620 Width =840 Height =360 + BorderColor =8355711 Name ="Label0" Caption ="Type" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =2880 LayoutCachedTop =1620 LayoutCachedWidth =3720 @@ -168,6 +169,7 @@ Begin Form Top =2100 Width =12540 Name ="Line1" + GridlineColor =10921638 LayoutCachedLeft =480 LayoutCachedTop =2100 LayoutCachedWidth =13020 @@ -175,12 +177,16 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =4320 Top =1620 Width =1260 Height =360 + BorderColor =8355711 Name ="Label3" Caption ="Theme Color" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =4320 LayoutCachedTop =1620 LayoutCachedWidth =5580 @@ -190,12 +196,16 @@ Begin Form End Begin Label OverlapFlags =93 + TextFontFamily =0 Left =7200 Top =1620 Width =1440 Height =360 + BorderColor =8355711 Name ="Label4" Caption ="Pallet Color" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =7200 LayoutCachedTop =1620 LayoutCachedWidth =8640 @@ -205,12 +215,16 @@ Begin Form End Begin Label OverlapFlags =93 + TextFontFamily =0 Left =10080 Top =1620 Width =1305 Height =360 + BorderColor =8355711 Name ="Label5" Caption ="Default Color" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =10080 LayoutCachedTop =1620 LayoutCachedWidth =11385 @@ -220,12 +234,16 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =2880 Top =2280 Width =870 Height =360 + BorderColor =8355711 Name ="Label6" Caption ="Text Box" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =2880 LayoutCachedTop =2280 LayoutCachedWidth =3750 @@ -235,12 +253,16 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =2880 Top =2820 Width =870 Height =360 + BorderColor =8355711 Name ="Label7" Caption ="Label" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =2880 LayoutCachedTop =2820 LayoutCachedWidth =3750 @@ -250,12 +272,16 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =2880 Top =3300 Width =870 Height =360 + BorderColor =8355711 Name ="Label8" Caption ="Button" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =2880 LayoutCachedTop =3300 LayoutCachedWidth =3750 @@ -265,12 +291,16 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =2880 Top =3780 Width =870 Height =360 + BorderColor =8355711 Name ="Label9" Caption ="Box" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =2880 LayoutCachedTop =3780 LayoutCachedWidth =3750 @@ -280,12 +310,16 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =600 Top =2280 Width =1635 Height =360 + BorderColor =8355711 Name ="Label12" Caption ="Orange, Accent 2" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =600 LayoutCachedTop =2280 LayoutCachedWidth =2235 @@ -295,13 +329,17 @@ Begin Form End Begin TextBox OverlapFlags =85 + TextFontFamily =0 IMESentenceMode =3 Left =4320 Top =2280 Width =1200 Height =315 + BorderColor =10921638 + ForeColor =4210752 Name ="Text13" - OnClick ="[Event Procedure]" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =4320 LayoutCachedTop =2280 @@ -311,6 +349,7 @@ Begin Form End Begin TextBox OverlapFlags =85 + TextFontFamily =0 IMESentenceMode =3 Left =7200 Top =2280 @@ -318,7 +357,11 @@ Begin Form Height =315 TabIndex =1 BackColor =5676533 + BorderColor =10921638 + ForeColor =4210752 Name ="Text15" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =7200 LayoutCachedTop =2280 @@ -328,6 +371,7 @@ Begin Form End Begin TextBox OverlapFlags =85 + TextFontFamily =0 IMESentenceMode =3 Left =8640 Top =2280 @@ -335,7 +379,11 @@ Begin Form Height =315 TabIndex =2 BackColor =3439082 + BorderColor =10921638 + ForeColor =4210752 Name ="Text16" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =8640 LayoutCachedTop =2280 @@ -345,6 +393,7 @@ Begin Form End Begin TextBox OverlapFlags =85 + TextFontFamily =0 IMESentenceMode =3 Left =11520 Top =2280 @@ -352,7 +401,11 @@ Begin Form Height =315 TabIndex =3 BackColor =-2147483598 + BorderColor =10921638 + ForeColor =4210752 Name ="Text18" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =11520 LayoutCachedTop =2280 @@ -362,12 +415,16 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =11520 Top =1620 Width =1305 Height =360 + BorderColor =8355711 Name ="Label19" Caption ="System Color" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =11520 LayoutCachedTop =1620 LayoutCachedWidth =12825 @@ -377,12 +434,16 @@ Begin Form End Begin Label OverlapFlags =87 + TextFontFamily =0 Left =8640 Top =1620 Width =1440 Height =360 + BorderColor =8355711 Name ="Label20" Caption ="Custom Color" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =8640 LayoutCachedTop =1620 LayoutCachedWidth =10080 @@ -393,12 +454,17 @@ Begin Form Begin Label BackStyle =1 OverlapFlags =85 + TextFontFamily =0 Left =4320 Top =2760 Width =1200 Height =300 + BorderColor =8355711 + ForeColor =8355711 Name ="Label21" Caption =" " + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =4320 LayoutCachedTop =2760 LayoutCachedWidth =5520 @@ -407,12 +473,17 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =10080 Top =2760 Width =1200 Height =300 + BorderColor =8355711 + ForeColor =8355711 Name ="Label22" Caption =" " + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =10080 LayoutCachedTop =2760 LayoutCachedWidth =11280 @@ -421,13 +492,18 @@ Begin Form Begin Label BackStyle =1 OverlapFlags =85 + TextFontFamily =0 Left =7200 Top =2760 Width =1200 Height =300 BackColor =5676533 + BorderColor =8355711 + ForeColor =8355711 Name ="Label23" Caption =" " + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =7200 LayoutCachedTop =2760 LayoutCachedWidth =8400 @@ -437,13 +513,18 @@ Begin Form Begin Label BackStyle =1 OverlapFlags =85 + TextFontFamily =0 Left =8640 Top =2760 Width =1200 Height =300 BackColor =3439082 + BorderColor =8355711 + ForeColor =8355711 Name ="Label24" Caption =" " + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =8640 LayoutCachedTop =2760 LayoutCachedWidth =9840 @@ -453,13 +534,18 @@ Begin Form Begin Label BackStyle =1 OverlapFlags =85 + TextFontFamily =0 Left =11520 Top =2760 Width =1200 Height =300 BackColor =-2147483598 + BorderColor =8355711 + ForeColor =8355711 Name ="Label25" Caption =" " + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =11520 LayoutCachedTop =2760 LayoutCachedWidth =12720 @@ -468,13 +554,18 @@ Begin Form End Begin TextBox OverlapFlags =85 + TextFontFamily =0 IMESentenceMode =3 Left =10080 Top =2280 Width =1260 Height =315 TabIndex =4 + BorderColor =10921638 + ForeColor =4210752 Name ="Text28" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =10080 LayoutCachedTop =2280 @@ -483,13 +574,18 @@ Begin Form End Begin TextBox OverlapFlags =85 + TextFontFamily =0 IMESentenceMode =3 Left =5760 Top =2280 Width =1200 Height =315 TabIndex =5 + BorderColor =10921638 + ForeColor =4210752 Name ="Text30" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =5760 LayoutCachedTop =2280 @@ -500,12 +596,16 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =5760 Top =1620 Width =1260 Height =360 + BorderColor =8355711 Name ="Label31" Caption ="Shade" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =5760 LayoutCachedTop =1620 LayoutCachedWidth =7020 @@ -516,12 +616,17 @@ Begin Form Begin Label BackStyle =1 OverlapFlags =85 + TextFontFamily =0 Left =5760 Top =2760 Width =1200 Height =300 + BorderColor =8355711 + ForeColor =8355711 Name ="Label32" Caption =" " + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =5760 LayoutCachedTop =2760 LayoutCachedWidth =6960 @@ -531,12 +636,16 @@ Begin Form End Begin CommandButton OverlapFlags =85 + TextFontFamily =0 Left =4320 Top =3240 Width =1200 TabIndex =6 + ForeColor =4210752 Name ="Command33" Caption ="Command33" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =4320 LayoutCachedTop =3240 @@ -545,6 +654,11 @@ Begin Form Gradient =0 BackThemeColorIndex =5 BackTint =100.0 + BorderColor =11710639 + HoverColor =13355721 + PressedColor =6249563 + HoverForeColor =4210752 + PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -552,12 +666,16 @@ Begin Form End Begin CommandButton OverlapFlags =85 + TextFontFamily =0 Left =5760 Top =3240 Width =1200 TabIndex =7 + ForeColor =4210752 Name ="Command34" Caption ="Command33" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =5760 LayoutCachedTop =3240 @@ -565,6 +683,11 @@ Begin Form LayoutCachedHeight =3600 Gradient =0 BackThemeColorIndex =5 + BorderColor =11710639 + HoverColor =13355721 + PressedColor =6249563 + HoverForeColor =4210752 + PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -572,12 +695,16 @@ Begin Form End Begin CommandButton OverlapFlags =85 + TextFontFamily =0 Left =7200 Top =3240 Width =1200 TabIndex =8 + ForeColor =4210752 Name ="Command35" Caption ="Command33" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =7200 LayoutCachedTop =3240 @@ -587,6 +714,11 @@ Begin Form BackColor =5676533 BackThemeColorIndex =-1 BackTint =100.0 + BorderColor =11710639 + HoverColor =13355721 + PressedColor =6249563 + HoverForeColor =4210752 + PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -594,12 +726,16 @@ Begin Form End Begin CommandButton OverlapFlags =85 + TextFontFamily =0 Left =8640 Top =3240 Width =1200 TabIndex =9 + ForeColor =4210752 Name ="Command36" Caption ="Command33" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =8640 LayoutCachedTop =3240 @@ -609,6 +745,11 @@ Begin Form BackColor =3439082 BackThemeColorIndex =-1 BackTint =100.0 + BorderColor =11710639 + HoverColor =13355721 + PressedColor =6249563 + HoverForeColor =4210752 + PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -616,17 +757,27 @@ Begin Form End Begin CommandButton OverlapFlags =85 + TextFontFamily =0 Left =10080 Top =3240 Width =1200 TabIndex =10 + ForeColor =4210752 Name ="Command37" Caption ="Command33" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =10080 LayoutCachedTop =3240 LayoutCachedWidth =11280 LayoutCachedHeight =3600 + BackColor =11710639 + BorderColor =11710639 + HoverColor =13355721 + PressedColor =6249563 + HoverForeColor =4210752 + PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -634,12 +785,16 @@ Begin Form End Begin CommandButton OverlapFlags =85 + TextFontFamily =0 Left =11520 Top =3240 Width =1200 TabIndex =11 + ForeColor =4210752 Name ="Command38" Caption ="Command33" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =11520 LayoutCachedTop =3240 @@ -649,6 +804,11 @@ Begin Form BackColor =-2147483598 BackThemeColorIndex =-1 BackTint =100.0 + BorderColor =11710639 + HoverColor =13355721 + PressedColor =6249563 + HoverForeColor =4210752 + PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -661,7 +821,9 @@ Begin Form Top =3780 Width =1200 Height =360 + BorderColor =10921638 Name ="Box41" + GridlineColor =10921638 LayoutCachedLeft =4320 LayoutCachedTop =3780 LayoutCachedWidth =5520 @@ -675,7 +837,9 @@ Begin Form Top =3780 Width =1200 Height =360 + BorderColor =10921638 Name ="Box42" + GridlineColor =10921638 LayoutCachedLeft =5760 LayoutCachedTop =3780 LayoutCachedWidth =6960 @@ -691,7 +855,9 @@ Begin Form Width =1200 Height =360 BackColor =5676533 + BorderColor =10921638 Name ="Box43" + GridlineColor =10921638 LayoutCachedLeft =7200 LayoutCachedTop =3780 LayoutCachedWidth =8400 @@ -706,7 +872,9 @@ Begin Form Width =1200 Height =360 BackColor =3439082 + BorderColor =10921638 Name ="Box44" + GridlineColor =10921638 LayoutCachedLeft =8640 LayoutCachedTop =3780 LayoutCachedWidth =9840 @@ -719,7 +887,9 @@ Begin Form Top =3780 Width =1200 Height =360 + BorderColor =10921638 Name ="Box45" + GridlineColor =10921638 LayoutCachedLeft =10080 LayoutCachedTop =3780 LayoutCachedWidth =11280 @@ -733,7 +903,9 @@ Begin Form Width =1200 Height =360 BackColor =-2147483598 + BorderColor =10921638 Name ="Box46" + GridlineColor =10921638 LayoutCachedLeft =11520 LayoutCachedTop =3780 LayoutCachedWidth =12720 @@ -742,12 +914,16 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =0 Left =600 Top =4860 Width =1860 Height =360 + BorderColor =8355711 Name ="Label48" Caption ="Screenshot Image" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =600 LayoutCachedTop =4860 LayoutCachedWidth =2460 @@ -761,8 +937,10 @@ Begin Form Top =4620 Width =10245 Height =2190 + BorderColor =10921638 Name ="Image49" Picture ="Colors" + GridlineColor =10921638 LayoutCachedLeft =2760 LayoutCachedTop =4620 @@ -788,7 +966,3 @@ Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Compare Database Option Explicit - -Private Sub Text13_Click() - -End Sub diff --git a/Testing/Testing.accdb.src/forms/frmMain.bas b/Testing/Testing.accdb.src/forms/frmMain.bas index ec6132aa..eec7411e 100644 --- a/Testing/Testing.accdb.src/forms/frmMain.bas +++ b/Testing/Testing.accdb.src/forms/frmMain.bas @@ -6,20 +6,21 @@ Begin Form DividingLines = NotDefault AllowDesignChanges = NotDefault DefaultView =0 + TabularFamily =18 PictureAlignment =2 DatasheetGridlinesBehavior =3 GridX =24 GridY =24 - Width =8520 + Width =9360 DatasheetFontHeight =11 ItemSuffix =13 - Right =15975 - Bottom =11745 + Right =19650 + Bottom =12585 RecSrcDt = Begin 0x18691eff0b76e540 End Caption ="Main Form" - DatasheetFontName ="Calibri" + DatasheetFontName ="Palatino Linotype" OnLoad ="[Event Procedure]" FilterOnLoad =0 ShowPageMargins =0 @@ -33,6 +34,7 @@ Begin Form ForeThemeColorIndex =0 AlternateBackThemeColorIndex =1 AlternateBackShade =95.0 + ThemeName ="Executive" Begin Begin Label BackStyle =0 @@ -130,13 +132,17 @@ Begin Form Begin Begin CommandButton OverlapFlags =85 + TextFontFamily =18 Left =5400 Top =2940 Width =3120 Height =720 + ForeColor =4210752 Name ="cmdRunTests" Caption =" Verify Database Objects" OnClick ="[Event Procedure]" + FontName ="Palatino Linotype" + GridlineColor =10921638 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x0000000000000000b0a090ff604830ff604830ff604830ff604830ff604830ff , @@ -179,6 +185,12 @@ Begin Form LayoutCachedWidth =8520 LayoutCachedHeight =3660 PictureCaptionArrangement =5 + BackColor =13807008 + BorderColor =13807008 + HoverColor =14796991 + PressedColor =9262658 + HoverForeColor =4210752 + PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -188,6 +200,7 @@ Begin Form Begin ListBox RowSourceTypeInt =1 OverlapFlags =85 + TextFontFamily =18 IMESentenceMode =3 ColumnCount =2 Left =600 @@ -195,6 +208,8 @@ Begin Form Width =4455 Height =5745 TabIndex =1 + ForeColor =4210752 + BorderColor =10921638 Name ="lstResults" RowSourceType ="Value List" RowSource ="✔;Access Table exists;✔;tblInternal has data;✔;Linked Table exists;✔;tblLinkedCS" @@ -203,6 +218,8 @@ Begin Form "ists;✔;Query exists;✔;Form exists;✔;Report exists;✔;Application Icon is set;✔;Cu" "stom Database (DAO) property;✔;Custom Project Property" ColumnWidths ="479;3975" + FontName ="Palatino Linotype" + GridlineColor =10921638 LayoutCachedLeft =600 LayoutCachedTop =1140 @@ -211,12 +228,17 @@ Begin Form Begin Begin Label OverlapFlags =85 + TextFontFamily =18 Left =780 Top =720 Width =2880 Height =320 + BorderColor =8355711 + ForeColor =8355711 Name ="Col1_Label" Caption ="Test Results" + FontName ="Palatino Linotype" + GridlineColor =10921638 LayoutCachedLeft =780 LayoutCachedTop =720 LayoutCachedWidth =3660 @@ -226,28 +248,37 @@ Begin Form End Begin Label OverlapFlags =85 + TextFontFamily =18 Left =5400 Top =1140 - Width =3060 + Width =3720 Height =1635 + BorderColor =8355711 + ForeColor =8355711 Name ="Label4" Caption ="Click the button below to verify the objects in the current database. This helps" " confirm that everything was correctly reconstructed from source." + FontName ="Palatino Linotype" + GridlineColor =10921638 LayoutCachedLeft =5400 LayoutCachedTop =1140 - LayoutCachedWidth =8460 + LayoutCachedWidth =9120 LayoutCachedHeight =2775 End Begin CommandButton OverlapFlags =85 + TextFontFamily =18 Left =5400 Top =3900 Width =3120 Height =720 TabIndex =2 + ForeColor =4210752 Name ="cmdEditTests" Caption =" Edit Tests..." OnClick ="[Event Procedure]" + FontName ="Palatino Linotype" + GridlineColor =10921638 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000000000000000000000 , @@ -290,6 +321,12 @@ Begin Form LayoutCachedWidth =8520 LayoutCachedHeight =4620 PictureCaptionArrangement =5 + BackColor =13807008 + BorderColor =13807008 + HoverColor =14796991 + PressedColor =9262658 + HoverForeColor =4210752 + PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -298,12 +335,17 @@ Begin Form End Begin Label OverlapFlags =93 + TextFontFamily =18 Left =5400 Top =4860 Width =3060 Height =1635 + BorderColor =8355711 + ForeColor =8355711 Name ="lblResults" Caption ="17 tests passed\015\0120 tests failed" + FontName ="Palatino Linotype" + GridlineColor =10921638 LayoutCachedLeft =5400 LayoutCachedTop =4860 LayoutCachedWidth =8460 @@ -315,7 +357,9 @@ Begin Form Top =4860 Width =600 Height =720 + BorderColor =10921638 Name ="imgResult" + GridlineColor =10921638 LayoutCachedLeft =7860 LayoutCachedTop =4860 @@ -353,6 +397,7 @@ Public Sub cmdRunTests_Click() Dim strTest As String Dim intTest As Integer Dim dbs As DAO.Database + Dim rsc As SharedResource Set dbs = CurrentDb @@ -489,6 +534,18 @@ Public Sub cmdRunTests_Click() End With + ' Theme + strTest = CurrentDb.Properties("Theme Resource Name") + ShowResult "Active theme = Angles", (strTest = "Angles") + + strTest = vbNullString + For Each rsc In CurrentProject.Resources + If rsc.Type = acResourceTheme Then + strTest = rsc.Name + If strTest = "Angles" Then Exit For + End If + Next rsc + ShowResult "Theme resource exists", (strTest = "Angles") ' Other ShowResult "VCS Options file exists", FSO.FileExists(ExportFolder & "vcs-options.json") diff --git a/Testing/Testing.accdb.src/modules/Module1.bas b/Testing/Testing.accdb.src/modules/Module1.bas index 064e5048..ac5166d4 100644 --- a/Testing/Testing.accdb.src/modules/Module1.bas +++ b/Testing/Testing.accdb.src/modules/Module1.bas @@ -38,7 +38,7 @@ Private Type DEVNAMES extra(1 To 255) As Byte End Type - +'noncompilingcodeissue ' Showing that we can build even with VBA errors Public Sub PrtMipCols(ByVal strName As String) diff --git a/Testing/Testing.accdb.src/reports/rptDefaultPrinter.bas b/Testing/Testing.accdb.src/reports/rptDefaultPrinter.bas index 202e9d98..d3e1c296 100644 --- a/Testing/Testing.accdb.src/reports/rptDefaultPrinter.bas +++ b/Testing/Testing.accdb.src/reports/rptDefaultPrinter.bas @@ -4,6 +4,7 @@ Begin Report LayoutForPrint = NotDefault DividingLines = NotDefault AllowDesignChanges = NotDefault + TabularFamily =0 DateGrouping =1 GrpKeepTogether =1 PictureAlignment =2 @@ -16,7 +17,7 @@ Begin Report RecSrcDt = Begin 0xe05ff061b477e540 End - DatasheetFontName ="Calibri" + DatasheetFontName ="Franklin Gothic Book" FilterOnLoad =0 FitToPage =1 DisplayOnSharePointSite =1 @@ -61,12 +62,17 @@ Begin Report BackThemeColorIndex =1 Begin Begin Label + TextFontFamily =0 Left =1260 Top =240 Width =4800 Height =420 + BorderColor =8355711 + ForeColor =8355711 Name ="Label0" Caption ="This report does not have any saved print settings." + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =1260 LayoutCachedTop =240 LayoutCachedWidth =6060 diff --git a/Testing/Testing.accdb.src/reports/rptNavigationPaneGroups.bas b/Testing/Testing.accdb.src/reports/rptNavigationPaneGroups.bas index f25a5fde..f8cde805 100644 --- a/Testing/Testing.accdb.src/reports/rptNavigationPaneGroups.bas +++ b/Testing/Testing.accdb.src/reports/rptNavigationPaneGroups.bas @@ -4,6 +4,7 @@ Begin Report LayoutForPrint = NotDefault DividingLines = NotDefault AllowDesignChanges = NotDefault + TabularFamily =0 DateGrouping =1 GrpKeepTogether =1 PictureAlignment =2 @@ -18,7 +19,7 @@ Begin Report End RecordSource ="qryNavigationPaneGroups" Caption ="qryNavigationPaneGroups" - DatasheetFontName ="Calibri" + DatasheetFontName ="Franklin Gothic Book" FilterOnLoad =0 FitToPage =1 DisplayOnSharePointSite =1 @@ -81,13 +82,18 @@ Begin Report BackTint =20.0 Begin Begin Label + TextFontFamily =0 Left =60 Top =60 Width =4350 Height =540 FontSize =20 + BorderColor =8355711 + ForeColor =8355711 Name ="Label4" Caption ="qryNavigationPaneGroups" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =60 LayoutCachedTop =60 LayoutCachedWidth =4410 @@ -105,14 +111,19 @@ Begin Report Begin Begin Label TextAlign =1 + TextFontFamily =0 Left =360 Top =60 Width =3660 Height =315 + BorderColor =8355711 + ForeColor =8355711 Name ="ObjectName_Label" Caption ="ObjectName" + FontName ="Franklin Gothic Book" Tag ="DetachedLabel" GridlineStyleBottom =1 + GridlineColor =10921638 LayoutCachedLeft =360 LayoutCachedTop =60 LayoutCachedWidth =4020 @@ -120,14 +131,19 @@ Begin Report End Begin Label TextAlign =1 + TextFontFamily =0 Left =4380 Top =60 Width =7260 Height =315 + BorderColor =8355711 + ForeColor =8355711 Name ="GroupName_Label" Caption ="GroupName" + FontName ="Franklin Gothic Book" Tag ="DetachedLabel" GridlineStyleBottom =1 + GridlineColor =10921638 LayoutCachedLeft =4380 LayoutCachedTop =60 LayoutCachedWidth =11640 @@ -147,13 +163,18 @@ Begin Report Begin TextBox DecimalPlaces =0 OldBorderStyle =0 + TextFontFamily =0 IMESentenceMode =3 Left =360 Width =3660 Height =330 ColumnWidth =1665 + BorderColor =10921638 + ForeColor =4210752 Name ="ObjectName" ControlSource ="ObjectName" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =360 LayoutCachedWidth =4020 @@ -172,13 +193,18 @@ Begin Report Begin Begin TextBox OldBorderStyle =0 + TextFontFamily =0 IMESentenceMode =3 Left =4380 Width =7260 Height =330 ColumnWidth =1545 + BorderColor =10921638 + ForeColor =4210752 Name ="GroupName" ControlSource ="GroupName" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =4380 LayoutCachedWidth =11640 @@ -197,14 +223,19 @@ Begin Report Begin TextBox OldBorderStyle =0 TextAlign =1 + TextFontFamily =0 IMESentenceMode =3 Left =60 Top =240 Width =5040 Height =330 + BorderColor =10921638 + ForeColor =4210752 Name ="Text5" ControlSource ="=Now()" Format ="Long Date" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =60 LayoutCachedTop =240 @@ -214,14 +245,19 @@ Begin Report Begin TextBox OldBorderStyle =0 TextAlign =3 + TextFontFamily =0 IMESentenceMode =3 Left =6600 Top =240 Width =5040 Height =330 TabIndex =1 + BorderColor =10921638 + ForeColor =4210752 Name ="Text6" ControlSource ="=\"Page \" & [Page] & \" of \" & [Pages]" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =6600 LayoutCachedTop =240 diff --git a/Testing/Testing.accdb.src/reports/rptNonDefaultPaperSize.bas b/Testing/Testing.accdb.src/reports/rptNonDefaultPaperSize.bas index 740558ab..65be8637 100644 --- a/Testing/Testing.accdb.src/reports/rptNonDefaultPaperSize.bas +++ b/Testing/Testing.accdb.src/reports/rptNonDefaultPaperSize.bas @@ -4,6 +4,7 @@ Begin Report LayoutForPrint = NotDefault DividingLines = NotDefault AllowDesignChanges = NotDefault + TabularFamily =0 DateGrouping =1 GrpKeepTogether =1 PictureAlignment =2 @@ -16,7 +17,7 @@ Begin Report RecSrcDt = Begin 0xe05ff061b477e540 End - DatasheetFontName ="Calibri" + DatasheetFontName ="Franklin Gothic Book" FilterOnLoad =0 FitToPage =1 DisplayOnSharePointSite =1 @@ -61,12 +62,17 @@ Begin Report BackThemeColorIndex =1 Begin Begin Label + TextFontFamily =0 Left =1260 Top =240 Width =4800 Height =420 + BorderColor =8355711 + ForeColor =8355711 Name ="Label0" Caption ="This report uses A4 landscape paper size" + FontName ="Franklin Gothic Book" + GridlineColor =10921638 LayoutCachedLeft =1260 LayoutCachedTop =240 LayoutCachedWidth =6060 diff --git a/Testing/Testing.accdb.src/themes/Angles.thmx b/Testing/Testing.accdb.src/themes/Angles.thmx new file mode 100644 index 00000000..b22a2b57 Binary files /dev/null and b/Testing/Testing.accdb.src/themes/Angles.thmx differ diff --git a/Testing/Testing.accdb.src/themes/Executive.thmx b/Testing/Testing.accdb.src/themes/Executive.thmx new file mode 100644 index 00000000..682bd967 Binary files /dev/null and b/Testing/Testing.accdb.src/themes/Executive.thmx differ diff --git a/Testing/Testing.accdb.src/themes/Office Theme.thmx b/Testing/Testing.accdb.src/themes/Office Theme.thmx deleted file mode 100644 index 53dd1919..00000000 Binary files a/Testing/Testing.accdb.src/themes/Office Theme.thmx and /dev/null differ diff --git a/Testing/Testing.accdb.src/vbeforms/frmForm20.frx b/Testing/Testing.accdb.src/vbeforms/frmForm20.frx index 1bff6d56..ac73ee0f 100644 Binary files a/Testing/Testing.accdb.src/vbeforms/frmForm20.frx and b/Testing/Testing.accdb.src/vbeforms/frmForm20.frx differ diff --git a/Testing/Testing.accdb.src/vcs-options.json b/Testing/Testing.accdb.src/vcs-options.json index c50e444d..009bbac9 100644 --- a/Testing/Testing.accdb.src/vcs-options.json +++ b/Testing/Testing.accdb.src/vcs-options.json @@ -1,6 +1,6 @@ { "Info": { - "AddinVersion": "3.4.1", + "AddinVersion": "3.4.13", "AccessVersion": "14.0 32-bit" }, "Options": { @@ -35,7 +35,8 @@ "ForceImportOriginalQuerySQL": false, "SaveTableSQL": true, "StripPublishOption": true, - "AggressiveSanitize": true, + "SanitizeColors": 1, + "SanitizeLevel": 2, "ExtractThemeFiles": false, "TablesToExportData": { "tblInternal": { diff --git a/Version Control.accda.src/dbs-properties.json b/Version Control.accda.src/dbs-properties.json index 320388df..724eea96 100644 --- a/Version Control.accda.src/dbs-properties.json +++ b/Version Control.accda.src/dbs-properties.json @@ -41,7 +41,7 @@ "Type": 10 }, "AppVersion": { - "Value": "3.3.17", + "Value": "3.4.14", "Type": 10 }, "Auto Compact": { diff --git a/Version Control.accda.src/documents.json b/Version Control.accda.src/documents.json index be44b330..6ae96fd5 100644 --- a/Version Control.accda.src/documents.json +++ b/Version Control.accda.src/documents.json @@ -1,13 +1,11 @@ -{ +{ "Info": { "Class": "clsDbDocument", - "Description": "Database Documents Properties (DAO)", - "VCS Version": "3.1.34" + "Description": "Database Documents Properties (DAO)" }, "Items": { "Databases": { "SummaryInfo": { - "Author": " ", "Comments": "Export source code and database objects for tracking in Version Control Systems like GitHub and GitLab. Also used for building a database from source files.", "Company": "https://github.com/joyfullservice/msaccess-vcs-integration", "Title": "Version Control" diff --git a/Version Control.accda.src/forms/frmVCSInstall.bas b/Version Control.accda.src/forms/frmVCSInstall.bas index 580c2af9..36770d7b 100644 --- a/Version Control.accda.src/forms/frmVCSInstall.bas +++ b/Version Control.accda.src/forms/frmVCSInstall.bas @@ -17,11 +17,10 @@ Begin Form GridY =24 DatasheetFontHeight =11 ItemSuffix =39 - Left =-25575 - Top =1710 - Right =-255 - Bottom =14295 - DatasheetGridlinesColor =15132391 + Left =3225 + Top =2430 + Right =22695 + Bottom =15015 RecSrcDt = Begin 0x79e78b777268e540 End @@ -77,8 +76,6 @@ Begin Form BorderLineStyle =0 SizeMode =3 PictureAlignment =2 - BorderColor =16777215 - GridlineColor =16777215 BackThemeColorIndex =1 BorderThemeColorIndex =1 BorderShade =65.0 @@ -99,7 +96,6 @@ Begin Form BackThemeColorIndex =4 BackTint =60.0 BorderLineStyle =0 - BorderColor =16777215 BorderThemeColorIndex =4 BorderTint =60.0 ThemeFontIndex =1 @@ -151,7 +147,6 @@ Begin Form Width =7200 BorderColor =15321539 Name ="Line10" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedTop =1230 LayoutCachedWidth =7200 @@ -166,9 +161,7 @@ Begin Form Width =7200 Height =1200 BackColor =5324600 - BorderColor =10921638 Name ="Box1" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedWidth =7200 LayoutCachedHeight =1200 @@ -182,11 +175,8 @@ Begin Form Height =540 FontSize =18 FontWeight =700 - BorderColor =8355711 - ForeColor =16777215 Name ="Label4" Caption ="Version Control System" - GridlineColor =10921638 LayoutCachedLeft =420 LayoutCachedTop =180 LayoutCachedWidth =4995 @@ -202,12 +192,10 @@ Begin Form Width =2400 Height =780 TabIndex =1 - ForeColor =4210752 Name ="cmdInstall" Caption =" Install Add-In" OnClick ="[Event Procedure]" Picture ="Export.png" - GridlineColor =10921638 ImageData = Begin 0x89504e470d0a1a0a0000000d494844520000001e0000001e08060000003b30ae , 0xa2000031697a5458745261772070726f66696c65207479706520657869660000 , @@ -703,8 +691,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -719,11 +705,9 @@ Begin Form Height =360 FontSize =14 FontWeight =700 - BorderColor =8355711 ForeColor =5324600 Name ="lblHeading" Caption ="Install Add-In" - GridlineColor =10921638 LayoutCachedLeft =540 LayoutCachedTop =1680 LayoutCachedWidth =2640 @@ -738,13 +722,11 @@ Begin Form Width =3060 Height =1440 FontSize =10 - BorderColor =8355711 ForeColor =5324600 Name ="lblSubheading" Caption ="Click the Install button to install or update the add-in.\015\012\015\012In some" " more secure environments, you may need to use one or both of the additional opt" "ions." - GridlineColor =10921638 LayoutCachedLeft =540 LayoutCachedTop =2160 LayoutCachedWidth =3600 @@ -759,11 +741,8 @@ Begin Form Width =2940 Height =360 FontSize =10 - BorderColor =8355711 - ForeColor =16777215 Name ="lblVersion" Caption ="Version 3.2.3" - GridlineColor =10921638 LayoutCachedLeft =600 LayoutCachedTop =720 LayoutCachedWidth =3540 @@ -778,11 +757,8 @@ Begin Form Width =3375 Height =240 FontSize =10 - BorderColor =8355711 - ForeColor =8355711 Name ="Label32" Caption ="joyfullservice/msaccess-vcs-integration" - GridlineColor =10921638 VerticalAnchor =1 LayoutCachedLeft =300 LayoutCachedTop =4260 @@ -800,10 +776,8 @@ Begin Form Top =120 Width =840 Height =900 - BorderColor =10921638 Name ="Image32" Picture ="adept_installer_7039.png" - GridlineColor =10921638 ImageData = Begin 0x89504e470d0a1a0a0000000d4948445200000080000000800806000000c33e61 , 0xcb00000006624b474400ff00ff00ffa0bda793000000097048597300002e2300 , @@ -1342,10 +1316,8 @@ Begin Form Left =4440 Top =2970 TabIndex =2 - BorderColor =10921638 Name ="chkAddTrustedLocation" DefaultValue ="True" - GridlineColor =10921638 LayoutCachedLeft =4440 LayoutCachedTop =2970 @@ -1359,11 +1331,9 @@ Begin Form Width =1935 Height =315 FontSize =10 - BorderColor =8355711 ForeColor =5324600 Name ="Label34" Caption ="Trust Add-In Folder" - GridlineColor =10921638 LayoutCachedLeft =4725 LayoutCachedTop =2940 LayoutCachedWidth =6660 @@ -1379,10 +1349,8 @@ Begin Form Left =4440 Top =3390 TabIndex =3 - BorderColor =10921638 Name ="chkOpenAfterInstall" DefaultValue ="False" - GridlineColor =10921638 LayoutCachedLeft =4440 LayoutCachedTop =3390 @@ -1396,11 +1364,9 @@ Begin Form Width =1935 Height =465 FontSize =10 - BorderColor =8355711 ForeColor =5324600 Name ="Label36" Caption ="Open after install to \015\012trust add-in file" - GridlineColor =10921638 LayoutCachedLeft =4725 LayoutCachedTop =3360 LayoutCachedWidth =6660 @@ -1419,11 +1385,9 @@ Begin Form Width =2160 FontSize =9 TabIndex =4 - ForeColor =12673797 Name ="cmdExplainOptions" Caption ="Explain options..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Installation" - GridlineColor =10921638 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x000000000000000000000000000000000000000000000000e0e8e000e0c8b000 , @@ -1483,8 +1447,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 @@ -1497,11 +1459,9 @@ Begin Form Width =3060 Height =300 FontSize =10 - BorderColor =8355711 ForeColor =5324600 Name ="lblInstalled" Caption ="Version x.x is currently installed." - GridlineColor =10921638 LayoutCachedLeft =540 LayoutCachedTop =3720 LayoutCachedWidth =3600 @@ -1518,21 +1478,13 @@ Begin Form Top =120 Width =240 Height =180 - ForeColor =4210752 Name ="cmdCancel" OnClick ="[Event Procedure]" - GridlineColor =10921638 LayoutCachedLeft =6840 LayoutCachedTop =120 LayoutCachedWidth =7080 LayoutCachedHeight =300 - BackColor =14461583 - BorderColor =14461583 - HoverColor =15189940 - PressedColor =9917743 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -1594,7 +1546,7 @@ Private Sub cmdInstall_Click() DoCmd.Hourglass True ' Check for legacy installations (before updating version) - CheckForLegacyInstall + RunUpgrades ' Save the trusted location and open file settings. InstallSettingTrustedLocation = chkAddTrustedLocation.Value diff --git a/Version Control.accda.src/forms/frmVCSMain.bas b/Version Control.accda.src/forms/frmVCSMain.bas index 12936b3a..4c3764f0 100644 --- a/Version Control.accda.src/forms/frmVCSMain.bas +++ b/Version Control.accda.src/forms/frmVCSMain.bas @@ -20,12 +20,13 @@ Begin Form Top =1710 Right =-255 Bottom =14295 - DatasheetGridlinesColor =14806254 + OnUnload ="[Event Procedure]" RecSrcDt = Begin 0x79e78b777268e540 End Caption ="MSAccessVCS" DatasheetFontName ="Calibri" + OnTimer ="[Event Procedure]" OnLoad ="[Event Procedure]" AllowDatasheetView =0 FilterOnLoad =0 @@ -76,8 +77,6 @@ Begin Form BorderLineStyle =0 SizeMode =3 PictureAlignment =2 - BorderColor =16777215 - GridlineColor =16777215 BackThemeColorIndex =1 BorderThemeColorIndex =1 BorderShade =65.0 @@ -98,7 +97,6 @@ Begin Form BackThemeColorIndex =4 BackTint =60.0 BorderLineStyle =0 - BorderColor =16777215 BorderThemeColorIndex =4 BorderTint =60.0 ThemeFontIndex =1 @@ -150,7 +148,6 @@ Begin Form Width =9360 BorderColor =15321539 Name ="Line10" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedTop =1725 LayoutCachedWidth =9360 @@ -165,9 +162,7 @@ Begin Form Width =9360 Height =1680 BackColor =5324600 - BorderColor =10921638 Name ="Box1" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedWidth =9360 LayoutCachedHeight =1680 @@ -181,11 +176,8 @@ Begin Form Height =540 FontSize =18 FontWeight =700 - BorderColor =8355711 - ForeColor =16777215 Name ="Label4" Caption ="Version Control System" - GridlineColor =10921638 LayoutCachedLeft =360 LayoutCachedTop =300 LayoutCachedWidth =4620 @@ -200,12 +192,10 @@ Begin Form Width =2880 Height =900 TabIndex =1 - ForeColor =4210752 Name ="cmdExport" Caption =" Export All Source" OnClick ="[Event Procedure]" Picture ="Export.png" - GridlineColor =10921638 ImageData = Begin 0x89504e470d0a1a0a0000000d494844520000001e0000001e08060000003b30ae , 0xa2000031697a5458745261772070726f66696c65207479706520657869660000 , @@ -701,8 +691,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 @@ -717,11 +705,9 @@ Begin Form Height =360 FontSize =14 FontWeight =700 - BorderColor =8355711 ForeColor =5324600 Name ="lblHeading" Caption ="Choose Action" - GridlineColor =10921638 LayoutCachedLeft =540 LayoutCachedTop =2100 LayoutCachedWidth =2640 @@ -736,7 +722,6 @@ Begin Form Width =2880 Height =900 TabIndex =2 - ForeColor =4210752 Name ="cmdBuild" Caption =" Build From Source" OnClick ="[Event Procedure]" @@ -745,7 +730,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 ImageData = Begin 0x89504e470d0a1a0a0000000d494844520000001e0000001e08060000003b30ae , 0xa2000035447a5458745261772070726f66696c65207479706520657869660000 , @@ -1255,8 +1239,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =9 @@ -1270,11 +1252,9 @@ Begin Form Width =2400 Height =540 FontSize =10 - BorderColor =8355711 ForeColor =5324600 Name ="lblSubheading" Caption ="What would you like to do?" - GridlineColor =10921638 LayoutCachedLeft =540 LayoutCachedTop =2580 LayoutCachedWidth =2940 @@ -1289,11 +1269,8 @@ Begin Form Width =1800 Height =465 FontSize =10 - BorderColor =8355711 - ForeColor =16777215 Name ="Label9" Caption ="Designed for \015\012GitHub && GitLab" - GridlineColor =10921638 LayoutCachedLeft =540 LayoutCachedTop =840 LayoutCachedWidth =2340 @@ -1302,6 +1279,7 @@ Begin Form ForeTint =100.0 End Begin TextBox + Locked = NotDefault TabStop = NotDefault OldBorderStyle =0 OverlapFlags =85 @@ -1313,10 +1291,8 @@ Begin Form Height =2400 FontSize =10 TabIndex =3 - BorderColor =8355711 ForeColor =5324600 Name ="txtDescription" - GridlineColor =10921638 TextFormat =1 VerticalAnchor =2 @@ -1338,7 +1314,6 @@ Begin Form Width =1500 Height =420 TabIndex =4 - ForeColor =4210752 Name ="cmdClose" Caption ="Close" OnClick ="[Event Procedure]" @@ -1346,7 +1321,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 HorizontalAnchor =1 VerticalAnchor =1 @@ -1366,8 +1340,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =9 @@ -1380,7 +1352,6 @@ Begin Form Top =1200 Width =1560 TabIndex =5 - ForeColor =16777215 Name ="cmdOptions" Caption =" Options..." OnClick ="[Event Procedure]" @@ -1388,7 +1359,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000000000000000000000 , @@ -1447,8 +1417,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =10 @@ -1462,11 +1430,8 @@ Begin Form Width =3375 Height =240 FontSize =10 - BorderColor =8355711 - ForeColor =8355711 Name ="Label32" Caption ="joyfullservice/msaccess-vcs-integration" - GridlineColor =10921638 VerticalAnchor =1 LayoutCachedLeft =300 LayoutCachedTop =5940 @@ -1485,7 +1450,6 @@ Begin Form Top =1200 Width =1080 TabIndex =6 - ForeColor =16777215 Name ="cmdHelp" Caption =" Help" OnClick ="[Event Procedure]" @@ -1493,7 +1457,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 HorizontalAnchor =1 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , @@ -1553,8 +1516,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =10 @@ -1569,10 +1530,7 @@ Begin Form Width =3180 Height =240 FontSize =10 - BorderColor =8355711 - ForeColor =16777215 Name ="lblVersion" - GridlineColor =10921638 HorizontalAnchor =1 LayoutCachedLeft =5820 LayoutCachedTop =480 @@ -1588,10 +1546,7 @@ Begin Form Top =5640 Width =5160 Height =180 - BorderColor =8355711 - ForeColor =8355711 Name ="lblProgBack" - GridlineColor =10921638 HorizontalAnchor =2 VerticalAnchor =1 LayoutCachedLeft =3120 @@ -1606,10 +1561,7 @@ Begin Form Top =6000 Width =2220 Height =180 - BorderColor =8355711 - ForeColor =8355711 Name ="lblProgFront" - GridlineColor =10921638 LayoutCachedLeft =4500 LayoutCachedTop =6000 LayoutCachedWidth =6720 @@ -1623,10 +1575,7 @@ Begin Form Width =1260 Height =180 FontSize =8 - BorderColor =8355711 - ForeColor =8355711 Name ="lblProgCaption" - GridlineColor =10921638 LayoutCachedLeft =4980 LayoutCachedTop =6120 LayoutCachedWidth =6240 @@ -1641,13 +1590,10 @@ Begin Form Width =1320 Height =240 FontSize =10 - BorderColor =10921638 - ForeColor =16711680 Name ="lblOpenLogFile" Caption ="Open Log File..." OnClick ="[Event Procedure]" HyperlinkAddress ="#" - GridlineColor =10921638 LayoutCachedLeft =3120 LayoutCachedTop =5640 LayoutCachedWidth =4440 @@ -1664,9 +1610,7 @@ Begin Form Left =2460 Top =1080 Width =660 - BorderColor =16777215 Name ="Line27" - GridlineColor =10921638 LayoutCachedLeft =2460 LayoutCachedTop =1080 LayoutCachedWidth =3120 @@ -1678,9 +1622,7 @@ Begin Form Left =5700 Top =3390 TabIndex =7 - BorderColor =10921638 Name ="chkFullExport" - GridlineColor =10921638 LayoutCachedLeft =5700 LayoutCachedTop =3390 @@ -1694,11 +1636,9 @@ Begin Form Width =1335 Height =270 FontSize =10 - BorderColor =8355711 ForeColor =5324600 Name ="Label29" Caption ="Full Export" - GridlineColor =10921638 LayoutCachedLeft =5925 LayoutCachedTop =3360 LayoutCachedWidth =7260 @@ -1714,10 +1654,8 @@ Begin Form Left =5700 Top =4950 TabIndex =8 - BorderColor =10921638 Name ="chkFullBuild" DefaultValue ="True" - GridlineColor =10921638 LayoutCachedLeft =5700 LayoutCachedTop =4950 @@ -1731,11 +1669,9 @@ Begin Form Width =1335 Height =270 FontSize =10 - BorderColor =8355711 ForeColor =5324600 Name ="Label31" Caption ="Full Build" - GridlineColor =10921638 LayoutCachedLeft =5925 LayoutCachedTop =4920 LayoutCachedWidth =7260 @@ -1762,10 +1698,8 @@ Begin Form TopMargin =144 RightMargin =144 BottomMargin =144 - BorderColor =10921638 Name ="txtLog" FontName ="Lucida Console" - GridlineColor =10921638 TextFormat =1 HorizontalAnchor =2 VerticalAnchor =2 @@ -1852,7 +1786,7 @@ Private Sub cmdBuild_Click() ' Selected a folder If FolderHasVcsOptionsFile(.SelectedItems(1)) Then ' Has source files - strFolder = .SelectedItems(1) + strFolder = .SelectedItems(1) & PathSep ' Relaunch build if building the add-in from source. If FSO.GetFileName(strFolder) = "Version Control.accda.src" Then DoCmd.Close acForm, Me.Name @@ -1865,6 +1799,10 @@ Private Sub cmdBuild_Click() DoCmd.Hourglass False Exit Sub End If + Else + ' Canceled dialog + DoCmd.Hourglass False + Exit Sub End If End With End If @@ -1933,12 +1871,40 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Sub cmdClose_Click() + + ' Check to see if we are actively logging a process. + If Log.Active Then + If ConfirmCancel Then + ' Throw a critical error, which will terminate the current export/build + Log.Error eelCritical, "Canceled Operation", Me.Name & ".cmdClose_Click" + End If + ' Either way, we should not attempt to close the form while the log is active. + Exit Sub + End If + + ' Close the form Log.SetConsole Nothing Set Log.ProgressBar = Nothing DoCmd.Close acForm, Me.Name + End Sub +'--------------------------------------------------------------------------------------- +' Procedure : ConfirmCancel +' Author : Adam Waller +' Date : 7/8/2021 +' Purpose : Confirm that the user really wants to cancel the current operation. +'--------------------------------------------------------------------------------------- +' +Private Function ConfirmCancel() As Boolean + ConfirmCancel = MsgBox2("Cancel Current Operation?", _ + "You are in the midst of a running process. Are you sure you want to cancel?", _ + "Click [Yes] to cancel the process, or [No] to resume.", _ + vbYesNo + vbDefaultButton2 + vbExclamation) = vbYes +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : cmdExport_Click ' Author : Adam Waller @@ -1968,8 +1934,12 @@ Private Sub cmdExport_Click() txtLog.ScrollBars = 2 Log.Flush - SetStatusText "Finished", "Export Complete", "Additional details can be found in the project export log file.

You may now close this window." - lblOpenLogFile.Visible = (Log.LogFilePath <> vbNullString) + ' Don't attempt to access controls if we are in the process of closing the form. + If FormLoaded(Me) Then + SetStatusText "Finished", "Export Complete", "Additional details can be found in the project export log file.

You may now close this window." + lblOpenLogFile.Visible = (Log.LogFilePath <> vbNullString) + DoEvents + End If End Sub @@ -2076,10 +2046,7 @@ Public Sub HandleCmd(Optional ByVal RibbonCmdIn As Long = erlVCSOpen) 'Start export, then close if no errors. Me.Visible = True cmdExport_Click - If Log.ErrorLevel = eelNoError Then - Pause 2 - cmdClose_Click - End If + If Log.ErrorLevel = eelNoError Then AutoClose Case Else 'default to export and close if no errors. Me.Visible = True @@ -2089,6 +2056,33 @@ Public Sub HandleCmd(Optional ByVal RibbonCmdIn As Long = erlVCSOpen) End Sub +'--------------------------------------------------------------------------------------- +' Procedure : AutoClose +' Author : Adam Waller +' Date : 5/6/2021 +' Purpose : Use the timer to automatically close the form in 2 seconds. +' : (This keeps the application from "hanging" during the pause between +' : completion and close.) +'--------------------------------------------------------------------------------------- +' +Private Sub AutoClose() + Me.TimerInterval = 2000 +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : Form_Timer +' Author : Adam Waller +' Date : 5/6/2021 +' Purpose : Automatically close form. +'--------------------------------------------------------------------------------------- +' +Private Sub Form_Timer() + Me.TimerInterval = 0 + cmdClose_Click +End Sub + + '--------------------------------------------------------------------------------------- ' Procedure : SetStatusText ' Author : Adam Waller @@ -2098,6 +2092,7 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Sub SetStatusText(strHeading As String, strSubHeading As String, strDescriptionHtml As String) + If Not FormLoaded(Me) Then Exit Sub lblHeading.Caption = strHeading lblSubheading.Caption = strSubHeading txtDescription.Value = strDescriptionHtml @@ -2117,6 +2112,32 @@ Private Function GetProgressBar() As clsLblProg End Function +'--------------------------------------------------------------------------------------- +' Procedure : Form_Unload +' Author : Adam Waller +' Date : 7/8/2021 +' Purpose : Verify that the user wants to cancel the current operation +'--------------------------------------------------------------------------------------- +' +Private Sub Form_Unload(Cancel As Integer) + + Static intAttempt As Integer + + ' Allow the form to close on the third attempt, just in case the log + ' is stuck in active status for some reason. + If intAttempt > 2 Then Exit Sub + + ' Check to see if we have an active job running. + If Log.Active Then + If ConfirmCancel Then Log.Error eelCritical, "Canceled Operation", Me.Name & ".Form_Unload" + ' Either way, we want the log to complete first. + Cancel = True + intAttempt = intAttempt + 1 + End If + +End Sub + + '--------------------------------------------------------------------------------------- ' Procedure : lblOpenLogFile_Click ' Author : Adam Waller diff --git a/Version Control.accda.src/forms/frmVCSOptions.bas b/Version Control.accda.src/forms/frmVCSOptions.bas index fc1f09de..39c38c75 100644 --- a/Version Control.accda.src/forms/frmVCSOptions.bas +++ b/Version Control.accda.src/forms/frmVCSOptions.bas @@ -15,12 +15,11 @@ Begin Form GridY =24 Width =10080 DatasheetFontHeight =11 - ItemSuffix =228 - Left =3225 - Top =2430 - Right =22695 - Bottom =15015 - DatasheetGridlinesColor =14806254 + ItemSuffix =236 + Left =-25575 + Top =1710 + Right =-5925 + Bottom =14295 RecSrcDt = Begin 0x79e78b777268e540 End @@ -76,8 +75,6 @@ Begin Form BorderLineStyle =0 SizeMode =3 PictureAlignment =2 - BorderColor =16777215 - GridlineColor =16777215 BackThemeColorIndex =1 BorderThemeColorIndex =1 BorderShade =65.0 @@ -98,7 +95,6 @@ Begin Form BackThemeColorIndex =4 BackTint =60.0 BorderLineStyle =0 - BorderColor =16777215 BorderThemeColorIndex =4 BorderTint =60.0 ThemeFontIndex =1 @@ -190,7 +186,6 @@ Begin Form BackThemeColorIndex =1 BackShade =85.0 BorderLineStyle =0 - BorderColor =16777215 BorderThemeColorIndex =2 BorderTint =60.0 HoverThemeColorIndex =1 @@ -221,7 +216,6 @@ Begin Form Width =10080 BorderColor =15321539 Name ="Line10" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedTop =1080 LayoutCachedWidth =10080 @@ -236,9 +230,7 @@ Begin Form Width =10080 Height =1020 BackColor =5324600 - BorderColor =10921638 Name ="Box1" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedWidth =10080 LayoutCachedHeight =1020 @@ -252,11 +244,8 @@ Begin Form Height =540 FontSize =18 FontWeight =700 - BorderColor =8355711 - ForeColor =16777215 Name ="lblOptions" Caption ="Options" - GridlineColor =10921638 LayoutCachedLeft =540 LayoutCachedTop =240 LayoutCachedWidth =4560 @@ -272,11 +261,8 @@ Begin Form Width =2040 Height =240 FontSize =10 - BorderColor =8355711 - ForeColor =16777215 Name ="Label9" Caption ="Version Control System " - GridlineColor =10921638 HorizontalAnchor =1 LayoutCachedLeft =7140 LayoutCachedTop =300 @@ -292,7 +278,6 @@ Begin Form Top =6540 Width =1500 Height =420 - ForeColor =4210752 Name ="cmdCancel" Caption ="Cancel" OnClick ="[Event Procedure]" @@ -300,7 +285,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 HorizontalAnchor =1 VerticalAnchor =1 @@ -320,8 +304,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =9 @@ -335,7 +317,6 @@ Begin Form Width =1860 Height =420 TabIndex =1 - ForeColor =4210752 Name ="cmdSaveAndClose" Caption =" Save && Close" OnClick ="[Event Procedure]" @@ -343,7 +324,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 HorizontalAnchor =1 VerticalAnchor =1 ImageData = Begin @@ -400,8 +380,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =9 @@ -413,17 +391,16 @@ Begin Form Left =540 Top =1500 Width =9000 - Height =4740 + Height =4755 TabIndex =2 Name ="tabOptions" - GridlineColor =10921638 HorizontalAnchor =2 VerticalAnchor =2 LayoutCachedLeft =540 LayoutCachedTop =1500 LayoutCachedWidth =9540 - LayoutCachedHeight =6240 + LayoutCachedHeight =6255 ThemeFontIndex =1 Shape =1 Gradient =12 @@ -437,24 +414,19 @@ Begin Form HoverThemeColorIndex =-1 PressedColor =15130848 PressedThemeColorIndex =-1 - HoverForeColor =4210752 - PressedForeColor =4210752 - ForeColor =4210752 Begin Begin Page OverlapFlags =87 Left =615 Top =1980 Width =8850 - Height =4190 - BorderColor =10921638 + Height =4200 Name ="pgeGeneral" Caption ="General" - GridlineColor =10921638 LayoutCachedLeft =615 LayoutCachedTop =1980 LayoutCachedWidth =9465 - LayoutCachedHeight =6170 + LayoutCachedHeight =6180 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 @@ -464,9 +436,7 @@ Begin Form OverlapFlags =215 Left =1020 Top =4020 - BorderColor =10921638 Name ="chkShowDebug" - GridlineColor =10921638 LayoutCachedLeft =1020 LayoutCachedTop =4020 @@ -479,11 +449,9 @@ Begin Form Top =3960 Width =2640 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label23" Caption ="Show Detailed Output" - GridlineColor =10921638 LayoutCachedLeft =1320 LayoutCachedTop =3960 LayoutCachedWidth =3960 @@ -498,9 +466,7 @@ Begin Form Left =1020 Top =4440 TabIndex =1 - BorderColor =10921638 Name ="chkBreakOnError" - GridlineColor =10921638 LayoutCachedLeft =1020 LayoutCachedTop =4440 @@ -513,11 +479,9 @@ Begin Form Top =4380 Width =2640 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label219" Caption ="Debug VBA Errors" - GridlineColor =10921638 LayoutCachedLeft =1320 LayoutCachedTop =4380 LayoutCachedWidth =3960 @@ -532,10 +496,7 @@ Begin Form Left =1020 Top =4860 TabIndex =2 - BorderColor =10921638 - Name ="chkUseGitIntegration" - OnClick ="[Event Procedure]" - GridlineColor =10921638 + Name ="chkShowVCSLegacy" LayoutCachedLeft =1020 LayoutCachedTop =4860 @@ -548,11 +509,9 @@ Begin Form Top =4800 Width =2640 Height =315 - BorderColor =8355711 ForeColor =5324600 - Name ="Label163" - Caption ="Use Git Integration" - GridlineColor =10921638 + Name ="Label215" + Caption ="Show Legacy Prompts" LayoutCachedLeft =1320 LayoutCachedTop =4800 LayoutCachedWidth =3960 @@ -563,13 +522,13 @@ Begin Form End End Begin CheckBox + Visible = NotDefault OverlapFlags =215 Left =1020 Top =5280 TabIndex =3 - BorderColor =10921638 - Name ="chkShowVCSLegacy" - GridlineColor =10921638 + Name ="chkUseGitIntegration" + OnClick ="[Event Procedure]" LayoutCachedLeft =1020 LayoutCachedTop =5280 @@ -582,11 +541,9 @@ Begin Form Top =5220 Width =2640 Height =315 - BorderColor =8355711 ForeColor =5324600 - Name ="Label215" - Caption ="Show Legacy Prompts" - GridlineColor =10921638 + Name ="Label163" + Caption ="Use Git Integration" LayoutCachedLeft =1320 LayoutCachedTop =5220 LayoutCachedWidth =3960 @@ -606,12 +563,9 @@ Begin Form Width =1920 Height =315 TabIndex =4 - BorderColor =10921638 - ForeColor =4138256 Name ="cboHashAlgorithm" RowSourceType ="Value List" RowSource ="\"SHA1\";\"SHA256\";\"SHA512\"" - GridlineColor =10921638 AllowValueListEdits =0 LayoutCachedLeft =6720 @@ -625,11 +579,9 @@ Begin Form Top =4800 Width =1560 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label221" Caption ="Hash Algorithm:" - GridlineColor =10921638 LayoutCachedLeft =5040 LayoutCachedTop =4800 LayoutCachedWidth =6600 @@ -644,9 +596,7 @@ Begin Form Left =5040 Top =5280 TabIndex =5 - BorderColor =10921638 Name ="chkUseShortHash" - GridlineColor =10921638 LayoutCachedLeft =5040 LayoutCachedTop =5280 @@ -659,11 +609,9 @@ Begin Form Top =5220 Width =2640 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label223" Caption ="Use short hashes in index" - GridlineColor =10921638 LayoutCachedLeft =5340 LayoutCachedTop =5220 LayoutCachedWidth =7980 @@ -679,11 +627,9 @@ Begin Form Top =3960 Width =3780 Height =600 - BorderColor =8355711 ForeColor =5324600 Name ="Label224" Caption ="Some environments may have specific requirements for hashing algorithms." - GridlineColor =10921638 LayoutCachedLeft =5040 LayoutCachedTop =3960 LayoutCachedWidth =8820 @@ -698,9 +644,7 @@ Begin Form Left =960 Top =3600 Width =8160 - BorderColor =10921638 Name ="Line226" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedLeft =960 LayoutCachedTop =3600 @@ -715,14 +659,12 @@ Begin Form Top =2340 Width =8160 Height =1095 - BorderColor =8355711 ForeColor =5324600 Name ="Label227" Caption ="Use this form to set your preferred options for exporting and building your data" "base project to and from source files. Note that you can have different options " "for different projects, and can save a set of options as default for new project" "s." - GridlineColor =10921638 LayoutCachedLeft =1020 LayoutCachedTop =2340 LayoutCachedWidth =9180 @@ -737,15 +679,13 @@ Begin Form Left =615 Top =1980 Width =8850 - Height =4185 - BorderColor =10921638 + Height =4200 Name ="pgeExport" Caption ="Export" - GridlineColor =10921638 LayoutCachedLeft =615 LayoutCachedTop =1980 LayoutCachedWidth =9465 - LayoutCachedHeight =6165 + LayoutCachedHeight =6180 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 @@ -758,10 +698,8 @@ Begin Form Top =2340 Width =3420 Height =315 - BorderColor =10921638 - ForeColor =4210752 Name ="txtExportFolder" - GridlineColor =10921638 + BeforeUpdate ="[Event Procedure]" LayoutCachedLeft =2460 LayoutCachedTop =2340 @@ -774,11 +712,9 @@ Begin Form Top =2340 Width =1380 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label31" Caption ="Export Folder:" - GridlineColor =10921638 LayoutCachedLeft =960 LayoutCachedTop =2340 LayoutCachedWidth =2340 @@ -793,9 +729,7 @@ Begin Form Left =1020 Top =2940 TabIndex =1 - BorderColor =10921638 Name ="chkUseFastSave" - GridlineColor =10921638 LayoutCachedLeft =1020 LayoutCachedTop =2940 @@ -808,11 +742,9 @@ Begin Form Top =2880 Width =2640 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label25" Caption ="Use Fast Save" - GridlineColor =10921638 LayoutCachedLeft =1320 LayoutCachedTop =2880 LayoutCachedWidth =3960 @@ -827,9 +759,7 @@ Begin Form Left =1020 Top =3360 TabIndex =2 - BorderColor =10921638 Name ="chkStripPublishOption" - GridlineColor =10921638 LayoutCachedLeft =1020 LayoutCachedTop =3360 @@ -842,11 +772,9 @@ Begin Form Top =3300 Width =2640 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label34" Caption ="Strip out Publish Option" - GridlineColor =10921638 LayoutCachedLeft =1320 LayoutCachedTop =3300 LayoutCachedWidth =3960 @@ -856,69 +784,82 @@ Begin Form End End End - Begin CheckBox + Begin ComboBox + LimitToList = NotDefault + RowSourceTypeInt =1 OverlapFlags =247 - Left =1020 - Top =3780 + IMESentenceMode =3 + ColumnCount =2 + Left =2760 + Top =3720 + Width =1980 + Height =315 TabIndex =3 - BorderColor =10921638 - Name ="chkAggressiveSanitize" - GridlineColor =10921638 + Name ="cboSanitizeLevel" + RowSourceType ="Value List" + ColumnWidths ="0" + HorizontalAnchor =1 + AllowValueListEdits =0 - LayoutCachedLeft =1020 - LayoutCachedTop =3780 - LayoutCachedWidth =1280 - LayoutCachedHeight =4020 + LayoutCachedLeft =2760 + LayoutCachedTop =3720 + LayoutCachedWidth =4740 + LayoutCachedHeight =4035 Begin Begin Label OverlapFlags =247 - Left =1320 + Left =1020 Top =3720 - Width =2640 - Height =315 - BorderColor =8355711 + Width =1560 + Height =305 ForeColor =5324600 - Name ="Label40" - Caption ="Aggressive Sanitize" - GridlineColor =10921638 - LayoutCachedLeft =1320 + Name ="Label235" + Caption ="Sanitize Level" + HorizontalAnchor =1 + LayoutCachedLeft =1020 LayoutCachedTop =3720 - LayoutCachedWidth =3960 - LayoutCachedHeight =4035 + LayoutCachedWidth =2580 + LayoutCachedHeight =4025 ForeThemeColorIndex =-1 ForeTint =100.0 End End End - Begin CheckBox + Begin ComboBox + RowSourceTypeInt =1 OverlapFlags =247 - Left =1020 - Top =4200 + IMESentenceMode =3 + ColumnCount =2 + Left =2760 + Top =4140 + Width =1980 + Height =315 TabIndex =4 - BorderColor =10921638 - Name ="chkExtractThemeFiles" - GridlineColor =10921638 + Name ="cboSanitizeColors" + RowSourceType ="Value List" + ColumnWidths ="0" + HorizontalAnchor =1 + AllowValueListEdits =0 - LayoutCachedLeft =1020 - LayoutCachedTop =4200 - LayoutCachedWidth =1280 - LayoutCachedHeight =4440 + LayoutCachedLeft =2760 + LayoutCachedTop =4140 + LayoutCachedWidth =4740 + LayoutCachedHeight =4455 Begin Begin Label OverlapFlags =247 - Left =1320 + Left =1020 Top =4140 - Width =2640 - Height =315 - BorderColor =8355711 + Width =1560 + Height =305 ForeColor =5324600 - Name ="Label112" - Caption ="Extract Theme Files" - GridlineColor =10921638 - LayoutCachedLeft =1320 + Name ="Label233" + Caption ="Sanitize Colors" + HorizontalAnchor =1 + LayoutCachedLeft =1020 LayoutCachedTop =4140 - LayoutCachedWidth =3960 - LayoutCachedHeight =4455 + LayoutCachedWidth =2580 + LayoutCachedHeight =4445 ForeThemeColorIndex =-1 ForeTint =100.0 End @@ -926,32 +867,28 @@ Begin Form End Begin CheckBox OverlapFlags =247 - Left =4500 + Left =5340 Top =2935 TabIndex =5 - BorderColor =10921638 Name ="chkSavePrintVars" - GridlineColor =10921638 - LayoutCachedLeft =4500 + LayoutCachedLeft =5340 LayoutCachedTop =2935 - LayoutCachedWidth =4760 + LayoutCachedWidth =5600 LayoutCachedHeight =3175 Begin Begin Label OverlapFlags =247 - Left =4800 + Left =5640 Top =2880 - Width =2640 + Width =2340 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label27" - Caption ="Save Report Print Settings" - GridlineColor =10921638 - LayoutCachedLeft =4800 + Caption ="Save Printer Settings" + LayoutCachedLeft =5640 LayoutCachedTop =2880 - LayoutCachedWidth =7440 + LayoutCachedWidth =7980 LayoutCachedHeight =3195 ForeThemeColorIndex =-1 ForeTint =100.0 @@ -960,32 +897,28 @@ Begin Form End Begin CheckBox OverlapFlags =247 - Left =4500 + Left =5340 Top =3360 TabIndex =6 - BorderColor =10921638 Name ="chkSaveQuerySQL" - GridlineColor =10921638 - LayoutCachedLeft =4500 + LayoutCachedLeft =5340 LayoutCachedTop =3360 - LayoutCachedWidth =4760 + LayoutCachedWidth =5600 LayoutCachedHeight =3600 Begin Begin Label OverlapFlags =247 - Left =4800 + Left =5640 Top =3300 - Width =2640 + Width =2340 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label29" Caption ="Save Query SQL" - GridlineColor =10921638 - LayoutCachedLeft =4800 + LayoutCachedLeft =5640 LayoutCachedTop =3300 - LayoutCachedWidth =7440 + LayoutCachedWidth =7980 LayoutCachedHeight =3615 ForeThemeColorIndex =-1 ForeTint =100.0 @@ -994,54 +927,77 @@ Begin Form End Begin CheckBox OverlapFlags =247 - Left =4500 + Left =5340 Top =3780 TabIndex =7 - BorderColor =10921638 Name ="chkSaveTableSQL" - GridlineColor =10921638 - LayoutCachedLeft =4500 + LayoutCachedLeft =5340 LayoutCachedTop =3780 - LayoutCachedWidth =4760 + LayoutCachedWidth =5600 LayoutCachedHeight =4020 Begin Begin Label OverlapFlags =247 - Left =4800 + Left =5640 Top =3720 - Width =2640 + Width =2340 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label38" Caption ="Save Table SQL" - GridlineColor =10921638 - LayoutCachedLeft =4800 + LayoutCachedLeft =5640 LayoutCachedTop =3720 - LayoutCachedWidth =7440 + LayoutCachedWidth =7980 LayoutCachedHeight =4035 ForeThemeColorIndex =-1 ForeTint =100.0 End End End + Begin CheckBox + OverlapFlags =247 + Left =5340 + Top =4200 + TabIndex =8 + Name ="chkExtractThemeFiles" + + LayoutCachedLeft =5340 + LayoutCachedTop =4200 + LayoutCachedWidth =5600 + LayoutCachedHeight =4440 + Begin + Begin Label + OverlapFlags =247 + Left =5640 + Top =4140 + Width =2340 + Height =315 + ForeColor =5324600 + Name ="Label112" + Caption ="Extract Theme Files" + LayoutCachedLeft =5640 + LayoutCachedTop =4140 + LayoutCachedWidth =7980 + LayoutCachedHeight =4455 + ForeThemeColorIndex =-1 + ForeTint =100.0 + End + End + End Begin TextBox OverlapFlags =247 IMESentenceMode =3 - Left =3300 + Left =3540 Top =5100 - Width =1980 + Width =2700 Height =315 - TabIndex =8 - BorderColor =10921638 - ForeColor =4210752 + TabIndex =9 Name ="txtRunBeforeExport" - GridlineColor =10921638 - LayoutCachedLeft =3300 + LayoutCachedLeft =3540 LayoutCachedTop =5100 - LayoutCachedWidth =5280 + LayoutCachedWidth =6240 LayoutCachedHeight =5415 Begin Begin Label @@ -1050,11 +1006,9 @@ Begin Form Top =5100 Width =2205 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label44" Caption ="Run Sub Before Export:" - GridlineColor =10921638 LayoutCachedLeft =1020 LayoutCachedTop =5100 LayoutCachedWidth =3225 @@ -1067,19 +1021,16 @@ Begin Form Begin TextBox OverlapFlags =247 IMESentenceMode =3 - Left =3300 + Left =3540 Top =5520 - Width =1980 + Width =2700 Height =315 - TabIndex =9 - BorderColor =10921638 - ForeColor =4210752 + TabIndex =10 Name ="txtRunAfterExport" - GridlineColor =10921638 - LayoutCachedLeft =3300 + LayoutCachedLeft =3540 LayoutCachedTop =5520 - LayoutCachedWidth =5280 + LayoutCachedWidth =6240 LayoutCachedHeight =5835 Begin Begin Label @@ -1088,11 +1039,9 @@ Begin Form Top =5520 Width =2055 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label48" Caption ="Run Sub After Export:" - GridlineColor =10921638 LayoutCachedLeft =1020 LayoutCachedTop =5520 LayoutCachedWidth =3075 @@ -1108,13 +1057,11 @@ Begin Form Left =7140 Top =5640 Width =2160 - TabIndex =10 - ForeColor =16711680 + TabIndex =11 Name ="cmdExplainOptions" Caption ="Explain options..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Documentation#op" "tions" - GridlineColor =10921638 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x000000000000000000000000000000000000000000000000e0e8e000e0c8b000 , @@ -1174,8 +1121,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 @@ -1188,11 +1133,8 @@ Begin Form Width =2160 Height =240 FontSize =10 - BorderColor =8355711 - ForeColor =8355711 Name ="Label46" Caption ="(Blank for default)" - GridlineColor =10921638 LayoutCachedLeft =6120 LayoutCachedTop =2400 LayoutCachedWidth =8280 @@ -1201,21 +1143,20 @@ Begin Form Begin Label FontUnderline = NotDefault OverlapFlags =247 - Left =7500 + Left =8100 Top =2880 Width =900 Height =240 FontSize =10 BackColor =14262935 BorderColor =15321539 - ForeColor =16711680 Name ="lblPrintSettingsOptions" Caption ="Options..." + OnClick ="[Event Procedure]" HyperlinkAddress ="#" - GridlineColor =10921638 - LayoutCachedLeft =7500 + LayoutCachedLeft =8100 LayoutCachedTop =2880 - LayoutCachedWidth =8400 + LayoutCachedWidth =9000 LayoutCachedHeight =3120 BackThemeColorIndex =-1 BorderThemeColorIndex =-1 @@ -1231,15 +1172,13 @@ Begin Form Left =615 Top =1980 Width =8850 - Height =4185 - BorderColor =10921638 + Height =4200 Name ="pgePrinterSettings" Caption ="Printer Settings" - GridlineColor =10921638 LayoutCachedLeft =615 LayoutCachedTop =1980 LayoutCachedWidth =9465 - LayoutCachedHeight =6165 + LayoutCachedHeight =6180 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 @@ -1249,9 +1188,7 @@ Begin Form OverlapFlags =247 Left =1200 Top =2395 - BorderColor =10921638 Name ="chkOrientation" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =2395 @@ -1264,11 +1201,9 @@ Begin Form Top =2340 Width =1920 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label115" Caption ="Page Orientation" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =2340 LayoutCachedWidth =3420 @@ -1283,9 +1218,7 @@ Begin Form Left =1200 Top =2755 TabIndex =1 - BorderColor =10921638 Name ="chkPaperSize" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =2755 @@ -1298,11 +1231,9 @@ Begin Form Top =2700 Width =1920 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label117" Caption ="Paper Size" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =2700 LayoutCachedWidth =3420 @@ -1317,9 +1248,7 @@ Begin Form Left =1200 Top =3775 TabIndex =2 - BorderColor =10921638 Name ="chkDuplex" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =3775 @@ -1332,11 +1261,9 @@ Begin Form Top =3720 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label130" Caption ="Duplex" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =3720 LayoutCachedWidth =2940 @@ -1351,9 +1278,7 @@ Begin Form Left =3780 Top =3775 TabIndex =3 - BorderColor =10921638 Name ="chkPrintQuality" - GridlineColor =10921638 LayoutCachedLeft =3780 LayoutCachedTop =3775 @@ -1366,11 +1291,9 @@ Begin Form Top =3720 Width =1620 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label128" Caption ="Print Quality" - GridlineColor =10921638 LayoutCachedLeft =4080 LayoutCachedTop =3720 LayoutCachedWidth =5700 @@ -1385,9 +1308,7 @@ Begin Form Left =7020 Top =3775 TabIndex =4 - BorderColor =10921638 Name ="chkDisplayFrequency" - GridlineColor =10921638 LayoutCachedLeft =7020 LayoutCachedTop =3775 @@ -1400,11 +1321,9 @@ Begin Form Top =3720 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label148" Caption ="Display Freq." - GridlineColor =10921638 LayoutCachedLeft =7320 LayoutCachedTop =3720 LayoutCachedWidth =8760 @@ -1419,9 +1338,7 @@ Begin Form Left =1200 Top =4135 TabIndex =5 - BorderColor =10921638 Name ="chkCollate" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =4135 @@ -1434,11 +1351,9 @@ Begin Form Top =4080 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label134" Caption ="Collate" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =4080 LayoutCachedWidth =2940 @@ -1453,9 +1368,7 @@ Begin Form Left =3780 Top =4135 TabIndex =6 - BorderColor =10921638 Name ="chkResolution" - GridlineColor =10921638 LayoutCachedLeft =3780 LayoutCachedTop =4135 @@ -1468,11 +1381,9 @@ Begin Form Top =4080 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label132" Caption ="Resolution" - GridlineColor =10921638 LayoutCachedLeft =4080 LayoutCachedTop =4080 LayoutCachedWidth =5520 @@ -1487,9 +1398,7 @@ Begin Form Left =7020 Top =4135 TabIndex =7 - BorderColor =10921638 Name ="chkDisplayFlags" - GridlineColor =10921638 LayoutCachedLeft =7020 LayoutCachedTop =4135 @@ -1502,11 +1411,9 @@ Begin Form Top =4080 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label146" Caption ="Display Flags" - GridlineColor =10921638 LayoutCachedLeft =7320 LayoutCachedTop =4080 LayoutCachedWidth =8760 @@ -1521,9 +1428,7 @@ Begin Form Left =1200 Top =4495 TabIndex =8 - BorderColor =10921638 Name ="chkColor" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =4495 @@ -1536,11 +1441,9 @@ Begin Form Top =4440 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label144" Caption ="Color or B/W" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =4440 LayoutCachedWidth =2940 @@ -1555,9 +1458,7 @@ Begin Form Left =3780 Top =4495 TabIndex =9 - BorderColor =10921638 Name ="chkCopies" - GridlineColor =10921638 LayoutCachedLeft =3780 LayoutCachedTop =4495 @@ -1570,11 +1471,9 @@ Begin Form Top =4440 Width =1800 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label123" Caption ="Number of Copies" - GridlineColor =10921638 LayoutCachedLeft =4080 LayoutCachedTop =4440 LayoutCachedWidth =5880 @@ -1589,9 +1488,7 @@ Begin Form Left =7020 Top =4495 TabIndex =10 - BorderColor =10921638 Name ="chkICMMethod" - GridlineColor =10921638 LayoutCachedLeft =7020 LayoutCachedTop =4495 @@ -1604,11 +1501,9 @@ Begin Form Top =4440 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label150" Caption ="ICM Method" - GridlineColor =10921638 LayoutCachedLeft =7320 LayoutCachedTop =4440 LayoutCachedWidth =8760 @@ -1623,9 +1518,7 @@ Begin Form Left =1200 Top =4855 TabIndex =11 - BorderColor =10921638 Name ="chkDefaultSource" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =4855 @@ -1638,11 +1531,9 @@ Begin Form Top =4800 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label125" Caption ="Paper Tray" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =4800 LayoutCachedWidth =2940 @@ -1657,9 +1548,7 @@ Begin Form Left =3780 Top =4855 TabIndex =12 - BorderColor =10921638 Name ="chkScale" - GridlineColor =10921638 LayoutCachedLeft =3780 LayoutCachedTop =4855 @@ -1672,11 +1561,9 @@ Begin Form Top =4800 Width =2220 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label121" Caption ="Print Scale" - GridlineColor =10921638 LayoutCachedLeft =4080 LayoutCachedTop =4800 LayoutCachedWidth =6300 @@ -1691,9 +1578,7 @@ Begin Form Left =7020 Top =4855 TabIndex =13 - BorderColor =10921638 Name ="chkICMIntent" - GridlineColor =10921638 LayoutCachedLeft =7020 LayoutCachedTop =4855 @@ -1706,11 +1591,9 @@ Begin Form Top =4800 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label152" Caption ="ICM Intent" - GridlineColor =10921638 LayoutCachedLeft =7320 LayoutCachedTop =4800 LayoutCachedWidth =8760 @@ -1725,9 +1608,7 @@ Begin Form Left =1200 Top =5215 TabIndex =14 - BorderColor =10921638 Name ="chkFormName" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =5215 @@ -1740,11 +1621,9 @@ Begin Form Top =5160 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label142" Caption ="Form Name" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =5160 LayoutCachedWidth =2940 @@ -1759,9 +1638,7 @@ Begin Form Left =3780 Top =5215 TabIndex =15 - BorderColor =10921638 Name ="chkPaperLength" - GridlineColor =10921638 LayoutCachedLeft =3780 LayoutCachedTop =5215 @@ -1774,11 +1651,9 @@ Begin Form Top =5160 Width =2220 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label119" Caption ="Custom Length" - GridlineColor =10921638 LayoutCachedLeft =4080 LayoutCachedTop =5160 LayoutCachedWidth =6300 @@ -1793,9 +1668,7 @@ Begin Form Left =7020 Top =5215 TabIndex =16 - BorderColor =10921638 Name ="chkDitherType" - GridlineColor =10921638 LayoutCachedLeft =7020 LayoutCachedTop =5215 @@ -1808,11 +1681,9 @@ Begin Form Top =5160 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label156" Caption ="Dither Type" - GridlineColor =10921638 LayoutCachedLeft =7320 LayoutCachedTop =5160 LayoutCachedWidth =8760 @@ -1827,9 +1698,7 @@ Begin Form Left =1200 Top =5575 TabIndex =17 - BorderColor =10921638 Name ="chkMediaType" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =5575 @@ -1842,11 +1711,9 @@ Begin Form Top =5520 Width =1440 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label154" Caption ="Media Type" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =5520 LayoutCachedWidth =2940 @@ -1861,9 +1728,7 @@ Begin Form Left =3780 Top =5575 TabIndex =18 - BorderColor =10921638 Name ="chkPaperWidth" - GridlineColor =10921638 LayoutCachedLeft =3780 LayoutCachedTop =5575 @@ -1876,11 +1741,9 @@ Begin Form Top =5520 Width =2220 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label158" Caption ="Custom Width" - GridlineColor =10921638 LayoutCachedLeft =4080 LayoutCachedTop =5520 LayoutCachedWidth =6300 @@ -1895,9 +1758,7 @@ Begin Form Left =7020 Top =5575 TabIndex =19 - BorderColor =10921638 Name ="chkTTOption" - GridlineColor =10921638 LayoutCachedLeft =7020 LayoutCachedTop =5575 @@ -1910,11 +1771,9 @@ Begin Form Top =5520 Width =1725 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label140" Caption ="TT Font Handling" - GridlineColor =10921638 LayoutCachedLeft =7320 LayoutCachedTop =5520 LayoutCachedWidth =9045 @@ -1930,12 +1789,10 @@ Begin Form Top =2340 Width =5040 Height =825 - BorderColor =8355711 ForeColor =5324600 Name ="Label126" Caption ="Select any additional settings that you would like saved to version control and " "used when building a database from source files." - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedLeft =3720 LayoutCachedTop =2340 @@ -1951,9 +1808,7 @@ Begin Form Left =960 Top =3360 Width =8160 - BorderColor =10921638 Name ="Line161" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedLeft =960 LayoutCachedTop =3360 @@ -1969,15 +1824,13 @@ Begin Form Left =615 Top =1980 Width =8850 - Height =4185 - BorderColor =10921638 + Height =4200 Name ="pgeTable" Caption ="Table Data" - GridlineColor =10921638 LayoutCachedLeft =615 LayoutCachedTop =1980 LayoutCachedWidth =9465 - LayoutCachedHeight =6165 + LayoutCachedHeight =6180 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 @@ -1993,14 +1846,11 @@ Begin Form Top =2280 Width =6045 Height =3240 - ForeColor =4210752 - BorderColor =10921638 Name ="lstTables" RowSourceType ="Value List" RowSource =";Table Name;Save Data" ColumnWidths ="340;4320" OnClick ="[Event Procedure]" - GridlineColor =10921638 HorizontalAnchor =2 VerticalAnchor =2 AllowValueListEdits =0 @@ -2015,11 +1865,9 @@ Begin Form Left =1020 Top =5760 TabIndex =1 - BorderColor =10921638 Name ="chkTableShowHidden" DefaultValue ="False" OnClick ="[Event Procedure]" - GridlineColor =10921638 VerticalAnchor =1 LayoutCachedLeft =1020 @@ -2033,11 +1881,9 @@ Begin Form Top =5700 Width =1380 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label71" Caption ="Show Hidden" - GridlineColor =10921638 VerticalAnchor =1 LayoutCachedLeft =1320 LayoutCachedTop =5700 @@ -2053,11 +1899,9 @@ Begin Form Left =2940 Top =5760 TabIndex =2 - BorderColor =10921638 Name ="chkTableShowSystem" DefaultValue ="False" OnClick ="[Event Procedure]" - GridlineColor =10921638 VerticalAnchor =1 LayoutCachedLeft =2940 @@ -2071,11 +1915,9 @@ Begin Form Top =5700 Width =1380 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label73" Caption ="Show System" - GridlineColor =10921638 VerticalAnchor =1 LayoutCachedLeft =3240 LayoutCachedTop =5700 @@ -2086,6 +1928,40 @@ Begin Form End End End + Begin CheckBox + OverlapFlags =247 + Left =4860 + Top =5760 + TabIndex =6 + Name ="chkTableShowOther" + DefaultValue ="False" + OnClick ="[Event Procedure]" + VerticalAnchor =1 + + LayoutCachedLeft =4860 + LayoutCachedTop =5760 + LayoutCachedWidth =5120 + LayoutCachedHeight =6000 + Begin + Begin Label + OverlapFlags =247 + Left =5160 + Top =5700 + Width =1200 + Height =315 + ForeColor =5324600 + Name ="Label85" + Caption ="Show Other" + VerticalAnchor =1 + LayoutCachedLeft =5160 + LayoutCachedTop =5700 + LayoutCachedWidth =6360 + LayoutCachedHeight =6015 + ForeThemeColorIndex =-1 + ForeTint =100.0 + End + End + End Begin TextBox Locked = NotDefault OverlapFlags =247 @@ -2095,11 +1971,7 @@ Begin Form Width =2400 Height =855 TabIndex =3 - BackColor =15921906 - BorderColor =10921638 - ForeColor =4210752 Name ="txtTableName" - GridlineColor =10921638 HorizontalAnchor =1 LayoutCachedLeft =6960 @@ -2114,11 +1986,9 @@ Begin Form Top =3240 Width =1500 Height =300 - BorderColor =8355711 ForeColor =5324600 Name ="Label79" Caption ="Selected Table:" - GridlineColor =10921638 HorizontalAnchor =1 LayoutCachedLeft =6960 LayoutCachedTop =3240 @@ -2139,11 +2009,8 @@ Begin Form Width =2400 Height =315 TabIndex =4 - BorderColor =10921638 - ForeColor =4138256 Name ="cboTableDataSaveType" RowSourceType ="Value List" - GridlineColor =10921638 HorizontalAnchor =1 AllowValueListEdits =0 @@ -2158,12 +2025,10 @@ Begin Form Top =4620 Width =1455 Height =305 - BorderColor =8355711 ForeColor =5324600 Name ="Data to Export_Label" Caption ="Data to Export" EventProcPrefix ="Data_to_Export_Label" - GridlineColor =10921638 HorizontalAnchor =1 LayoutCachedLeft =6960 LayoutCachedTop =4620 @@ -2174,33 +2039,11 @@ Begin Form End End End - Begin Label - OverlapFlags =247 - Left =6960 - Top =2280 - Width =2400 - Height =840 - FontSize =10 - BorderColor =8355711 - ForeColor =5324600 - Name ="Label82" - Caption ="You may optionally include data from specific tables as part of the export proce" - "ss." - GridlineColor =10921638 - HorizontalAnchor =1 - LayoutCachedLeft =6960 - LayoutCachedTop =2280 - LayoutCachedWidth =9360 - LayoutCachedHeight =3120 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End Begin CommandButton OverlapFlags =247 Left =6960 Top =5340 TabIndex =5 - ForeColor =4210752 Name ="cmdUpdateTableData" Caption =" Update" OnClick ="[Event Procedure]" @@ -2208,7 +2051,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 HorizontalAnchor =1 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , @@ -2264,50 +2106,29 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =9 WebImagePaddingBottom =9 End - Begin CheckBox + Begin Label OverlapFlags =247 - Left =4860 - Top =5760 - TabIndex =6 - BorderColor =10921638 - Name ="chkTableShowOther" - DefaultValue ="False" - OnClick ="[Event Procedure]" - GridlineColor =10921638 - VerticalAnchor =1 - - LayoutCachedLeft =4860 - LayoutCachedTop =5760 - LayoutCachedWidth =5120 - LayoutCachedHeight =6000 - Begin - Begin Label - OverlapFlags =247 - Left =5160 - Top =5700 - Width =1200 - Height =315 - BorderColor =8355711 - ForeColor =5324600 - Name ="Label85" - Caption ="Show Other" - GridlineColor =10921638 - VerticalAnchor =1 - LayoutCachedLeft =5160 - LayoutCachedTop =5700 - LayoutCachedWidth =6360 - LayoutCachedHeight =6015 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End - End + Left =6960 + Top =2280 + Width =2400 + Height =840 + FontSize =10 + ForeColor =5324600 + Name ="Label82" + Caption ="You may optionally include data from specific tables as part of the export proce" + "ss." + HorizontalAnchor =1 + LayoutCachedLeft =6960 + LayoutCachedTop =2280 + LayoutCachedWidth =9360 + LayoutCachedHeight =3120 + ForeThemeColorIndex =-1 + ForeTint =100.0 End Begin Label FontUnderline = NotDefault @@ -2319,12 +2140,10 @@ Begin Form FontSize =10 BackColor =14262935 BorderColor =15321539 - ForeColor =16711680 Name ="lblAddOtherTable" Caption ="Other..." OnClick ="[Event Procedure]" HyperlinkAddress ="#" - GridlineColor =10921638 HorizontalAnchor =1 LayoutCachedLeft =8640 LayoutCachedTop =3255 @@ -2343,20 +2162,84 @@ Begin Form Left =615 Top =1980 Width =8850 - Height =4185 - BorderColor =10921638 + Height =4200 Name ="pgeBuild" Caption ="Build" - GridlineColor =10921638 LayoutCachedLeft =615 LayoutCachedTop =1980 LayoutCachedWidth =9465 - LayoutCachedHeight =6165 + LayoutCachedHeight =6180 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 WebImagePaddingBottom =2 Begin + Begin CheckBox + OverlapFlags =247 + Left =1140 + Top =4555 + TabIndex =1 + Name ="chkForceImportOriginalQuerySQL" + + LayoutCachedLeft =1140 + LayoutCachedTop =4555 + LayoutCachedWidth =1400 + LayoutCachedHeight =4795 + Begin + Begin Label + OverlapFlags =247 + Left =1447 + Top =4500 + Width =3705 + Height =315 + ForeColor =5324600 + Name ="lblForceImportOriginalQuerySQL" + Caption ="Force import of original SQL for queries" + LayoutCachedLeft =1447 + LayoutCachedTop =4500 + LayoutCachedWidth =5152 + LayoutCachedHeight =4815 + ForeThemeColorIndex =-1 + ForeTint =100.0 + End + End + End + Begin TextBox + OverlapFlags =247 + IMESentenceMode =3 + Left =3420 + Top =5040 + Width =2640 + Height =315 + TabIndex =2 + Name ="txtRunBeforeBuild" + ValidationRule ="Like \"*?.?*\" Or \"\" Or Is Null" + ValidationText ="This value must include both module and sub names joined with a period. For exam" + "ple, use MyModule.Bootstrap to run the Bootstrap sub in MyModule." + + LayoutCachedLeft =3420 + LayoutCachedTop =5040 + LayoutCachedWidth =6060 + LayoutCachedHeight =5355 + Begin + Begin Label + OverlapFlags =247 + Left =1140 + Top =5040 + Width =2085 + Height =315 + ForeColor =5324600 + Name ="Label229" + Caption ="Run Sub Before Build:" + LayoutCachedLeft =1140 + LayoutCachedTop =5040 + LayoutCachedWidth =3225 + LayoutCachedHeight =5355 + ForeThemeColorIndex =-1 + ForeTint =100.0 + End + End + End Begin TextBox OverlapFlags =247 IMESentenceMode =3 @@ -2364,10 +2247,7 @@ Begin Form Top =5460 Width =2640 Height =315 - BorderColor =10921638 - ForeColor =4210752 Name ="txtRunAfterBuild" - GridlineColor =10921638 LayoutCachedLeft =3420 LayoutCachedTop =5460 @@ -2380,11 +2260,9 @@ Begin Form Top =5460 Width =2055 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label104" Caption ="Run Sub After Build:" - GridlineColor =10921638 LayoutCachedLeft =1140 LayoutCachedTop =5460 LayoutCachedWidth =3195 @@ -2399,75 +2277,63 @@ Begin Form Left =1140 Top =2100 Width =7860 - Height =2445 - BorderColor =8355711 + Height =2220 ForeColor =5324600 Name ="Label105" - Caption ="PLEASE NOTE:\015\012\015\012The build functionality in this tool is fairly new w" - "ith limited testing in real-world applications. It is very important that you te" - "st this carefully in your environment to make sure everything you need is being " - "created in your database during the build.\015\012\015\012Please see the online " - "documentation for additional details on the build process. If you encounter an i" - "ssue, please feel free to submit issues and/or pull requests on the GitHub proje" - "ct." - GridlineColor =10921638 + Caption ="PLEASE NOTE:\015\012The build functionality in this tool is fairly new with limi" + "ted testing in real-world applications. It is very important that you test this " + "carefully in your environment to make sure everything you need is being created " + "in your database during the build.\015\012\015\012Please see the online document" + "ation for additional details on the build process. If you encounter an issue, pl" + "ease feel free to submit issues and/or pull requests on the GitHub project." LayoutCachedLeft =1140 LayoutCachedTop =2100 LayoutCachedWidth =9000 - LayoutCachedHeight =4545 + LayoutCachedHeight =4320 ForeThemeColorIndex =-1 ForeTint =100.0 End - Begin CheckBox - OverlapFlags =247 - Left =1140 - Top =4885 - TabIndex =1 - BorderColor =10921638 - Name ="chkForceImportOriginalQuerySQL" - GridlineColor =10921638 - - LayoutCachedLeft =1140 - LayoutCachedTop =4885 - LayoutCachedWidth =1400 - LayoutCachedHeight =5125 - Begin - Begin Label - OverlapFlags =247 - Left =1447 - Top =4830 - Width =3705 - Height =315 - BorderColor =8355711 - ForeColor =5324600 - Name ="lblForceImportOriginalQuerySQL" - Caption ="Force import of original SQL for queries" - GridlineColor =10921638 - LayoutCachedLeft =1447 - LayoutCachedTop =4830 - LayoutCachedWidth =5152 - LayoutCachedHeight =5145 - ForeThemeColorIndex =-1 - ForeTint =100.0 - End - End - End Begin Label OverlapFlags =247 Left =5197 - Top =4874 + Top =4544 Width =4170 Height =240 FontSize =10 - BorderColor =8355711 - ForeColor =8355711 Name ="lblForceImportSQLNote" Caption ="(\"Save Query SQL\" option needed when exporting)" - GridlineColor =10921638 LayoutCachedLeft =5197 - LayoutCachedTop =4874 + LayoutCachedTop =4544 LayoutCachedWidth =9367 - LayoutCachedHeight =5114 + LayoutCachedHeight =4784 + End + Begin Label + OverlapFlags =247 + Left =6240 + Top =5100 + Width =3120 + Height =240 + FontSize =10 + Name ="Label230" + Caption ="Use \"module.sub\" to specify module" + LayoutCachedLeft =6240 + LayoutCachedTop =5100 + LayoutCachedWidth =9360 + LayoutCachedHeight =5340 + End + Begin Label + OverlapFlags =247 + Left =6240 + Top =5520 + Width =2760 + Height =240 + FontSize =10 + Name ="Label231" + Caption ="(Module name optional)" + LayoutCachedLeft =6240 + LayoutCachedTop =5520 + LayoutCachedWidth =9000 + LayoutCachedHeight =5760 End End End @@ -2477,15 +2343,13 @@ Begin Form Left =615 Top =1980 Width =8850 - Height =4185 - BorderColor =10921638 + Height =4200 Name ="pgeGitIntegration" Caption ="Git Integration" - GridlineColor =10921638 LayoutCachedLeft =615 LayoutCachedTop =1980 LayoutCachedWidth =9465 - LayoutCachedHeight =6165 + LayoutCachedHeight =6180 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 @@ -2495,9 +2359,7 @@ Begin Form OverlapFlags =247 Left =1200 Top =2395 - BorderColor =10921638 Name ="chkMergeUntrackedFiles" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =2395 @@ -2510,11 +2372,9 @@ Begin Form Top =2340 Width =3240 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label166" Caption ="Merge Untracked (New) Files" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =2340 LayoutCachedWidth =4740 @@ -2529,9 +2389,7 @@ Begin Form Left =1200 Top =3235 TabIndex =1 - BorderColor =10921638 Name ="chkMergeQuerySQL" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =3235 @@ -2544,11 +2402,9 @@ Begin Form Top =3180 Width =2190 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label172" Caption ="Merge .SQL for queries" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =3180 LayoutCachedWidth =3690 @@ -2563,9 +2419,7 @@ Begin Form Left =6120 Top =4615 TabIndex =2 - BorderColor =10921638 Name ="chkInspectSharedImages" - GridlineColor =10921638 LayoutCachedLeft =6120 LayoutCachedTop =4615 @@ -2578,11 +2432,9 @@ Begin Form Top =4560 Width =2040 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label182" Caption ="Shared Images" - GridlineColor =10921638 LayoutCachedLeft =6420 LayoutCachedTop =4560 LayoutCachedWidth =8460 @@ -2597,9 +2449,7 @@ Begin Form Left =6120 Top =5035 TabIndex =3 - BorderColor =10921638 Name ="chkInspectThemeFiles" - GridlineColor =10921638 LayoutCachedLeft =6120 LayoutCachedTop =5035 @@ -2612,11 +2462,9 @@ Begin Form Top =4980 Width =2040 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label188" Caption ="Access Theme Files" - GridlineColor =10921638 LayoutCachedLeft =6420 LayoutCachedTop =4980 LayoutCachedWidth =8460 @@ -2631,9 +2479,7 @@ Begin Form Left =1200 Top =2815 TabIndex =4 - BorderColor =10921638 Name ="chkImportTableData" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =2815 @@ -2646,11 +2492,9 @@ Begin Form Top =2760 Width =2760 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label194" Caption ="Import Modified Table Data" - GridlineColor =10921638 LayoutCachedLeft =1500 LayoutCachedTop =2760 LayoutCachedWidth =4260 @@ -2666,12 +2510,10 @@ Begin Form Top =2340 Width =3900 Height =825 - BorderColor =8355711 ForeColor =5324600 Name ="Label205" Caption ="Please see the online documentation for additional information on these settings" " and the git integration." - GridlineColor =10921638 LayoutCachedLeft =4860 LayoutCachedTop =2340 LayoutCachedWidth =8760 @@ -2686,9 +2528,7 @@ Begin Form Left =5880 Top =4380 Width =3120 - BorderColor =10921638 Name ="Line206" - GridlineColor =10921638 LayoutCachedLeft =5880 LayoutCachedTop =4380 LayoutCachedWidth =9000 @@ -2707,12 +2547,9 @@ Begin Form Width =2820 Height =315 TabIndex =5 - BorderColor =10921638 - ForeColor =4138256 Name ="cboMergeConflicts" RowSourceType ="Value List" RowSource ="\"Cancel Merge\";\"Skip Object\";\"Overwrite\"" - GridlineColor =10921638 AllowValueListEdits =0 LayoutCachedLeft =1200 @@ -2726,11 +2563,9 @@ Begin Form Top =4020 Width =2310 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label208" Caption ="Merge Conflict Handling" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =4020 LayoutCachedWidth =3510 @@ -2746,11 +2581,9 @@ Begin Form Top =3660 Width =2760 Height =600 - BorderColor =8355711 ForeColor =5324600 Name ="Label209" Caption ="Use slower deep inspection for the following items:" - GridlineColor =10921638 LayoutCachedLeft =6120 LayoutCachedTop =3660 LayoutCachedWidth =8880 @@ -2766,10 +2599,7 @@ Begin Form Width =2040 Height =315 TabIndex =6 - BorderColor =10921638 - ForeColor =4210752 Name ="txtRunBeforeMerge" - GridlineColor =10921638 LayoutCachedLeft =3120 LayoutCachedTop =5040 @@ -2782,11 +2612,9 @@ Begin Form Top =5040 Width =1800 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label211" Caption ="Run Before Merge:" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =5040 LayoutCachedWidth =3000 @@ -2804,10 +2632,7 @@ Begin Form Width =2040 Height =315 TabIndex =7 - BorderColor =10921638 - ForeColor =4210752 Name ="txtRunAfterMerge" - GridlineColor =10921638 LayoutCachedLeft =3120 LayoutCachedTop =5460 @@ -2820,11 +2645,9 @@ Begin Form Top =5460 Width =1815 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label213" Caption ="Run After Merge:" - GridlineColor =10921638 LayoutCachedLeft =1200 LayoutCachedTop =5460 LayoutCachedWidth =3015 @@ -2841,15 +2664,13 @@ Begin Form Left =615 Top =1980 Width =8850 - Height =4185 - BorderColor =10921638 + Height =4200 Name ="pgeSettings" Caption ="Settings" - GridlineColor =10921638 LayoutCachedLeft =615 LayoutCachedTop =1980 LayoutCachedWidth =9465 - LayoutCachedHeight =6165 + LayoutCachedHeight =6180 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 @@ -2861,7 +2682,6 @@ Begin Form Top =2640 Width =2160 Height =420 - ForeColor =4210752 Name ="cmdSaveAsDefault" Caption =" Save as Default" OnClick ="[Event Procedure]" @@ -2869,7 +2689,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000000000000000000000 , @@ -2924,8 +2743,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =9 @@ -2937,11 +2754,9 @@ Begin Form Top =2700 Width =4500 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label53" Caption ="Save these settings as default for new projects." - GridlineColor =10921638 LayoutCachedLeft =3900 LayoutCachedTop =2700 LayoutCachedWidth =8400 @@ -2958,7 +2773,6 @@ Begin Form Width =2160 Height =420 TabIndex =1 - ForeColor =4210752 Name ="cmdRestoreDefaults" Caption =" Restore Defaults" OnClick ="[Event Procedure]" @@ -2966,7 +2780,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000000000000000000000 , @@ -3021,8 +2834,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =9 @@ -3034,11 +2845,9 @@ Begin Form Top =3300 Width =4500 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label57" Caption ="Apply system defaults to this project." - GridlineColor =10921638 LayoutCachedLeft =3900 LayoutCachedTop =3300 LayoutCachedWidth =8400 @@ -3055,7 +2864,6 @@ Begin Form Width =2160 Height =420 TabIndex =2 - ForeColor =4210752 Name ="cmdClearDefaults" Caption =" Clear Defaults" OnClick ="[Event Procedure]" @@ -3063,7 +2871,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000000000000000000000 , @@ -3118,8 +2925,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =9 @@ -3131,11 +2936,9 @@ Begin Form Top =3840 Width =4500 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label59" Caption ="Reset all default settings to original values." - GridlineColor =10921638 LayoutCachedLeft =3900 LayoutCachedTop =3840 LayoutCachedWidth =8400 @@ -3152,9 +2955,7 @@ Begin Form Width =8160 Height =2220 TabIndex =3 - BorderColor =10921638 Name ="Frame62" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedLeft =960 @@ -3170,11 +2971,9 @@ Begin Form Width =1620 Height =315 BackColor =15130848 - BorderColor =8355711 ForeColor =5324600 Name ="Label63" Caption =" System Defaults" - GridlineColor =10921638 LayoutCachedLeft =1080 LayoutCachedTop =2100 LayoutCachedWidth =2700 @@ -3192,9 +2991,7 @@ Begin Form Width =8160 Height =1200 TabIndex =4 - BorderColor =10921638 Name ="Frame65" - GridlineColor =10921638 HorizontalAnchor =2 LayoutCachedLeft =960 @@ -3210,11 +3007,9 @@ Begin Form Width =1620 Height =315 BackColor =15130848 - BorderColor =8355711 ForeColor =5324600 Name ="Label66" Caption =" Remove Add-In" - GridlineColor =10921638 LayoutCachedLeft =1080 LayoutCachedTop =4680 LayoutCachedWidth =2700 @@ -3232,7 +3027,6 @@ Begin Form Width =2160 Height =420 TabIndex =5 - ForeColor =4210752 Name ="cmdUninstall" Caption =" Uninstall" OnClick ="[Event Procedure]" @@ -3240,7 +3034,6 @@ Begin Form TopPadding =135 RightPadding =150 BottomPadding =150 - GridlineColor =10921638 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000003255d6273255d68d , @@ -3295,8 +3088,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =9 WebImagePaddingTop =9 WebImagePaddingRight =9 @@ -3308,11 +3099,9 @@ Begin Form Top =5340 Width =4500 Height =315 - BorderColor =8355711 ForeColor =5324600 Name ="Label108" Caption ="Uninstall this add-in" - GridlineColor =10921638 LayoutCachedLeft =3900 LayoutCachedTop =5340 LayoutCachedWidth =8400 @@ -3333,11 +3122,9 @@ Begin Form Top =1260 Width =1560 TabIndex =3 - ForeColor =16711680 Name ="cmdSeeDocs" Caption ="See Docs..." HyperlinkAddress ="https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Documentation" - GridlineColor =10921638 HorizontalAnchor =1 ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , @@ -3398,8 +3185,6 @@ Begin Form PressedColor =13072231 PressedThemeColorIndex =-1 PressedShade =100.0 - HoverForeColor =4210752 - PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 @@ -3413,11 +3198,8 @@ Begin Form Width =3375 Height =240 FontSize =10 - BorderColor =8355711 - ForeColor =8355711 Name ="Label32" Caption ="joyfullservice/msaccess-vcs-integration" - GridlineColor =10921638 VerticalAnchor =1 LayoutCachedLeft =240 LayoutCachedTop =6660 @@ -3439,11 +3221,8 @@ Begin Form Width =2040 FontSize =10 TabIndex =4 - BorderColor =8355711 - ForeColor =16777215 Name ="Label45" ControlSource ="=GetVCSVersion()" - GridlineColor =10921638 HorizontalAnchor =1 LayoutCachedLeft =7140 @@ -3464,7 +3243,6 @@ Begin Form Top =6240 Width =300 Name ="Line76" - GridlineColor =10921638 LayoutCachedLeft =9540 LayoutCachedTop =6240 LayoutCachedWidth =9840 @@ -3479,7 +3257,6 @@ Begin Form Width =0 Height =240 Name ="Line77" - GridlineColor =10921638 LayoutCachedLeft =540 LayoutCachedTop =6240 LayoutCachedWidth =540 @@ -3842,6 +3619,14 @@ End Sub ' Private Sub cmdSaveAndClose_Click() + ' Make sure we actually have a file open + If Not DatabaseOpen Then + MsgBox2 "No Database File Open", _ + "You must have a database file open to save VCS options to a source folder.", _ + "Please open a database file before saving options for a project.", vbExclamation + Exit Sub + End If + ' Save options and close. MapControlsToOptions emaFormToClass Options.SaveOptionsForProject @@ -3861,8 +3646,26 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Sub cmdSaveAsDefault_Click() + + Dim strPath As String + + ' Note that we can't save an absolute path as default, or we will potentially + ' create some major issues with source files being overwritten and lost. + strPath = Nz(txtExportFolder) + If strPath <> vbNullString Then + If InStr(1, strPath, "%dbName%", vbTextCompare) < 1 Then + MsgBox2 "Invalid Export Path for Default", _ + "If you specify an absolute or relative Export Path as a default option," & vbCrLf & _ + "you must include the %dbName% placeholder to keep the paths unique.", _ + "Please update the Export Path and try again.", vbExclamation + Exit Sub + End If + End If + + ' Load the options from the form and save as default MapControlsToOptions emaFormToClass Options.SaveOptionsAsDefault + End Sub @@ -3891,6 +3694,7 @@ End Sub Private Sub Form_Load() Dim intFormat As eTableDataExportFormat + Dim intSanitizeLevel As eSanitizeLevel MapControlsToOptions emaClassToForm RefreshTableDisplay @@ -3904,6 +3708,22 @@ Private Sub Form_Load() Next intFormat End With + ' Load general sanitize options + With Me.cboSanitizeLevel + .RowSource = vbNullString + For intSanitizeLevel = 0 To (eSanitizeLevel.[_Last] - 1) + .AddItem intSanitizeLevel & "," & Options.GetSanitizeLevelName(intSanitizeLevel) + Next intSanitizeLevel + End With + + ' Load color sanitize options + With Me.cboSanitizeColors + .RowSource = vbNullString + For intSanitizeLevel = 0 To (eSanitizeLevel.[_Last] - 1) + .AddItem intSanitizeLevel & "," & Options.GetSanitizeLevelName(intSanitizeLevel) + Next intSanitizeLevel + End With + End Sub @@ -3974,6 +3794,7 @@ Private Sub MapControlsToOptions(eAction As eMapAction) ElseIf eAction = emaFormToClass Then ' Save list of tables to export data Set dTables = New Dictionary + dTables.CompareMode = TextCompare For Each varItem In m_colTables If varItem(etcType) <> vbNullString Then Set dTable = New Dictionary @@ -4068,3 +3889,30 @@ Private Sub cmdUninstall_Click() DoCmd.Quit End If End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : txtExportFolder_BeforeUpdate +' Author : Adam Waller +' Date : 5/6/2021 +' Purpose : Make sure we have a valid entry, blank, absolute path, or relative path. +'--------------------------------------------------------------------------------------- +' +Private Sub txtExportFolder_BeforeUpdate(Cancel As Integer) + + Dim strPath As String + + strPath = Nz(txtExportFolder) + If strPath <> vbNullString Then + If (Left(strPath, 1) = PathSep) Or _ + (InStr(2, strPath, ":" & PathSep) > 0) Then + ' Looks like a valid path + Else + MsgBox2 "Invalid Export Folder", _ + "This does not appear to be a valid relative or absolute path.", _ + "Please see the wiki documentation for more detail and examples.", vbExclamation + Cancel = True + End If + End If + +End Sub diff --git a/Version Control.accda.src/modules/IDbComponent.bas b/Version Control.accda.src/modules/IDbComponent.cls similarity index 98% rename from Version Control.accda.src/modules/IDbComponent.bas rename to Version Control.accda.src/modules/IDbComponent.cls index 00d2338d..7638ac8b 100644 --- a/Version Control.accda.src/modules/IDbComponent.bas +++ b/Version Control.accda.src/modules/IDbComponent.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "IDbComponent" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -220,4 +225,4 @@ End Property '--------------------------------------------------------------------------------------- ' Public Sub Upgrade() -End Sub \ No newline at end of file +End Sub diff --git a/Version Control.accda.src/modules/clsAdpFunction.bas b/Version Control.accda.src/modules/clsAdpFunction.cls similarity index 99% rename from Version Control.accda.src/modules/clsAdpFunction.bas rename to Version Control.accda.src/modules/clsAdpFunction.cls index bc7c1a0c..10516903 100644 --- a/Version Control.accda.src/modules/clsAdpFunction.bas +++ b/Version Control.accda.src/modules/clsAdpFunction.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsAdpFunction" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -285,4 +290,4 @@ End Sub ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsAdpProcedure.bas b/Version Control.accda.src/modules/clsAdpProcedure.cls similarity index 99% rename from Version Control.accda.src/modules/clsAdpProcedure.bas rename to Version Control.accda.src/modules/clsAdpProcedure.cls index 2e78f937..d250a6e2 100644 --- a/Version Control.accda.src/modules/clsAdpProcedure.bas +++ b/Version Control.accda.src/modules/clsAdpProcedure.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsAdpProcedure" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -287,4 +292,4 @@ End Sub ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsAdpServerView.bas b/Version Control.accda.src/modules/clsAdpServerView.cls similarity index 99% rename from Version Control.accda.src/modules/clsAdpServerView.bas rename to Version Control.accda.src/modules/clsAdpServerView.cls index c5551211..dbdb2b32 100644 --- a/Version Control.accda.src/modules/clsAdpServerView.bas +++ b/Version Control.accda.src/modules/clsAdpServerView.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsAdpServerView" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -287,4 +292,4 @@ End Sub ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsAdpTable.bas b/Version Control.accda.src/modules/clsAdpTable.cls similarity index 99% rename from Version Control.accda.src/modules/clsAdpTable.bas rename to Version Control.accda.src/modules/clsAdpTable.cls index 50d09e64..26c2da91 100644 --- a/Version Control.accda.src/modules/clsAdpTable.bas +++ b/Version Control.accda.src/modules/clsAdpTable.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsAdpTable" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -323,4 +328,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsAdpTrigger.bas b/Version Control.accda.src/modules/clsAdpTrigger.cls similarity index 99% rename from Version Control.accda.src/modules/clsAdpTrigger.bas rename to Version Control.accda.src/modules/clsAdpTrigger.cls index c5549660..29c6efec 100644 --- a/Version Control.accda.src/modules/clsAdpTrigger.bas +++ b/Version Control.accda.src/modules/clsAdpTrigger.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsAdpTrigger" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -302,4 +307,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsConcat.bas b/Version Control.accda.src/modules/clsConcat.cls similarity index 98% rename from Version Control.accda.src/modules/clsConcat.bas rename to Version Control.accda.src/modules/clsConcat.cls index 4e2175a4..4e644395 100644 --- a/Version Control.accda.src/modules/clsConcat.bas +++ b/Version Control.accda.src/modules/clsConcat.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsConcat" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -151,6 +156,8 @@ End Sub ' Returns the accumulated string Public Function GetStr() As String +Attribute GetStr.VB_Description = "Returns the concatenated string." +Attribute GetStr.VB_UserMemId = 0 Dim lngCnt As Long @@ -315,4 +322,5 @@ Public Sub SelfTest() .Add "0A" Debug.Assert .GetStr = "1234567890A" End With -End Sub \ No newline at end of file +End Sub + diff --git a/Version Control.accda.src/modules/clsDbDocument.bas b/Version Control.accda.src/modules/clsDbDocument.cls similarity index 97% rename from Version Control.accda.src/modules/clsDbDocument.bas rename to Version Control.accda.src/modules/clsDbDocument.cls index 1ab25f5d..def853ee 100644 --- a/Version Control.accda.src/modules/clsDbDocument.bas +++ b/Version Control.accda.src/modules/clsDbDocument.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbDocument" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -12,6 +17,8 @@ Attribute VB_Exposed = False Option Compare Database Option Explicit +Private Const ModuleName As String = "clsDbDocument" + Private m_AllItems As Collection Public m_dItems As Dictionary Private m_Count As Long @@ -56,6 +63,8 @@ Private Sub IDbComponent_Import(strFile As String) ' Only import files with the correct extension. If Not strFile Like "*.json" Then Exit Sub + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + Set dFile = ReadJsonFile(strFile) If Not dFile Is Nothing Then ClearDatabaseSummaryProperties @@ -68,6 +77,7 @@ Private Sub IDbComponent_Import(strFile As String) For Each varProp In dDoc.Keys ' Attempt to add or update the property value on the object. SetDAOProperty dbs.Containers(varCont).Documents(varDoc), dbText, CStr(varProp), dDoc(varProp) + CatchAny eelError, "Error setting document property " & varCont & "." & varDoc & "." & varProp, ModuleName Next varProp Next varDoc Next varCont @@ -387,4 +397,5 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property + diff --git a/Version Control.accda.src/modules/clsDbForm.bas b/Version Control.accda.src/modules/clsDbForm.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbForm.bas rename to Version Control.accda.src/modules/clsDbForm.cls index cad0eb8e..7c0e64f6 100644 --- a/Version Control.accda.src/modules/clsDbForm.bas +++ b/Version Control.accda.src/modules/clsDbForm.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbForm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -306,4 +311,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbHiddenAttribute.bas b/Version Control.accda.src/modules/clsDbHiddenAttribute.cls similarity index 97% rename from Version Control.accda.src/modules/clsDbHiddenAttribute.bas rename to Version Control.accda.src/modules/clsDbHiddenAttribute.cls index a8b99236..e824ff31 100644 --- a/Version Control.accda.src/modules/clsDbHiddenAttribute.bas +++ b/Version Control.accda.src/modules/clsDbHiddenAttribute.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbHiddenAttribute" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -12,6 +17,8 @@ Attribute VB_Exposed = False Option Compare Database Option Explicit +Private Const ModuleName As String = "clsDbHiddenAttribute" + Private m_AllItems As Collection Public m_dItems As Dictionary Private m_Count As Long @@ -54,6 +61,8 @@ Private Sub IDbComponent_Import(strFile As String) ' Only import files with the correct extension. If Not strFile Like "*.json" Then Exit Sub + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + Set dFile = ReadJsonFile(strFile) If Not dFile Is Nothing Then Set dbs = CurrentDb @@ -64,11 +73,12 @@ Private Sub IDbComponent_Import(strFile As String) For Each varDoc In dItems(varCont) ' Set object to hidden Application.SetHiddenAttribute objType, varDoc, True + CatchAny eelError, "Error setting hidden attribute for " & varDoc, ModuleName Next varDoc End If Next varCont End If - + End Sub @@ -363,4 +373,5 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property + diff --git a/Version Control.accda.src/modules/clsDbImexSpec.bas b/Version Control.accda.src/modules/clsDbImexSpec.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbImexSpec.bas rename to Version Control.accda.src/modules/clsDbImexSpec.cls index 6d29d00b..4d250443 100644 --- a/Version Control.accda.src/modules/clsDbImexSpec.bas +++ b/Version Control.accda.src/modules/clsDbImexSpec.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbImexSpec" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -424,4 +429,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbMacro.bas b/Version Control.accda.src/modules/clsDbMacro.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbMacro.bas rename to Version Control.accda.src/modules/clsDbMacro.cls index ec344b8d..da51ee3c 100644 --- a/Version Control.accda.src/modules/clsDbMacro.bas +++ b/Version Control.accda.src/modules/clsDbMacro.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbMacro" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -291,4 +296,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbModule.bas b/Version Control.accda.src/modules/clsDbModule.cls similarity index 56% rename from Version Control.accda.src/modules/clsDbModule.bas rename to Version Control.accda.src/modules/clsDbModule.cls index 6777cad5..7817de07 100644 --- a/Version Control.accda.src/modules/clsDbModule.bas +++ b/Version Control.accda.src/modules/clsDbModule.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbModule" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -12,10 +17,17 @@ Attribute VB_Exposed = False Option Compare Database Option Explicit -Private m_Module As AccessObject +Private Const ModuleName As String = "clsDbModule" + +Private m_Module As VBComponent Private m_AllItems As Collection Private m_blnModifiedOnly As Boolean +Private Type udtVbaFileContent + strContent As String + blnIsClass As Boolean +End Type + ' This requires us to use all the public methods and properties of the implemented class ' which keeps all the component classes consistent in how they are used in the export ' and import process. The implemented functions should be kept private as they are called @@ -31,8 +43,25 @@ Implements IDbComponent '--------------------------------------------------------------------------------------- ' Private Sub IDbComponent_Export() - SaveComponentAsText acModule, m_Module.Name, IDbComponent_SourceFile - VCSIndex.Update Me, eatExport, GetCodeModuleHash(IDbComponent_ComponentType, m_Module.Name) + + Dim strTempFile As String + Dim strExt As String + Dim strAlternateFile As String + + ' Export to temp file and convert to UTF-8 encoding + strTempFile = GetTempFile + ExportVbComponent strTempFile + ConvertAnsiUtf8 strTempFile, IDbComponent_SourceFile + + ' Remove any file with the same name but alternate extension + strExt = IIf(GetExtension = ".bas", ".cls", ".bas") + strAlternateFile = IDbComponent_BaseFolder & GetSafeFileName(m_Module.Name) & strExt + If FSO.FileExists(strAlternateFile) Then DeleteFile strAlternateFile + + ' Update the index with the current VBA hash. (Note, this will not show + ' changes to the hidden VBE properties that might have been added.) + VCSIndex.Update Me, eatExport, GetCodeModuleHash(edbModule, m_Module.Name) + End Sub @@ -46,18 +75,199 @@ End Sub Private Sub IDbComponent_Import(strFile As String) Dim strName As String + Dim strTempFile As String + Dim udtFile As udtVbaFileContent - ' Only import files with the correct extension. - If Not strFile Like "*.bas" Then Exit Sub - + ' Only import files with the correct extension. + If Not (strFile Like "*.bas" Or strFile Like "*.cls") Then Exit Sub + + ' Parse source file strName = GetObjectNameFromFileName(strFile) - LoadComponentFromText acModule, strName, strFile - Set m_Module = CurrentProject.AllModules(strName) - VCSIndex.Update Me, eatImport, GetCodeModuleHash(IDbComponent_ComponentType, strName) + udtFile = ParseSourceFile(strFile, strName) + + ' Check to see if we have an Access object with this name + If Not ModuleExists(strName) Then ImportModuleStub strName, udtFile.blnIsClass + + ' Write to a new file using system encoding (converting from UTF-8) + strTempFile = GetTempFile + WriteFile udtFile.strContent, strTempFile, GetSystemEncoding + + ' Import the source file to the code module + LoadVbeModuleFromFile strTempFile, strName + + ' Save hash, update the index, and remove the temp file + VCSIndex.Update Me, eatImport, GetCodeModuleHash(IDbComponent_ComponentType, m_Module.Name) + DeleteFile strTempFile + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : ParseSourceFile +' Author : Adam Waller +' Date : 7/13/2021 +' Purpose : Parse the source file to build VBE content +'--------------------------------------------------------------------------------------- +' +Private Function ParseSourceFile(strFile As String, strName As String) As udtVbaFileContent + + Dim strLines() As String + Dim strTLine As String + Dim lngLine As Long + Dim cData As clsConcat + Dim blnIsClass As Boolean + Dim blnHasHeader As Boolean + + Perf.OperationStart "Parse VBA Module" + + ' Read file contents into array of lines + strLines = Split(ReadFile(strFile), vbCrLf) + + ' Loop through first several lines to determine type and header + For lngLine = 0 To UBound(strLines) + If strLines(lngLine) = "VERSION 1.0 CLASS" Then + ' Class with VBE header + blnIsClass = True + blnHasHeader = True + Exit For + ElseIf StartsWith(strLines(lngLine), "Attribute VB_Name = """) Then + ' Module with VBE header + blnHasHeader = True + Exit For + ElseIf StartsWith(strLines(lngLine), "Attribute VB_GlobalNameSpace = ") Then + ' Class with no header + blnIsClass = True + Exit For + End If + ' Exit after 10 lines + If lngLine > 8 Then Exit For + Next lngLine + + ' Use concatenation class to build file contents + Set cData = New clsConcat + With cData + .AppendOnAdd = vbCrLf + + ' Build header, if needed + If Not blnHasHeader Then + If blnIsClass Then + .Add "VERSION 1.0 CLASS" + .Add "BEGIN" + .Add " MultiUse = -1 'True" + .Add "END" + End If + .Add "Attribute VB_Name = """, strName, """" + End If + + ' Add in file contents + For lngLine = 0 To UBound(strLines) + .Add strLines(lngLine) + Next lngLine + + ' Remove trailing vbCrLf + .Remove 2 + End With + + ' Return values + With ParseSourceFile + .blnIsClass = blnIsClass + .strContent = cData.GetStr + End With + + Perf.OperationEnd + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : LoadVbeModuleFromFile +' Author : Adam Waller +' Date : 7/12/2021 +' Purpose : Load the VBA standard/class module from a file through VBE. (This allows +' : us to preserve hidden attributes not recognized in then LoadFromText +' : import of code modules and classes.) +'--------------------------------------------------------------------------------------- +' +Private Sub LoadVbeModuleFromFile(strFile As String, strName As String) + + Dim proj As VBProject + + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + + Set proj = GetVBProjectForCurrentDB + Perf.OperationStart "Import VBE Module" + With proj.VBComponents + + ' Remove any existing component (In most cases the module will exist) + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next + .Remove .Item(strName) + If DebugMode(False) Then On Error GoTo 0 Else On Error Resume Next + + ' Load from the file + Set m_Module = .Import(strFile) + End With + Perf.OperationEnd + + CatchAny eelError, "Error importing VBA code for " & strName, ModuleName & ".LoadVbeModuleFromFile" + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : ImportModuleStub +' Author : Adam Waller +' Date : 7/12/2021 +' Purpose : Import a blank code module as text so it can be loaded into Access before +' : overlaying the content through VBE. (This allows us to use DoCmd.Save to +' : save the code changes, which is not available when a new module is created +' : through a VBE import. +'--------------------------------------------------------------------------------------- +' +Private Sub ImportModuleStub(strName As String, blnAsClass As Boolean) + + Dim cContent As clsConcat + Dim strTempFile As String + + Set cContent = New clsConcat + + ' Save the template content as a file + strTempFile = GetTempFile + With New clsConcat + .AppendOnAdd = vbCrLf + If blnAsClass Then + .Add "Attribute VB_GlobalNameSpace = False" + .Add "Attribute VB_Creatable = False" + .Add "Attribute VB_PredeclaredId = False" + .Add "Attribute VB_Exposed = False" + End If + .Add "' Stub module for import by MSAccessVCS" + .Add "noncompilingcode 'issue here" + ' Load as text without BOM + WriteFile .GetStr, strTempFile, "Windows-1252" + End With + + LoadFromText acModule, strName, strTempFile + DeleteFile strTempFile End Sub +'--------------------------------------------------------------------------------------- +' Procedure : ModuleExists +' Author : Adam Waller +' Date : 7/13/2021 +' Purpose : Returns true if the module or class exists in the current database +'--------------------------------------------------------------------------------------- +' +Private Function ModuleExists(strName As String) As Boolean + Dim objTest As AccessObject + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next + Set objTest = CurrentProject.AllModules(strName) + CatchAny eelNoError, vbNullString, , False + ModuleExists = Not objTest Is Nothing +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : Merge ' Author : Adam Waller @@ -76,6 +286,20 @@ Private Sub IDbComponent_Merge(strFile As String) End Sub +'--------------------------------------------------------------------------------------- +' Procedure : ExportVbComponent +' Author : Adam Waller +' Date : 5/26/2021 +' Purpose : Export the code module VB component +'--------------------------------------------------------------------------------------- +' +Private Sub ExportVbComponent(strFile As String) + Perf.OperationStart "Export VBE Module" + m_Module.Export strFile + Perf.OperationEnd +End Sub + + '--------------------------------------------------------------------------------------- ' Procedure : GetAllFromDB ' Author : Adam Waller @@ -84,17 +308,19 @@ End Sub '--------------------------------------------------------------------------------------- ' Private Function IDbComponent_GetAllFromDB(Optional blnModifiedOnly As Boolean = False) As Collection - + Dim oMod As AccessObject Dim cModule As IDbComponent + Dim proj As VBProject ' Build collection if not already cached If m_AllItems Is Nothing Or blnModifiedOnly <> m_blnModifiedOnly Then m_blnModifiedOnly = blnModifiedOnly Set m_AllItems = New Collection + Set proj = GetVBProjectForCurrentDB For Each oMod In CurrentProject.AllModules Set cModule = New clsDbModule - Set cModule.DbObject = oMod + Set cModule.DbObject = proj.VBComponents(oMod.Name) If blnModifiedOnly Then If cModule.IsModified Then m_AllItems.Add cModule, oMod.Name Else @@ -118,6 +344,7 @@ End Function ' Private Function IDbComponent_GetFileList(Optional blnModifiedOnly As Boolean = False) As Collection Set IDbComponent_GetFileList = GetFilePathsInFolder(IDbComponent_BaseFolder, "*.bas") + MergeCollection IDbComponent_GetFileList, GetFilePathsInFolder(IDbComponent_BaseFolder, "*.cls") End Function @@ -129,7 +356,7 @@ End Function '--------------------------------------------------------------------------------------- ' Private Sub IDbComponent_ClearOrphanedSourceFiles() - ClearOrphanedSourceFiles Me, "bas" + ClearOrphanedSourceFiles Me, "bas", "cls" End Sub @@ -142,9 +369,11 @@ End Sub '--------------------------------------------------------------------------------------- ' Public Function IDbComponent_IsModified() As Boolean - + ' The modified date for the object changes frequently with compile/save operations, ' so use the hash instead to detect changes. + + ' NOTE: This will not detect changes to hidden VBE attributes IDbComponent_IsModified = VCSIndex.Item(Me)("Hash") <> GetCodeModuleHash(IDbComponent_ComponentType, m_Module.Name) End Function @@ -160,7 +389,7 @@ End Function '--------------------------------------------------------------------------------------- ' Private Function IDbComponent_DateModified() As Date - IDbComponent_DateModified = m_Module.DateModified + IDbComponent_DateModified = CurrentProject.AllModules(m_Module.Name).DateModified End Function @@ -222,10 +451,26 @@ End Property '--------------------------------------------------------------------------------------- ' Private Property Get IDbComponent_SourceFile() As String - IDbComponent_SourceFile = IDbComponent_BaseFolder & GetSafeFileName(m_Module.Name) & ".bas" + IDbComponent_SourceFile = IDbComponent_BaseFolder & GetSafeFileName(m_Module.Name) & GetExtension End Property +'--------------------------------------------------------------------------------------- +' Procedure : GetExtension +' Author : Adam Waller +' Date : 6/4/2021 +' Purpose : Return the extension (".cls" or ".bas") based on the component type. +'--------------------------------------------------------------------------------------- +' +Private Function GetExtension() As String + If m_Module.Type = vbext_ct_StdModule Then + GetExtension = ".bas" + Else + GetExtension = ".cls" + End If +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : Count ' Author : Adam Waller @@ -301,4 +546,5 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property + diff --git a/Version Control.accda.src/modules/clsDbNavPaneGroup.bas b/Version Control.accda.src/modules/clsDbNavPaneGroup.cls similarity index 98% rename from Version Control.accda.src/modules/clsDbNavPaneGroup.bas rename to Version Control.accda.src/modules/clsDbNavPaneGroup.cls index 0049b28f..25846feb 100644 --- a/Version Control.accda.src/modules/clsDbNavPaneGroup.bas +++ b/Version Control.accda.src/modules/clsDbNavPaneGroup.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbNavPaneGroup" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -144,7 +149,7 @@ Private Sub ClearExistingNavGroups() Dim rst As DAO.Recordset Dim strSql As String - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Get SQL for query of NavPaneGroup objects Set dbs = CodeDb @@ -491,7 +496,7 @@ Private Sub IDbComponent_Upgrade() Dim colNew As Collection Dim dblVersion As Double - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Get version If Not m_dItems Is Nothing Then @@ -567,4 +572,5 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property + diff --git a/Version Control.accda.src/modules/clsDbProjProperty.bas b/Version Control.accda.src/modules/clsDbProjProperty.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbProjProperty.bas rename to Version Control.accda.src/modules/clsDbProjProperty.cls index 7b967c4a..2d70415b 100644 --- a/Version Control.accda.src/modules/clsDbProjProperty.bas +++ b/Version Control.accda.src/modules/clsDbProjProperty.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbProjProperty" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -354,4 +359,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbVbeProject.bas b/Version Control.accda.src/modules/clsDbProject.cls similarity index 82% rename from Version Control.accda.src/modules/clsDbVbeProject.bas rename to Version Control.accda.src/modules/clsDbProject.cls index 8bfbef90..96408cdf 100644 --- a/Version Control.accda.src/modules/clsDbVbeProject.bas +++ b/Version Control.accda.src/modules/clsDbProject.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbProject" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -12,9 +17,9 @@ Attribute VB_Exposed = False Option Compare Database Option Explicit -Private Const ModuleName As String = "clsDbVbeProject" +Private Const ModuleName As String = "clsDbProject" -Private m_Project As VBIDE.VBProject +Private m_Project As CurrentProject Private m_AllItems As Collection ' This requires us to use all the public methods and properties of the implemented class @@ -27,7 +32,7 @@ Implements IDbComponent '--------------------------------------------------------------------------------------- ' Procedure : Export ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Export the individual database component (table, form, query, etc...) '--------------------------------------------------------------------------------------- ' @@ -38,7 +43,7 @@ Private Sub IDbComponent_Export() Set dProject = GetDictionary ' Save in JSON format. - WriteJsonFile TypeName(Me), dProject, IDbComponent_SourceFile, "VBE Project" + WriteJsonFile TypeName(Me), dProject, IDbComponent_SourceFile, "Project" ' Save to index VCSIndex.Update Me, eatExport, GetDictionaryHash(dProject) @@ -49,43 +54,28 @@ End Sub '--------------------------------------------------------------------------------------- ' Procedure : Import ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Import the individual database component from a file. '--------------------------------------------------------------------------------------- ' Private Sub IDbComponent_Import(strFile As String) Dim dProject As Dictionary - Dim strValue As String - + Dim proj As CurrentProject + + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + ' Only import files with the correct extension. If Not strFile Like "*.json" Then Exit Sub - - ' Update project properties Set dProject = ReadJsonFile(strFile) - Set m_Project = GetVBProjectForCurrentDB - With m_Project - .Name = dNZ(dProject, "Items\Name") - .Description = dNZ(dProject, "Items\Description") - - ' Setting the HelpContextId can throw random automation errors. - ' The setting does change despite the error. - strValue = dNZ(dProject, "Items\HelpContextId") - If DebugMode Then On Error Resume Next Else On Error Resume Next - .HelpContextId = strValue - ' If we failed to set the ID then it was a real error, throw it - If .HelpContextId <> strValue Then CatchAny eelError, "Failed to set help context" - strValue = dNZ(dProject, "Items\HelpFile") - .HelpFile = strValue - If .HelpFile <> strValue Then CatchAny eelError, "Failed to set help file" - ' // Read-only properties - '.FileName = dNZ(dProject, "Items\FileName") - '.Mode = dNZ(dProject, "Items\Mode") - '.Protection = dNZ(dProject, "Items\Protection") - '.Type = dNZ(dProject, "Items\Type") + Set proj = CurrentProject + + ' Update project properties (Only one we can really change) + With proj + .RemovePersonalInformation = Nz2(dNZ(dProject, "Items\RemovePersonalInformation"), False) End With - CatchAny eelError, "Importing VBE Project", ModuleName & ".Import" + CatchAny eelError, "Importing Project", ModuleName & ".Import" ' Save to index VCSIndex.Update Me, eatImport, GetDictionaryHash(GetDictionary) @@ -96,26 +86,25 @@ End Sub '--------------------------------------------------------------------------------------- ' Procedure : GetDictionary ' Author : Adam Waller -' Date : 12/1/2020 +' Date : 5/17/2021 ' Purpose : Return a dictionary object of project properties. '--------------------------------------------------------------------------------------- ' Private Function GetDictionary() As Dictionary ' Make sure we have a reference to the VB project - If m_Project Is Nothing Then Set m_Project = GetVBProjectForCurrentDB + If m_Project Is Nothing Then Set m_Project = CurrentProject ' Read project properties Set GetDictionary = New Dictionary With GetDictionary - .Add "Name", m_Project.Name - .Add "Description", m_Project.Description - .Add "FileName", GetRelativePath(m_Project.FileName) - .Add "HelpFile", m_Project.HelpFile - .Add "HelpContextId", m_Project.HelpContextId - .Add "Mode", m_Project.Mode - .Add "Protection", m_Project.Protection - .Add "Type", m_Project.Type + If m_Project.ProjectType = acADP Then + ' Only save the connection string for ADP projects + .Add "BaseConnectionString", m_Project.BaseConnectionString + End If + .Add "FileFormat", m_Project.FileFormat + .Add "RemovePersonalInformation", m_Project.RemovePersonalInformation + End With End Function @@ -124,7 +113,7 @@ End Function '--------------------------------------------------------------------------------------- ' Procedure : Merge ' Author : Adam Waller -' Date : 11/21/2020 +' Date : 5/17/2021 ' Purpose : Merge the source file into the existing database, updating or replacing ' : any existing object. '--------------------------------------------------------------------------------------- @@ -137,7 +126,7 @@ End Sub '--------------------------------------------------------------------------------------- ' Procedure : GetAllFromDB ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Return a collection of class objects represented by this component type. '--------------------------------------------------------------------------------------- ' @@ -148,9 +137,9 @@ Private Function IDbComponent_GetAllFromDB(Optional blnModifiedOnly As Boolean = ' Build collection if not already cached If m_AllItems Is Nothing Then ' Load class details - Set m_Project = GetVBProjectForCurrentDB + Set m_Project = CurrentProject Set m_AllItems = New Collection - Set cProj = New clsDbVbeProject + Set cProj = New clsDbProject Set cProj.DbObject = m_Project m_AllItems.Add cProj, m_Project.Name End If @@ -164,7 +153,7 @@ End Function '--------------------------------------------------------------------------------------- ' Procedure : GetFileList ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Return a list of file names to import for this component type. '--------------------------------------------------------------------------------------- ' @@ -177,7 +166,7 @@ End Function '--------------------------------------------------------------------------------------- ' Procedure : ClearOrphanedSourceFiles ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Remove any source files for objects not in the current database. '--------------------------------------------------------------------------------------- ' @@ -188,20 +177,19 @@ End Sub '--------------------------------------------------------------------------------------- ' Procedure : IsModified ' Author : Adam Waller -' Date : 11/21/2020 +' Date : 5/17/2021 ' Purpose : Returns true if the object in the database has been modified since ' : the last export of the object. '--------------------------------------------------------------------------------------- ' Public Function IDbComponent_IsModified() As Boolean - End Function '--------------------------------------------------------------------------------------- ' Procedure : DateModified ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : The date/time the object was modified. (If possible to retrieve) ' : If the modified date cannot be determined (such as application ' : properties) then this function will return 0. @@ -215,7 +203,7 @@ End Function '--------------------------------------------------------------------------------------- ' Procedure : SourceModified ' Author : Adam Waller -' Date : 4/27/2020 +' Date : 5/17/2021 ' Purpose : The date/time the source object was modified. In most cases, this would ' : be the date/time of the source file, but it some cases like SQL objects ' : the date can be determined through other means, so this function @@ -230,19 +218,19 @@ End Function '--------------------------------------------------------------------------------------- ' Procedure : Category ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Return a category name for this type. (I.e. forms, queries, macros) '--------------------------------------------------------------------------------------- ' Private Property Get IDbComponent_Category() As String - IDbComponent_Category = "VB Project" + IDbComponent_Category = "Project" End Property '--------------------------------------------------------------------------------------- ' Procedure : BaseFolder ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Return the base folder for import/export of this component. '--------------------------------------------------------------------------------------- Private Property Get IDbComponent_BaseFolder() As String @@ -253,7 +241,7 @@ End Property '--------------------------------------------------------------------------------------- ' Procedure : Name ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Return a name to reference the object for use in logs and screen output. '--------------------------------------------------------------------------------------- ' @@ -265,19 +253,19 @@ End Property '--------------------------------------------------------------------------------------- ' Procedure : SourceFile ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Return the full path of the source file for the current object. '--------------------------------------------------------------------------------------- ' Private Property Get IDbComponent_SourceFile() As String - IDbComponent_SourceFile = IDbComponent_BaseFolder & "vbe-project.json" + IDbComponent_SourceFile = IDbComponent_BaseFolder & "project.json" End Property '--------------------------------------------------------------------------------------- ' Procedure : Count ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Return a count of how many items are in this category. '--------------------------------------------------------------------------------------- ' @@ -289,19 +277,19 @@ End Property '--------------------------------------------------------------------------------------- ' Procedure : ComponentType ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : The type of component represented by this class. '--------------------------------------------------------------------------------------- ' Private Property Get IDbComponent_ComponentType() As eDatabaseComponentType - IDbComponent_ComponentType = edbVbeProject + IDbComponent_ComponentType = edbProject End Property '--------------------------------------------------------------------------------------- ' Procedure : Upgrade ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : Run any version specific upgrade processes before importing. '--------------------------------------------------------------------------------------- ' @@ -313,7 +301,7 @@ End Sub '--------------------------------------------------------------------------------------- ' Procedure : DbObject ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 5/17/2021 ' Purpose : This represents the database object we are dealing with. '--------------------------------------------------------------------------------------- ' @@ -328,7 +316,7 @@ End Property '--------------------------------------------------------------------------------------- ' Procedure : SingleFile ' Author : Adam Waller -' Date : 4/24/2020 +' Date : 5/17/2021 ' Purpose : Returns true if the export of all items is done as a single file instead ' : of individual files for each component. (I.e. properties, references) '--------------------------------------------------------------------------------------- @@ -341,7 +329,7 @@ End Property '--------------------------------------------------------------------------------------- ' Procedure : Class_Initialize ' Author : Adam Waller -' Date : 4/24/2020 +' Date : 5/17/2021 ' Purpose : Helps us know whether we have already counted the objects. '--------------------------------------------------------------------------------------- ' @@ -361,4 +349,4 @@ End Sub ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbProperty.bas b/Version Control.accda.src/modules/clsDbProperty.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbProperty.bas rename to Version Control.accda.src/modules/clsDbProperty.cls index 8e23cd94..c5d55b78 100644 --- a/Version Control.accda.src/modules/clsDbProperty.bas +++ b/Version Control.accda.src/modules/clsDbProperty.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbProperty" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -437,4 +442,4 @@ End Sub ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbQuery.bas b/Version Control.accda.src/modules/clsDbQuery.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbQuery.bas rename to Version Control.accda.src/modules/clsDbQuery.cls index d268161a..3d2e449e 100644 --- a/Version Control.accda.src/modules/clsDbQuery.bas +++ b/Version Control.accda.src/modules/clsDbQuery.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbQuery" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -338,4 +343,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbRelation.bas b/Version Control.accda.src/modules/clsDbRelation.cls similarity index 98% rename from Version Control.accda.src/modules/clsDbRelation.bas rename to Version Control.accda.src/modules/clsDbRelation.cls index e112ebac..60c4c137 100644 --- a/Version Control.accda.src/modules/clsDbRelation.bas +++ b/Version Control.accda.src/modules/clsDbRelation.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbRelation" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -116,7 +121,7 @@ Private Sub IDbComponent_Import(strFile As String) ' Relationships create indexes, so we need to make sure an index ' with this name doesn't already exist. (Also check to be sure that ' we don't already have a relationship with this name. - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next With dbs .TableDefs(rel.Table).Indexes.Delete rel.Name .TableDefs(rel.ForeignTable).Indexes.Delete rel.Name @@ -410,4 +415,5 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property + diff --git a/Version Control.accda.src/modules/clsDbReport.bas b/Version Control.accda.src/modules/clsDbReport.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbReport.bas rename to Version Control.accda.src/modules/clsDbReport.cls index 78865746..cba13906 100644 --- a/Version Control.accda.src/modules/clsDbReport.bas +++ b/Version Control.accda.src/modules/clsDbReport.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbReport" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -305,4 +310,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbSavedSpec.bas b/Version Control.accda.src/modules/clsDbSavedSpec.cls similarity index 98% rename from Version Control.accda.src/modules/clsDbSavedSpec.bas rename to Version Control.accda.src/modules/clsDbSavedSpec.cls index 85d7a237..6f7b06d2 100644 --- a/Version Control.accda.src/modules/clsDbSavedSpec.bas +++ b/Version Control.accda.src/modules/clsDbSavedSpec.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbSavedSpec" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -35,7 +40,7 @@ Private Sub IDbComponent_Export() Set dSpec = New Dictionary - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next ' For some reason it throws an error if there is no ' description in the specification. With dSpec @@ -322,4 +327,4 @@ End Sub ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbSharedImage.bas b/Version Control.accda.src/modules/clsDbSharedImage.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbSharedImage.bas rename to Version Control.accda.src/modules/clsDbSharedImage.cls index 34feb095..57b7e589 100644 --- a/Version Control.accda.src/modules/clsDbSharedImage.bas +++ b/Version Control.accda.src/modules/clsDbSharedImage.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbSharedImage" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -469,4 +474,4 @@ End Property ' Private Sub Class_Terminate() Set m_Dbs = Nothing -End Sub \ No newline at end of file +End Sub diff --git a/Version Control.accda.src/modules/clsDbTEMPLATE.bas b/Version Control.accda.src/modules/clsDbTEMPLATE.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbTEMPLATE.bas rename to Version Control.accda.src/modules/clsDbTEMPLATE.cls index 4551a3b9..2b88617e 100644 --- a/Version Control.accda.src/modules/clsDbTEMPLATE.bas +++ b/Version Control.accda.src/modules/clsDbTEMPLATE.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbTEMPLATE" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -295,4 +300,4 @@ Attribute VB_Exposed = False '' 'Public Property Get Parent() As IDbComponent ' Set Parent = Me -'End Property \ No newline at end of file +'End Property diff --git a/Version Control.accda.src/modules/clsDbTableData.bas b/Version Control.accda.src/modules/clsDbTableData.cls similarity index 93% rename from Version Control.accda.src/modules/clsDbTableData.bas rename to Version Control.accda.src/modules/clsDbTableData.cls index 08695b4a..0013d360 100644 --- a/Version Control.accda.src/modules/clsDbTableData.bas +++ b/Version Control.accda.src/modules/clsDbTableData.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbTableData" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -51,7 +56,7 @@ Private Sub IDbComponent_Export() Perf.OperationStart "App.ExportXML()" Application.ExportXML acExportTable, m_Table.Name, strFile Perf.OperationEnd - SanitizeXML strFile, Options + SanitizeXML strFile End Select End If Next intFormat @@ -92,8 +97,7 @@ Public Sub ExportTableDataAsTDF(strTable As String) intCnt = 0 For Each fld In rst.Fields ' Format for TDF format without line breaks - strText = MultiReplace(Nz(fld.Value), "\", "\\", vbCrLf, "\r\n", vbCr, "\r", vbLf, "\n", vbTab, "\t") - cData.Add strText + cData.Add FormatStringForTDF(Nz(fld.Value)) intCnt = intCnt + 1 If intCnt < intFields Then cData.Add vbTab Next fld @@ -181,8 +185,7 @@ Private Sub ImportTableDataTDF(strFile As String) End If Else ' Perform any needed replacements - strValue = MultiReplace(CStr(varLine(intCol)), _ - "\\", "\", "\r\n", vbCrLf, "\r", vbCr, "\n", vbLf, "\t", vbTab) + strValue = FormatStringFromTDF(CStr(varLine(intCol))) If strValue <> CStr(varLine(intCol)) Then ' Use replaced string value rst.Fields(varHeader(intCol)).Value = strValue @@ -206,6 +209,44 @@ Private Sub ImportTableDataTDF(strFile As String) End Sub +'--------------------------------------------------------------------------------------- +' Procedure : FormatStringForTDF +' Author : Adam Waller +' Date : 7/16/2021 +' Purpose : Replace line feeds and similar characters with escaped codes for +' : representation in tab-delimited format. +' : (Using Chr(26) as interim placeholder) See #251 +'--------------------------------------------------------------------------------------- +' +Private Function FormatStringForTDF(strValue As String) As String + FormatStringForTDF = MultiReplace(strValue, _ + "\", Chr$(26), _ + vbCrLf, "\r\n", _ + vbCr, "\r", _ + vbLf, "\n", _ + vbTab, "\t", _ + Chr$(26), "\\") +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : FormatStringFromTDF +' Author : Adam Waller +' Date : 7/16/2021 +' Purpose : Restore original characters from escaped codes. +'--------------------------------------------------------------------------------------- +' +Private Function FormatStringFromTDF(strTDFValue) As String + FormatStringFromTDF = MultiReplace(strTDFValue, _ + "\\", Chr$(26), _ + "\r\n", vbCrLf, _ + "\r", vbCr, _ + "\n", vbLf, _ + "\t", vbTab, _ + Chr$(26), "\") +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : GetTableExportSql ' Author : Adam Waller @@ -571,4 +612,5 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property + diff --git a/Version Control.accda.src/modules/clsDbTableDataMacro.bas b/Version Control.accda.src/modules/clsDbTableDataMacro.cls similarity index 99% rename from Version Control.accda.src/modules/clsDbTableDataMacro.bas rename to Version Control.accda.src/modules/clsDbTableDataMacro.cls index aa7a8c80..4ab3e66d 100644 --- a/Version Control.accda.src/modules/clsDbTableDataMacro.bas +++ b/Version Control.accda.src/modules/clsDbTableDataMacro.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbTableDataMacro" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -307,4 +312,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbTableDef.bas b/Version Control.accda.src/modules/clsDbTableDef.cls similarity index 91% rename from Version Control.accda.src/modules/clsDbTableDef.bas rename to Version Control.accda.src/modules/clsDbTableDef.cls index 7fc00e85..688ce867 100644 --- a/Version Control.accda.src/modules/clsDbTableDef.bas +++ b/Version Control.accda.src/modules/clsDbTableDef.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbTableDef" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -12,6 +17,8 @@ Attribute VB_Exposed = False Option Compare Database Option Explicit +Const ModuleName As String = "clsDbTableDef" + Private m_Table As DAO.TableDef Private m_AllItems As Collection Private m_blnModifiedOnly As Boolean @@ -46,14 +53,15 @@ Private Sub IDbComponent_Export() ' For internal tables, we can export them as XML. If tbl.Connect = vbNullString Then - ' Check for existing file - If FSO.FileExists(strFile) Then DeleteFile strFile, True - ' Save structure in XML format VerifyPath strFile Perf.OperationStart "App.ExportXML()" - Application.ExportXML acExportTable, m_Table.Name, , strFile ', , , , acExportAllTableAndFieldProperties ' Add support for this later. + ' Note that the additional properties are important to accurately reconstruct the table. + Application.ExportXML acExportTable, m_Table.Name, , strFile, , , , acExportAllTableAndFieldProperties Perf.OperationEnd + + ' Rewrite sanitized XML as formatted UTF-8 content + SanitizeXML strFile Else ' Linked table - Save as JSON @@ -300,7 +308,7 @@ Private Function IndexAvailable(tdf As TableDef) As Boolean Dim lngTest As Long - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next lngTest = tdf.Indexes.Count If Err Then Err.Clear @@ -329,7 +337,7 @@ Private Sub IDbComponent_Import(strFile As String) Select Case LCase$(FSO.GetExtensionName(strFile)) Case "json" - ImportLinkedTable strFile + If Not ImportLinkedTable(strFile) Then Exit Sub Case "xml" ' The ImportXML function does not properly handle UrlEncoded paths @@ -377,9 +385,10 @@ End Sub ' Author : Adam Waller ' Date : 5/6/2020 ' Purpose : Recreate a linked table from the JSON source file. +' : Returns true if successful. '--------------------------------------------------------------------------------------- ' -Private Sub ImportLinkedTable(strFile As String) +Private Function ImportLinkedTable(strFile As String) As Boolean Dim dTable As Dictionary Dim dItem As Dictionary @@ -388,6 +397,8 @@ Private Sub ImportLinkedTable(strFile As String) Dim strSql As String Dim strConnect As String + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + ' Read json file Set dTable = ReadJsonFile(strFile) If Not dTable Is Nothing Then @@ -403,30 +414,41 @@ Private Sub ImportLinkedTable(strFile As String) .Attributes = SafeAttributes(dItem("Attributes")) End With dbs.TableDefs.Append tdf - - ' Verify that the connection matches the source file. (Issue #192) - If tdf.Connect <> strConnect Then - tdf.Connect = strConnect - tdf.RefreshLink - End If - dbs.TableDefs.Refresh - - ' Set index on linked table. - If InStr(1, tdf.Connect, ";DATABASE=", vbTextCompare) = 1 Then - ' Can't create a key on a linked Access database table. - ' Presumably this would use the Access index instead of needing the pseudo index + If Catch(3011) Then + Log.Error eelError, "Could not link table '" & dItem("SourceTableName") & "'", _ + ModuleName & ".ImportLinkedTable" + Log.Add "Linked table object not found in " & strFile, False + Log.Add "Connection String: " & strConnect, False + ElseIf CatchAny(eelError, vbNullString, ModuleName & ".ImportLinkedTable") Then + ' May have encountered other issue like a missing link specification. Else - ' Check for a primary key index (Linked SQL tables may bring over the index, but linked views won't.) - If dItem.Exists("PrimaryKey") And Not HasUniqueIndex(tdf) Then - ' Create a pseudo index on the linked table - strSql = "CREATE UNIQUE INDEX __uniqueindex ON [" & tdf.Name & "] (" & dItem("PrimaryKey") & ") WITH PRIMARY" - dbs.Execute strSql, dbFailOnError - dbs.TableDefs.Refresh + ' Verify that the connection matches the source file. (Issue #192) + If tdf.Connect <> strConnect Then + tdf.Connect = strConnect + tdf.RefreshLink + End If + dbs.TableDefs.Refresh + + ' Set index on linked table. + If InStr(1, tdf.Connect, ";DATABASE=", vbTextCompare) = 1 Then + ' Can't create a key on a linked Access database table. + ' Presumably this would use the Access index instead of needing the pseudo index + Else + ' Check for a primary key index (Linked SQL tables may bring over the index, but linked views won't.) + If dItem.Exists("PrimaryKey") And Not HasUniqueIndex(tdf) Then + ' Create a pseudo index on the linked table + strSql = "CREATE UNIQUE INDEX __uniqueindex ON [" & tdf.Name & "] (" & dItem("PrimaryKey") & ") WITH PRIMARY" + dbs.Execute strSql, dbFailOnError + dbs.TableDefs.Refresh + End If End If End If End If - -End Sub + + ' Report any unhandled errors + CatchAny eelError, "Error importing " & strFile, ".ImportLinkedTable" + +End Function '--------------------------------------------------------------------------------------- @@ -723,4 +745,5 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property + diff --git a/Version Control.accda.src/modules/clsDbTheme.bas b/Version Control.accda.src/modules/clsDbTheme.cls similarity index 85% rename from Version Control.accda.src/modules/clsDbTheme.bas rename to Version Control.accda.src/modules/clsDbTheme.cls index 32c47055..c0343056 100644 --- a/Version Control.accda.src/modules/clsDbTheme.bas +++ b/Version Control.accda.src/modules/clsDbTheme.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbTheme" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -52,7 +57,7 @@ Private Sub IDbComponent_Export() Dim rstAtc As Recordset2 Dim strSql As String - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Query theme file details strSql = "SELECT [Data] FROM MSysResources WHERE [Name]='" & m_Name & "' AND Extension='" & m_Extension & "'" @@ -124,7 +129,7 @@ Private Sub IDbComponent_Import(strFile As String) Dim strSql As String Dim blnIsFolder As Boolean - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Are we dealing with a folder, or a file? blnIsFolder = (Right$(strFile, 5) <> ".thmx") @@ -158,7 +163,7 @@ Private Sub IDbComponent_Import(strFile As String) ' Create/edit record in resources table. strThemeName = GetObjectNameFromFileName(FSO.GetBaseName(strFile)) ' Make sure we have a resources table before we try to query the records. - If VerifyResourcesTable(True) Then + If VerifyResourcesTable Then strSql = "SELECT * FROM MSysResources WHERE [Type] = 'thmx' AND [Name]=""" & strThemeName & """" Set rstResources = CurrentDb.OpenRecordset(strSql, dbOpenDynaset) With rstResources @@ -277,29 +282,97 @@ End Function ' Purpose : Make sure the resources table exists, creating it if needed. '--------------------------------------------------------------------------------------- ' -Public Function VerifyResourcesTable(blnClearThemes As Boolean) As Boolean +Public Function VerifyResourcesTable() As Boolean + Dim blnExists As Boolean Dim strName As String + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + ' Make sure we actually have a resources table. - If Not TableExists("MSysResources") Then - ' It would be nice to find a magical system command for this, but for now - ' we can create it by creating a temporary form object. - strName = CreateForm().Name - ' Close without saving - DoCmd.Close acForm, strName, acSaveNo - ' Remove any potential default theme - If TableExists("MSysResources") Then - If blnClearThemes Then CurrentDb.Execute "DELETE * FROM MSysResources WHERE [Type]='thmx'", dbFailOnError - VerifyResourcesTable = True - Else - Log.Add "WARNING: Unable to create MSysResources table." - End If + blnExists = TableExists("MSysResources") + If Not blnExists Then + CreateResourcesTable + blnExists = TableExists("MSysResources") End If + + ' Return true if the table exists + VerifyResourcesTable = blnExists + + ' Log any errors + CatchAny eelError, "Error verifying MSysResources table", ModuleName & ".VerifyResourcesTable" End Function +'--------------------------------------------------------------------------------------- +' Procedure : CreateResourcesTable +' Author : Adam Waller +' Date : 7/9/2021 +' Purpose : The resources table is also used for shared images. We can add and remove +' : a temporary shared image to cause this table to be generated. +'--------------------------------------------------------------------------------------- +' +Private Sub CreateResourcesTable() + + Dim strTempFile As String + Dim strName As String + + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + Perf.OperationStart "Create MSysResources Table" + + ' Create a temporary image file + strTempFile = GetTempFile("IMG") + Create1x1pxImage strTempFile + + ' Add to database as shared image + strName = FSO.GetBaseName(strTempFile) + CurrentProject.AddSharedImage strName, strTempFile + + ' Now that we have the table, remove temporary shared image record and temp file. + CurrentDb.Execute "DELETE * FROM MSysResources WHERE Name='" & strName & "'", dbFailOnError + DeleteFile strTempFile + + ' Log any errors + CatchAny eelError, "Error creating MSysResources table", ModuleName & ".CreateResourcesTable" + Perf.OperationEnd + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : Create1x1pxImage +' Author : Adam Waller +' Date : 7/9/2021 +' Purpose : Creates a 1 pixel by 1 pixel png image. +'--------------------------------------------------------------------------------------- +' +Private Sub Create1x1pxImage(strPath As String) + + Dim intCnt As Integer + Dim varBytes As Variant + Dim bteImg() As Byte + + ' Byte array for binary 1x1 pixel png file. + varBytes = Array((137), (80), (78), (71), (13), (10), (26), (10), (0), (0), (0), (13), (73), (72), (68), _ + (82), (0), (0), (0), (1), (0), (0), (0), (1), (1), (3), (0), (0), (0), (37), (219), (86), (202), (0), _ + (0), (0), (3), (80), (76), (84), (69), (0), (0), (0), (167), (122), (61), (218), (0), (0), (0), (1), _ + (116), (82), (78), (83), (0), (64), (230), (216), (102), (0), (0), (0), (10), (73), (68), (65), (84), _ + (8), (215), (99), (96), (0), (0), (0), (2), (0), (1), (226), (33), (188), (51), (0), (0), (0), (0), _ + (73), (69), (78), (68), (174), (66), (96), (130)) + + ' Convert to byte array + ReDim bteImg(0 To UBound(varBytes)) As Byte + For intCnt = 0 To UBound(varBytes) + bteImg(intCnt) = varBytes(intCnt) + Next intCnt + + ' Write to file + WriteBinaryFile strPath, bteImg + +End Sub + + '--------------------------------------------------------------------------------------- ' Procedure : GetFileList ' Author : Adam Waller @@ -534,4 +607,5 @@ End Property ' Private Sub Class_Terminate() Set m_Dbs = Nothing -End Sub \ No newline at end of file +End Sub + diff --git a/Version Control.accda.src/modules/clsDbVbeForm.bas b/Version Control.accda.src/modules/clsDbVbeForm.cls similarity index 90% rename from Version Control.accda.src/modules/clsDbVbeForm.bas rename to Version Control.accda.src/modules/clsDbVbeForm.cls index 596cc1e6..05b1b340 100644 --- a/Version Control.accda.src/modules/clsDbVbeForm.bas +++ b/Version Control.accda.src/modules/clsDbVbeForm.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbVbeForm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -12,6 +17,8 @@ Attribute VB_Exposed = False Option Compare Database Option Explicit +Private Const ModuleName As String = "clsDbVbeForm" + Private m_Form As VBIDE.VBComponent Private m_AllItems As Collection @@ -38,17 +45,40 @@ End Sub '--------------------------------------------------------------------------------------- ' Procedure : Import ' Author : Adam Waller -' Date : 4/23/2020 +' Date : 4/30/2021 ' Purpose : Import the individual database component from a file. '--------------------------------------------------------------------------------------- ' Private Sub IDbComponent_Import(strFile As String) + Dim strLine As String + + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + ' Only import files with the correct extension. If Not strFile Like "*.frm" Then Exit Sub - GetVBProjectForCurrentDB.VBComponents.Import strFile + With GetVBProjectForCurrentDB.VBComponents + ' Import the source file + .Import strFile + + ' Check for extra blank line that may get added during import (VBE bug?) + With .Item(GetObjectNameFromFileName(strFile)) + If Not .CodeModule Is Nothing Then + If .CodeModule.Lines(1, 1) = vbNullString Then + ' Remove blank line added during import + .CodeModule.DeleteLines 1 + ' Note, this change is not saved at this time. It will be saved during + ' the next compile/save operation. + Log.Add "Removed blank line from the top of the code module for " & .Name, False + End If + End If + End With + End With + + CatchAny eelError, "Error importing " & strFile, ModuleName & ".Import" + End Sub @@ -285,4 +315,4 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/clsDbVbeProject.cls b/Version Control.accda.src/modules/clsDbVbeProject.cls new file mode 100644 index 00000000..a3dcf8d6 --- /dev/null +++ b/Version Control.accda.src/modules/clsDbVbeProject.cls @@ -0,0 +1,490 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbVbeProject" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'--------------------------------------------------------------------------------------- +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : This class extends the IDbComponent class to perform the specific +' : operations required by this particular object type. +' : (I.e. The specific way you export or import this component.) +'--------------------------------------------------------------------------------------- +Option Compare Database +Option Explicit + +Private Const ModuleName As String = "clsDbVbeProject" + +Private m_Project As VBIDE.VBProject +Private m_AllItems As Collection + +' This requires us to use all the public methods and properties of the implemented class +' which keeps all the component classes consistent in how they are used in the export +' and import process. The implemented functions should be kept private as they are called +' from the implementing class, not this class. +Implements IDbComponent + + +'--------------------------------------------------------------------------------------- +' Procedure : Export +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Export the individual database component (table, form, query, etc...) +'--------------------------------------------------------------------------------------- +' +Private Sub IDbComponent_Export() + + Dim dProject As Dictionary + + Set dProject = GetDictionary + + ' Save in JSON format. + WriteJsonFile TypeName(Me), dProject, IDbComponent_SourceFile, "VBE Project" + + ' Save to index + VCSIndex.Update Me, eatExport, GetDictionaryHash(dProject) + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : Import +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Import the individual database component from a file. +'--------------------------------------------------------------------------------------- +' +Private Sub IDbComponent_Import(strFile As String) + + Dim dProject As Dictionary + + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + + ' Only import files with the correct extension. + If Not strFile Like "*.json" Then Exit Sub + Set dProject = ReadJsonFile(strFile) + Set m_Project = GetVBProjectForCurrentDB + + ' Update project properties + With m_Project + .Name = dNZ(dProject, "Items\Name") + .Description = dNZ(dProject, "Items\Description") + + ' Setting the HelpContextId can throw random automation errors. + SafeSetProperty m_Project, "HelpContextId", ValidHelpContextId(dNZ(dProject, "Items\HelpContextId")) + SafeSetProperty m_Project, "HelpFile", ValidHelpFile(dNZ(dProject, "Items\HelpFile")) + + ' This property is not exposed through the VBProject object model + Application.SetOption "Conditional Compilation Arguments", dNZ(dProject, "Items\ConditionalCompilationArguments") + + ' // Read-only properties + '.FileName = dNZ(dProject, "Items\FileName") + '.Mode = dNZ(dProject, "Items\Mode") + '.Protection = dNZ(dProject, "Items\Protection") + '.Type = dNZ(dProject, "Items\Type") + End With + + CatchAny eelError, "Importing VBE Project", ModuleName & ".Import" + + ' Save to index + VCSIndex.Update Me, eatImport, GetDictionaryHash(GetDictionary) + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : SafeSetProperty +' Author : Adam Waller +' Date : 3/26/2021 +' Purpose : For some reason the help properties can sometimes throw strange runtime +' : errors when setting them. This function handles the extra error handling +' : involved in setting and verifying these properties. +'--------------------------------------------------------------------------------------- +' +Private Sub SafeSetProperty(cProj As VBProject, strProperty As String, varValue As Variant) + + Dim varCurrent As Variant + + ' Get current property value + varCurrent = CallByName(cProj, strProperty, VbGet) + + ' No need to set if the current value already matches + If varValue = varCurrent Then Exit Sub + + ' Switch to on error resume next after checking for current errors + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next + + ' Attempt to set the property + CallByName cProj, strProperty, VbLet, varValue + + ' Read the value after setting it + varCurrent = CallByName(cProj, strProperty, VbGet) + + ' Verify that the property was set correctly + If varCurrent <> varValue Then + ' We might have thrown an actual error. + If Not CatchAny(eelError, "Failed to set " & strProperty & " to '" & _ + CStr(varValue) & "'", ModuleName & ".SafeSetProperty") Then + ' No error, but property not set correctly. + Log.Error eelError, "Failed to set " & strProperty & ". Set value to '" & _ + varValue & "' but afterwards it returned '" & varCurrent & "'.", _ + ModuleName & ".SafeSetProperty" + End If + Else + ' Clear any errors that may have been thrown, even if the change was successful. + If Err Then Err.Clear + End If + + ' Log any uncaught errors + CatchAny eelError, "Setting Property '" & strProperty & "' to value '" & CStr(varValue) & "'", ModuleName & ".SafeSetProperty" + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : ValidHelpContextId +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Don't attempt to set the help context id to anything other than a number. +'--------------------------------------------------------------------------------------- +' +Private Function ValidHelpContextId(strHelpID As String) As Long + If strHelpID = vbNullString Then + ValidHelpContextId = 0 + ElseIf Not IsNumeric(strHelpID) Then + Log.Error eelWarning, "HelpContextID should be a number. " & _ + "Found '" & strHelpID & "' instead.", ModuleName & ".ValidHelpContextId" + ValidHelpContextId = 0 + Else + ValidHelpContextId = CLng(strHelpID) + End If +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : ValidHelpFile +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Get help file path saved as a relative path. +'--------------------------------------------------------------------------------------- +' +Private Function ValidHelpFile(strHelpFile As String) As String + + Dim strValid As String + + If strHelpFile <> vbNullString Then + + ' Check for a Rubber Duck Identifier value + If InStr(1, strHelpFile, ".") = 0 And IsNumeric(strHelpFile) Then + If Options.PreserveRubberDuckID Then + ' Allow user to save this identifier in the exported source, if they really want to. + ' See issue #197 for more details on this. + Log.Add "RubberDuck Identifier " & strHelpFile & " found in VBE Project HelpFile field. " & _ + "If you don't want to save this to source, " & _ + "set PreserveRubberDuckID = False in the options file.", False + + strValid = strHelpFile + End If + + Else + ' Might actually be a help file name/path + + ' Build out any relative path + strValid = GetPathFromRelative(strHelpFile) + + ' Make sure this is a valid help file + If strValid Like "*.hlp" Or strValid Like "*.chm" Then + If Not FSO.FileExists(strValid) Then + Log.Error eelWarning, "Help file not found: " & strValid, ModuleName & ".ValidHelpFile" + End If + Else + ' Does not appear to be a help file extension + Log.Error eelWarning, "'" & strValid & "' is not a valid help file name. " & _ + "(Expecting *.hlp or *.chm)", ModuleName & ".ValidHelpFile" + strValid = vbNullString + End If + + End If + End If + + ' Return validated help file string + ValidHelpFile = strValid + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : GetDictionary +' Author : Adam Waller +' Date : 12/1/2020 +' Purpose : Return a dictionary object of project properties. +'--------------------------------------------------------------------------------------- +' +Private Function GetDictionary() As Dictionary + + ' Make sure we have a reference to the VB project + If m_Project Is Nothing Then Set m_Project = GetVBProjectForCurrentDB + + ' Read project properties + Set GetDictionary = New Dictionary + With GetDictionary + .Add "Name", m_Project.Name + .Add "Description", m_Project.Description + .Add "FileName", FSO.GetFileName(m_Project.FileName) + .Add "HelpFile", ValidHelpFile(m_Project.HelpFile) + .Add "HelpContextId", ValidHelpContextId(m_Project.HelpContextId) + .Add "ConditionalCompilationArguments", Application.GetOption("Conditional Compilation Arguments") + .Add "Mode", m_Project.Mode + .Add "Protection", m_Project.Protection + .Add "Type", m_Project.Type + End With + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : Merge +' Author : Adam Waller +' Date : 11/21/2020 +' Purpose : Merge the source file into the existing database, updating or replacing +' : any existing object. +'--------------------------------------------------------------------------------------- +' +Private Sub IDbComponent_Merge(strFile As String) + IDbComponent_Import strFile +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : GetAllFromDB +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Return a collection of class objects represented by this component type. +'--------------------------------------------------------------------------------------- +' +Private Function IDbComponent_GetAllFromDB(Optional blnModifiedOnly As Boolean = False) As Collection + + Dim cProj As IDbComponent + + ' Build collection if not already cached + If m_AllItems Is Nothing Then + ' Load class details + Set m_Project = GetVBProjectForCurrentDB + Set m_AllItems = New Collection + Set cProj = New clsDbVbeProject + Set cProj.DbObject = m_Project + m_AllItems.Add cProj, m_Project.Name + End If + + ' Return cached collection + Set IDbComponent_GetAllFromDB = m_AllItems + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : GetFileList +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Return a list of file names to import for this component type. +'--------------------------------------------------------------------------------------- +' +Private Function IDbComponent_GetFileList(Optional blnModifiedOnly As Boolean = False) As Collection + Set IDbComponent_GetFileList = New Collection + If FSO.FileExists(IDbComponent_SourceFile) Then IDbComponent_GetFileList.Add IDbComponent_SourceFile +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : ClearOrphanedSourceFiles +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Remove any source files for objects not in the current database. +'--------------------------------------------------------------------------------------- +' +Private Sub IDbComponent_ClearOrphanedSourceFiles() +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : IsModified +' Author : Adam Waller +' Date : 11/21/2020 +' Purpose : Returns true if the object in the database has been modified since +' : the last export of the object. +'--------------------------------------------------------------------------------------- +' +Public Function IDbComponent_IsModified() As Boolean + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : DateModified +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : The date/time the object was modified. (If possible to retrieve) +' : If the modified date cannot be determined (such as application +' : properties) then this function will return 0. +'--------------------------------------------------------------------------------------- +' +Private Function IDbComponent_DateModified() As Date + IDbComponent_DateModified = 0 +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : SourceModified +' Author : Adam Waller +' Date : 4/27/2020 +' Purpose : The date/time the source object was modified. In most cases, this would +' : be the date/time of the source file, but it some cases like SQL objects +' : the date can be determined through other means, so this function +' : allows either approach to be taken. +'--------------------------------------------------------------------------------------- +' +Private Function IDbComponent_SourceModified() As Date + If FSO.FileExists(IDbComponent_SourceFile) Then IDbComponent_SourceModified = GetLastModifiedDate(IDbComponent_SourceFile) +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : Category +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Return a category name for this type. (I.e. forms, queries, macros) +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbComponent_Category() As String + IDbComponent_Category = "VB Project" +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : BaseFolder +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Return the base folder for import/export of this component. +'--------------------------------------------------------------------------------------- +Private Property Get IDbComponent_BaseFolder() As String + IDbComponent_BaseFolder = Options.GetExportFolder +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : Name +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Return a name to reference the object for use in logs and screen output. +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbComponent_Name() As String + IDbComponent_Name = m_Project.Name +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : SourceFile +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Return the full path of the source file for the current object. +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbComponent_SourceFile() As String + IDbComponent_SourceFile = IDbComponent_BaseFolder & "vbe-project.json" +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : Count +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Return a count of how many items are in this category. +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbComponent_Count(Optional blnModifiedOnly As Boolean = False) As Long + IDbComponent_Count = 1 +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : ComponentType +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : The type of component represented by this class. +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbComponent_ComponentType() As eDatabaseComponentType + IDbComponent_ComponentType = edbVbeProject +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : Upgrade +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : Run any version specific upgrade processes before importing. +'--------------------------------------------------------------------------------------- +' +Private Sub IDbComponent_Upgrade() + ' No upgrade needed. +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : DbObject +' Author : Adam Waller +' Date : 4/23/2020 +' Purpose : This represents the database object we are dealing with. +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbComponent_DbObject() As Object + Set IDbComponent_DbObject = m_Project +End Property +Private Property Set IDbComponent_DbObject(ByVal RHS As Object) + Set m_Project = RHS +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : SingleFile +' Author : Adam Waller +' Date : 4/24/2020 +' Purpose : Returns true if the export of all items is done as a single file instead +' : of individual files for each component. (I.e. properties, references) +'--------------------------------------------------------------------------------------- +' +Private Property Get IDbComponent_SingleFile() As Boolean + IDbComponent_SingleFile = True +End Property + + +'--------------------------------------------------------------------------------------- +' Procedure : Class_Initialize +' Author : Adam Waller +' Date : 4/24/2020 +' Purpose : Helps us know whether we have already counted the objects. +'--------------------------------------------------------------------------------------- +' +Private Sub Class_Initialize() + 'm_Count = -1 +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : Parent +' Author : Adam Waller +' Date : 4/24/2020 +' Purpose : Return a reference to this class as an IDbComponent. This allows you +' : to reference the public methods of the parent class without needing +' : to create a new class object. +'--------------------------------------------------------------------------------------- +' +Public Property Get Parent() As IDbComponent + Set Parent = Me +End Property + diff --git a/Version Control.accda.src/modules/clsDbVbeReference.bas b/Version Control.accda.src/modules/clsDbVbeReference.cls similarity index 91% rename from Version Control.accda.src/modules/clsDbVbeReference.bas rename to Version Control.accda.src/modules/clsDbVbeReference.cls index 680525d6..43441ce6 100644 --- a/Version Control.accda.src/modules/clsDbVbeReference.bas +++ b/Version Control.accda.src/modules/clsDbVbeReference.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDbVbeReference" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -56,6 +61,27 @@ End Sub ' Private Sub IDbComponent_Import(strFile As String) + ' Import the references + ImportReferences strFile + + ' Update index + VCSIndex.Update Me, eatImport, GetDictionaryHash(GetDictionary) + + CatchAny eelError, "Importing VBE references", ModuleName & ".Import" + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : ImportReferences +' Author : Adam Waller +' Date : 4/21/2021 +' Purpose : Wrapper to import references with the option of only loading the +' : GUID references. (This is used when preparing a bootstrap module.) +'--------------------------------------------------------------------------------------- +' +Public Sub ImportReferences(strFile As String, Optional blnGuidOnly As Boolean = False) + Dim dRef As Dictionary Dim dItems As Dictionary Dim varKey As Variant @@ -69,7 +95,7 @@ Private Sub IDbComponent_Import(strFile As String) ' Only import files with the correct extension. If Not strFile Like "*.json" Then Exit Sub - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Read in references from file Set dFile = ReadJsonFile(strFile) @@ -91,23 +117,23 @@ Private Sub IDbComponent_Import(strFile As String) varVersion = Split(dRef("Version"), ".") AddFromGuid proj, CStr(varKey), dRef("GUID"), CLng(varVersion(0)), CLng(varVersion(1)) ElseIf dRef.Exists("FullPath") Then - strPath = GetPathFromRelative(dRef("FullPath")) - If Not FSO.FileExists(strPath) Then - Log.Error eelError, "File not found. Unable to add reference to " & strPath, "clsVbeReference.Import" - Else - proj.References.AddFromFile strPath - CatchAny eelError, "Adding VBE reference from " & strPath, ModuleName & ".Import" + If Not blnGuidOnly Then + strPath = GetPathFromRelative(dRef("FullPath")) + If Not FSO.FileExists(strPath) Then + Log.Error eelError, "File not found. Unable to add reference to " & strPath, _ + ModuleName & ".ImportReferences" + Else + Perf.OperationStart "Add Library References" + proj.References.AddFromFile strPath + Perf.OperationEnd + CatchAny eelError, "Adding VBE reference from " & strPath, ModuleName & ".ImportReferences" + End If End If End If End If Next varKey End If - - ' Update index - VCSIndex.Update Me, eatImport, GetDictionaryHash(GetDictionary) - - CatchAny eelError, "Importing VBE references", ModuleName & ".Import" - + End Sub @@ -161,8 +187,10 @@ Private Sub AddFromGuid(proj As VBIDE.VBProject, strName As String, strGuid As S ' Try to add the GUID with the specific version requested ' We might encounter a reference that is not available in this version On Error GoTo ErrHandlerWithVersion + Perf.OperationStart "Add GUID References" proj.References.AddFromGuid strGuid, lngMajor, lngMinor - + Perf.OperationEnd + ' Normal exit On Error GoTo 0 Exit Sub @@ -452,4 +480,5 @@ End Property ' Public Property Get Parent() As IDbComponent Set Parent = Me -End Property \ No newline at end of file +End Property + diff --git a/Version Control.accda.src/modules/clsDevMode.bas b/Version Control.accda.src/modules/clsDevMode.cls similarity index 99% rename from Version Control.accda.src/modules/clsDevMode.bas rename to Version Control.accda.src/modules/clsDevMode.cls index 84f11e9d..c4f61688 100644 --- a/Version Control.accda.src/modules/clsDevMode.bas +++ b/Version Control.accda.src/modules/clsDevMode.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsDevMode" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -229,7 +234,7 @@ Public Sub LoadFromExportFile(strFile As String) Dim udtDevModeBuffer As tDevModeBuffer Dim udtDevNamesBuffer As tDevNamesBuffer - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Blocks: 1=Mip, 2=DevMode, 3=DevNames @@ -349,7 +354,7 @@ Public Sub LoadFromPrinter(strPrinter As String) Dim udtBuffer As tDevModeBuffer Dim objPrinter As Access.Printer - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Clear our existing devmode structures ClearStructures @@ -760,7 +765,7 @@ Public Sub SetPrinterOptions(objFormOrReport As Object, dSettings As Dictionary) Dim strDevModeExtra As String Dim tBuffer As tDevModeBuffer - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Make sure we are using the correct object type If TypeOf objFormOrReport Is Access.Report Then @@ -886,7 +891,7 @@ Public Sub ApplySettings(dSettings As Dictionary) Dim dItems As Dictionary Dim strPrinter As String - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Set the properties in the DevNames structure. ' Note that this simply sets the printer to one with a matching name. It doesn't try to reconstruct @@ -1035,7 +1040,7 @@ Public Function AddToExportFile(strFile As String) As String Dim blnFound As Boolean Dim blnInBlock As Boolean - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Load data from export file strData = ReadFile(strFile) @@ -1653,4 +1658,5 @@ Private Function RTrimNulls(strData As String, lngLeaveCount As Long) As String RTrimNulls = strTrimmed End If -End Function \ No newline at end of file +End Function + diff --git a/Version Control.accda.src/modules/clsGitIntegration.bas b/Version Control.accda.src/modules/clsGitIntegration.cls similarity index 99% rename from Version Control.accda.src/modules/clsGitIntegration.bas rename to Version Control.accda.src/modules/clsGitIntegration.cls index bdc2c425..2f52f19f 100644 --- a/Version Control.accda.src/modules/clsGitIntegration.bas +++ b/Version Control.accda.src/modules/clsGitIntegration.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsGitIntegration" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -432,4 +437,5 @@ End Function ' Private Sub Class_Initialize() GetRepositoryPath -End Sub \ No newline at end of file +End Sub + diff --git a/Version Control.accda.src/modules/clsLblProg.bas b/Version Control.accda.src/modules/clsLblProg.cls similarity index 99% rename from Version Control.accda.src/modules/clsLblProg.bas rename to Version Control.accda.src/modules/clsLblProg.cls index 9ab9b770..b80ea32f 100644 --- a/Version Control.accda.src/modules/clsLblProg.bas +++ b/Version Control.accda.src/modules/clsLblProg.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsLblProg" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -337,4 +342,4 @@ Private Function GetParentFormName(ctlControl As Control) As String ' Now we should have the parent form GetParentFormName = objParent.Name -End Function \ No newline at end of file +End Function diff --git a/Version Control.accda.src/modules/clsLog.bas b/Version Control.accda.src/modules/clsLog.cls similarity index 83% rename from Version Control.accda.src/modules/clsLog.bas rename to Version Control.accda.src/modules/clsLog.cls index 9d18a5c4..864b2645 100644 --- a/Version Control.accda.src/modules/clsLog.bas +++ b/Version Control.accda.src/modules/clsLog.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsLog" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -55,7 +60,10 @@ End Sub ' Purpose : Add a log file entry. '--------------------------------------------------------------------------------------- ' -Public Sub Add(strText As String, Optional blnPrint As Boolean = True, Optional blnNextOutputOnNewLine As Boolean = True) +Public Sub Add(strText As String, Optional blnPrint As Boolean = True, _ + Optional blnNextOutputOnNewLine As Boolean = True, _ + Optional strColor As String = vbNullString, _ + Optional blnBold As Boolean = False) Dim strHtml As String @@ -70,14 +78,25 @@ Public Sub Add(strText As String, Optional blnPrint As Boolean = True, Optional m_Prog.Hide End If - ' Use bold/green text for completion line. - strHtml = Replace(strText, " ", " ") - If InStr(1, strText, "Done. ") = 1 Then - strHtml = "" & strText & "" - End If - m_Console.Add strHtml - ' Add line break for HTML - If blnNextOutputOnNewLine Then m_Console.Add "
" + ' Build HTML output for console + With m_Console + + ' Opening tags + If blnBold Then .Add "" + If strColor <> vbNullString Then .Add "" + + ' Content + .Add MultiReplace(strText, _ + " ", " ", _ + vbCrLf, "
") + + ' Closing tags + If strColor <> vbNullString Then .Add "" + If blnBold Then m_Console.Add "" + + ' Add line break for HTML + If blnNextOutputOnNewLine Then m_Console.Add "
" + End With ' Run debug output If m_RichText Is Nothing Then @@ -125,7 +144,7 @@ Public Sub Flush() ' we don't hit the Integer limit ' on the SelStart property. .Value = m_Console.RightStr(20000) - .SelStart = 20000 + If VerifyFocus(m_RichText) Then .SelStart = 20000 Echo True 'Form_frmVCSMain.Repaint End With @@ -149,6 +168,7 @@ End Sub Public Sub Error(eLevel As eErrorLevel, strDescription As String, Optional strSource As String) Dim strPrefix As String + Dim strDisplay As String Select Case eLevel Case eelWarning: strPrefix = "WARNING: " @@ -158,13 +178,26 @@ Public Sub Error(eLevel As eErrorLevel, strDescription As String, Optional strSo ' Build the error message string. With New clsConcat - .AppendOnAdd = vbNullString - .Add strPrefix, strDescription - If strSource <> vbNullString Then .Add " Source: ", strSource - If Err Then .Add " Error ", Err.Number, ": ", Err.Description + + ' Sometimes the error description is sufficient for the description + If strDescription = vbNullString And Err.Number <> 0 Then + strDisplay = strPrefix & Err.Description + Else + strDisplay = strPrefix & strDescription + End If + + ' Display on the output screen anything higher than a warning + If eLevel > eelWarning Then + Me.Add vbNullString + Me.Spacer + Me.Add strDisplay, , , "red" + Me.Spacer + End If - ' Log the error and display if higher than warning. - Me.Add .GetStr, eLevel > eelWarning + ' Log the full detail to the log file + If Err Then .Add "Error ", Err.Number, ": ", Err.Description, " " + If strSource <> vbNullString Then .Add "Source: ", strSource + Me.Add .GetStr, False ' See if we are actively logging an operation If Log.Active Then @@ -177,9 +210,9 @@ Public Sub Error(eLevel As eErrorLevel, strDescription As String, Optional strSo ' Show message on any error level when we are not logging to a file. Select Case eLevel Case eelNoError: ' Do nothing - Case eelWarning: MsgBox2 "Warning", .GetStr, , vbInformation - Case eelError: MsgBox2 "Error", .GetStr, , vbExclamation - Case eelCritical: MsgBox2 "Critical", .GetStr, , vbCritical + Case eelWarning: MsgBox2 "Warning", strDisplay, .GetStr, vbInformation + Case eelError: MsgBox2 "Error", strDisplay, .GetStr, vbExclamation + Case eelCritical: MsgBox2 "Critical", strDisplay, .GetStr, vbCritical End Select End If End With @@ -286,7 +319,7 @@ End Sub ' Procedure : Increment ' Author : Adam Waller ' Date : 4/28/2020 -' Purpose : Increment the clock icon +' Purpose : Increment the progress bar '--------------------------------------------------------------------------------------- ' Public Sub Increment() @@ -322,7 +355,7 @@ Public Sub Increment() ' we don't hit the Integer limit ' on the SelStart property. .Value = m_Console.RightStr(20000) - .SelStart = 20000 + If VerifyFocus(m_RichText) Then .SelStart = 20000 Echo True End With End If @@ -333,4 +366,5 @@ Public Sub Increment() m_Prog.Value = lngProgress Perf.OperationEnd -End Sub \ No newline at end of file +End Sub + diff --git a/Version Control.accda.src/modules/clsOptions.bas b/Version Control.accda.src/modules/clsOptions.cls similarity index 80% rename from Version Control.accda.src/modules/clsOptions.bas rename to Version Control.accda.src/modules/clsOptions.cls index 32c253df..c0a92e25 100644 --- a/Version Control.accda.src/modules/clsOptions.bas +++ b/Version Control.accda.src/modules/clsOptions.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsOptions" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -26,16 +31,19 @@ Public SaveQuerySQL As Boolean Public ForceImportOriginalQuerySQL As Boolean Public SaveTableSQL As Boolean Public StripPublishOption As Boolean -Public AggressiveSanitize As Boolean +Public SanitizeColors As eSanitizeLevel +Public SanitizeLevel As eSanitizeLevel Public ExtractThemeFiles As Boolean Public TablesToExportData As Dictionary Public RunBeforeExport As String Public RunAfterExport As String +Public RunBeforeBuild As String Public RunAfterBuild As String Public ShowVCSLegacy As Boolean Public HashAlgorithm As String Public UseShortHash As Boolean Public BreakOnError As Boolean +Public PreserveRubberDuckID As Boolean ' Constants for enum values ' (These values are not permanently stored and @@ -70,16 +78,19 @@ Public Sub LoadDefaults() .ForceImportOriginalQuerySQL = False .SaveTableSQL = True .StripPublishOption = True - .AggressiveSanitize = True + .SanitizeLevel = eslAggressive + .SanitizeColors = eslBasic .ShowVCSLegacy = True .HashAlgorithm = DefaultHashAlgorithm .UseShortHash = True ' Table data export Set .TablesToExportData = New Dictionary + ' Set CompareMode to textual comparison + .TablesToExportData.CompareMode = vbTextCompare ' Save specific tables by default - AddTableToExportData "USysRibbons", etdTabDelimited AddTableToExportData "USysRegInfo", etdTabDelimited + AddTableToExportData "USysRibbons", etdTabDelimited ' Print settings to export Set .ExportPrintSettings = New Dictionary @@ -169,7 +180,7 @@ End Sub '--------------------------------------------------------------------------------------- ' Public Sub SaveOptionsAsDefault() - Me.SaveOptionsToFile FSO.BuildPath(CodeProject.Path, FSO.GetBaseName(CodeProject.Name)) & ".json" + Me.SaveOptionsToFile GetDefaultOptionsFilePath End Sub @@ -202,7 +213,7 @@ Public Sub LoadOptionsFromFile(strFile As String) Dim varOption As Variant Dim strKey As String - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Save file path, in case we need to use it to determine ' the export folder location with no database open. @@ -213,6 +224,8 @@ Public Sub LoadOptionsFromFile(strFile As String) If Not dFile Is Nothing Then If dFile.Exists("Options") Then Set dOptions = dFile("Options") + ' Perform any relevant option upgrades + Upgrade dOptions ' Attempt to set any matching options in this class. For Each varOption In m_colOptions strKey = CStr(varOption) @@ -222,7 +235,7 @@ Public Sub LoadOptionsFromFile(strFile As String) Case "ExportPrintSettings" Set Me.ExportPrintSettings = dOptions(strKey) Case "TablesToExportData" - Set Me.TablesToExportData = dOptions(strKey) + Set Me.TablesToExportData = CloneDictionary(dOptions(strKey), ecmTextCompare) Case Else ' Regular top-level properties CallByName Me, strKey, VbLet, dOptions(strKey) @@ -237,6 +250,31 @@ Public Sub LoadOptionsFromFile(strFile As String) End Sub +'--------------------------------------------------------------------------------------- +' Procedure : Upgrade +' Author : Adam Waller +' Date : 6/16/2021 +' Purpose : Perform any upgrades to option names or settings. +' : Expects a dictionary of options, as when loaded from a file. +'--------------------------------------------------------------------------------------- +' +Private Sub Upgrade(ByRef dOptions As Dictionary) + + ' 6/16/2021 + ' Aggressive sanitize to sanitize levels + If dOptions.Exists("AggressiveSanitize") Then + If Not dOptions.Exists("SanitizeLevel") Then + ' Check for non-default level + If Not dOptions("AggressiveSanitize") Then + ' Set to basic level + dOptions.Add "SanitizeLevel", eslBasic + End If + End If + End If + +End Sub + + '--------------------------------------------------------------------------------------- ' Procedure : LoadProjectOptions ' Author : Adam Waller @@ -270,10 +308,22 @@ End Sub '--------------------------------------------------------------------------------------- ' Public Sub LoadDefaultOptions() - LoadOptionsFromFile FSO.BuildPath(CodeProject.Path, FSO.GetBaseName(CodeProject.Name)) & ".json" + LoadOptionsFromFile GetDefaultOptionsFilePath End Sub +'--------------------------------------------------------------------------------------- +' Procedure : GetDefaultOptionsFilePath +' Author : Adam Waller +' Date : 5/7/2021 +' Purpose : Return the full path of the default options file +'--------------------------------------------------------------------------------------- +' +Private Function GetDefaultOptionsFilePath() As String + GetDefaultOptionsFilePath = FSO.BuildPath(CodeProject.Path, cstrOptionsFilename) +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : PrintOptionsToDebugWindow ' Author : Adam Waller @@ -352,7 +402,7 @@ Private Function SerializeOptions() As Dictionary Dim strOption As String Dim strBit As String - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next Set dOptions = New Dictionary Set dInfo = New Dictionary @@ -370,7 +420,14 @@ Private Function SerializeOptions() As Dictionary ' Loop through options For Each varOption In m_colOptions ' Simulate reflection to serialize properties. - dOptions.Add CStr(varOption), CallByName(Me, CStr(varOption), VbGet) + Select Case varOption + Case "AggressiveSanitize" + 'Ignored Properties/Options that should not be exported. + Case Else + dOptions.Add CStr(varOption), CallByName(Me, CStr(varOption), VbGet) + End Select + + Next varOption 'Set SerializeOptions = new Dictionary @@ -396,6 +453,56 @@ Public Function GetHash() As String End Function +'--------------------------------------------------------------------------------------- +' Procedure : GetSanitizeLevelName +' Author : Hecon5 (as adapted from Adam Waller's below) +' Date : 6/09/2021 +' Purpose : Return the name used to read and write to the JSON options files. +'--------------------------------------------------------------------------------------- +' +Public Function GetSanitizeLevelName(intSanitizeLevel As eSanitizeLevel) As String + Select Case intSanitizeLevel + Case eslNone: GetSanitizeLevelName = "None (Off)" + Case eslBasic: GetSanitizeLevelName = "Basic" + Case eslAggressive: GetSanitizeLevelName = "Aggressive" + Case eslAdvancedBeta: GetSanitizeLevelName = "Advanced (BETA)" + Case Else: GetSanitizeLevelName = vbNullString + End Select +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : GetSanitizeLevel +' Author : Hecon5 (as adapted from Adam Waller's below) +' Date : 4/17/2020 +' Purpose : Translate the table export format key to the corresponding enum value. +'--------------------------------------------------------------------------------------- +' +Public Function GetSanitizeLevel(strKey As String) As eSanitizeLevel + Dim intSanitizeLevel As eSanitizeLevel + Dim strName As String + For intSanitizeLevel = eslNone To eSanitizeLevel.[_Last] + strName = Me.GetSanitizeLevelName(intSanitizeLevel) + If strName = strKey Then + GetSanitizeLevel = intSanitizeLevel + Exit For + End If + Next intSanitizeLevel +End Function + + +'--------------------------------------------------------------------------------------- +' Property : AggressiveSanitize +' Author : hecon5 +' Date : 6/16/2021 +' Purpose : Return the AggressiveSanitize value based on new property; used to ensure +' : we can still use AggressiveSanitize in legacy code. +'--------------------------------------------------------------------------------------- +' +Public Property Get AggressiveSanitize() As Boolean + If SanitizeLevel >= eslAggressive Then AggressiveSanitize = True +End Property + '--------------------------------------------------------------------------------------- ' Procedure : GetTableExportFormatName ' Author : Adam Waller @@ -489,20 +596,26 @@ Private Sub Class_Initialize() .Add "ForceImportOriginalQuerySQL" .Add "SaveTableSQL" .Add "StripPublishOption" - .Add "AggressiveSanitize" + .Add "SanitizeColors" + .Add "SanitizeLevel" .Add "ExtractThemeFiles" .Add "TablesToExportData" .Add "RunBeforeExport" .Add "RunAfterExport" + .Add "RunBeforeBuild" .Add "RunAfterBuild" .Add "ShowVCSLegacy" .Add "HashAlgorithm" .Add "UseShortHash" .Add "BreakOnError" + .Add "PreserveRubberDuckID" End With ' Load default values Me.LoadDefaults + + ' Load saved defaults + LoadDefaultOptions ' Other run-time options JsonOptions.AllowUnicodeChars = True @@ -574,4 +687,5 @@ Private Function GetSavedSourcePathProperty() As AccessObjectProperty End If Next prp End If -End Function \ No newline at end of file +End Function + diff --git a/Version Control.accda.src/modules/clsPerformance.bas b/Version Control.accda.src/modules/clsPerformance.cls similarity index 96% rename from Version Control.accda.src/modules/clsPerformance.bas rename to Version Control.accda.src/modules/clsPerformance.cls index 46cd5c14..2582c713 100644 --- a/Version Control.accda.src/modules/clsPerformance.bas +++ b/Version Control.accda.src/modules/clsPerformance.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsPerformance" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -145,6 +150,7 @@ Public Sub OperationEnd(Optional lngCount As Long = 1) End Sub + '--------------------------------------------------------------------------------------- ' Procedure : DigitsAfterDecimal ' Author : Eugen Albiker @@ -157,6 +163,7 @@ Public Property Let DigitsAfterDecimal(intDigitsAfterDecimal As Integer) m_intDigitsAfterDecimal = intDigitsAfterDecimal End Property + '--------------------------------------------------------------------------------------- ' Procedure : EndTiming ' Author : Adam Waller @@ -250,6 +257,18 @@ Private Function GetElapsed(curStart As Currency) As Currency End Function +'--------------------------------------------------------------------------------------- +' Procedure : TotalTime +' Author : Adam Waller +' Date : 4/29/2021 +' Purpose : Return total time from start to end, or to now if end not specified. +'--------------------------------------------------------------------------------------- +' +Public Property Get TotalTime() As Currency + TotalTime = GetElapsed(m_Overall.Start) +End Property + + '--------------------------------------------------------------------------------------- ' Procedure : GetReports ' Author : Adam Waller @@ -401,4 +420,5 @@ Private Sub Class_Initialize() ' m_curFrequency need only be queried once ' https://docs.microsoft.com/en-us/windows/win32/api/profileapi/nf-profileapi-queryperformancefrequency GetFrequencyAPI m_curFrequency -End Sub \ No newline at end of file +End Sub + diff --git a/Version Control.accda.src/modules/clsPerformanceItem.bas b/Version Control.accda.src/modules/clsPerformanceItem.cls similarity index 68% rename from Version Control.accda.src/modules/clsPerformanceItem.bas rename to Version Control.accda.src/modules/clsPerformanceItem.cls index f2eab2f9..71be3d34 100644 --- a/Version Control.accda.src/modules/clsPerformanceItem.bas +++ b/Version Control.accda.src/modules/clsPerformanceItem.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsPerformanceItem" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -8,4 +13,4 @@ Option Explicit ' See usage in clsPerformance Public Start As Currency Public Total As Currency -Public Count As Double \ No newline at end of file +Public Count As Double diff --git a/Version Control.accda.src/modules/clsVCSIndex.bas b/Version Control.accda.src/modules/clsVCSIndex.cls similarity index 88% rename from Version Control.accda.src/modules/clsVCSIndex.bas rename to Version Control.accda.src/modules/clsVCSIndex.cls index 359d222c..6729a8e5 100644 --- a/Version Control.accda.src/modules/clsVCSIndex.bas +++ b/Version Control.accda.src/modules/clsVCSIndex.cls @@ -1,16 +1,25 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsVCSIndex" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False '--------------------------------------------------------------------------------------- -' Module : clsGitIndex +' Module : clsVCSIndex ' Author : Adam Waller ' Date : 11/25/2020 -' Purpose : +' Purpose : Maintain index of source files and database objects so that changes +' : can be detected. '--------------------------------------------------------------------------------------- Option Compare Database Option Explicit +' File name for index +Private Const cstrFileName As String = "vcs-index.json" + ' General properties Public MergeBuildDate As Date @@ -53,7 +62,7 @@ Public Sub LoadFromFile(Optional strFile As String) ' Load properties m_strFile = strFile - If m_strFile = vbNullString Then m_strFile = DefaultFileName + If m_strFile = vbNullString Then m_strFile = DefaultFilePath If FSO.FileExists(m_strFile) Then Set dFile = ReadJsonFile(m_strFile) If Not dFile Is Nothing Then @@ -84,12 +93,13 @@ End Sub ' Purpose : Save to a file '--------------------------------------------------------------------------------------- ' -Public Sub Save() +Public Sub Save(Optional strInFolder As String) Dim varCat As Variant Dim varKey As Variant Dim varValue As Variant Dim dComponents As Dictionary + Dim strFile As String ' Load dictionary from properties For Each varKey In m_dIndex.Keys @@ -111,9 +121,16 @@ Public Sub Save() Next varCat Set m_dIndex("Components") = SortDictionaryByKeys(dComponents) + ' Build file path + If strInFolder = vbNullString Then + strFile = m_strFile + Else + strFile = StripSlash(strInFolder) & PathSep & cstrFileName + End If + ' Save index to file If m_strFile <> vbNullString Then - WriteJsonFile TypeName(Me), m_dIndex, m_strFile, "Version Control System Index" + WriteJsonFile TypeName(Me), m_dIndex, strFile, "Version Control System Index" End If End Sub @@ -155,6 +172,9 @@ Public Function Update(cItem As IDbComponent, intAction As eIndexActionType, _ ' Save timestamp of exported source file. dteDateTime = GetLastModifiedDate(cItem.SourceFile) .Item("SourceModified") = ZNDate(CStr(dteDateTime)) + + ' Save hash of file properties + .Item("FilePropertiesHash") = GetFilePropertyHash(cItem.SourceFile) End With @@ -321,6 +341,31 @@ Public Property Get DefaultDevModeHash() As String End Property +'--------------------------------------------------------------------------------------- +' Procedure : GetFilePropertyHash +' Author : Adam Waller +' Date : 5/27/2021 +' Purpose : Returns a hash of some file properties used to quickly scan for changes. +'--------------------------------------------------------------------------------------- +' +Public Function GetFilePropertyHash(strFile As String) As String + + Dim oFile As Scripting.File + + If FSO.FileExists(strFile) Then + Perf.OperationStart "Get File Property Hash" + Set oFile = FSO.GetFile(strFile) + + With New clsConcat + .Add oFile.DateLastModified, oFile.Size + GetFilePropertyHash = GetStringHash(.GetStr) + End With + Perf.OperationEnd + End If + +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : GetModifiedSourceFiles ' Author : Adam Waller @@ -392,8 +437,8 @@ End Function ' Purpose : Return file name for git state json file. '--------------------------------------------------------------------------------------- ' -Private Function DefaultFileName() As String - DefaultFileName = Options.GetExportFolder & "vcs-index.json" +Private Function DefaultFilePath() As String + If DatabaseOpen Then DefaultFilePath = Options.GetExportFolder & cstrFileName End Function @@ -420,4 +465,5 @@ Private Sub Class_Initialize() ' Load Git integration Set m_dGitIndex = Nothing -End Sub \ No newline at end of file +End Sub + diff --git a/Version Control.accda.src/modules/clsVersionControl.bas b/Version Control.accda.src/modules/clsVersionControl.cls similarity index 95% rename from Version Control.accda.src/modules/clsVersionControl.bas rename to Version Control.accda.src/modules/clsVersionControl.cls index 2fe9e13c..bb908c04 100644 --- a/Version Control.accda.src/modules/clsVersionControl.bas +++ b/Version Control.accda.src/modules/clsVersionControl.cls @@ -1,3 +1,8 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "clsVersionControl" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False @@ -58,4 +63,4 @@ End Function ' Public Property Get Version() As String Version = GetVCSVersion -End Property \ No newline at end of file +End Property diff --git a/Version Control.accda.src/modules/modAPI.bas b/Version Control.accda.src/modules/modAPI.bas index 98ca5be5..fc142852 100644 --- a/Version Control.accda.src/modules/modAPI.bas +++ b/Version Control.accda.src/modules/modAPI.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modAPI" '--------------------------------------------------------------------------------------- ' Module : modAPI ' Author : Adam Waller @@ -7,6 +8,8 @@ Option Compare Database Option Explicit +' Note, some enums are listed here when they are directly exposed +' through the Options class. (Allowing them to be used externally) ' Formats used when exporting table data. Public Enum eTableDataExportFormat @@ -16,6 +19,18 @@ Public Enum eTableDataExportFormat [_Last] = 2 End Enum +Public Enum eSanitizeLevel + eslNone = 0 ' Sanitize only items which won't build correctly unless you sanitize them. + eslBasic ' Strip out excess items (like GUIDs) that are just noise and no effect can be found. + eslAggressive ' Strip out anything that can be reliably rebuilt by Access during Build (themed control colors). + + ' WARNING: AdvancedBeta introduces sanitzation that may or may not work in all environments, and has known + ' (or highly suspected) edge cases where it does not always operate correctly. Do not use this level in + ' production databases. + eslAdvancedBeta ' Remove all excess noise. Try out new sanitize features that still have ragged edges. + [_Last] ' DO NOT REMOVE: This is a "Fake" level, and must be at the end. +End Enum + Private m_VCS As clsVersionControl @@ -29,4 +44,16 @@ Private m_VCS As clsVersionControl Public Function VCS() As clsVersionControl If m_VCS Is Nothing Then Set m_VCS = New clsVersionControl Set VCS = m_VCS -End Function \ No newline at end of file +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : RepairColors +' Author : Adam Waller +' Date : 6/8/2021 +' Purpose : Reapply the color properties in the current database +'--------------------------------------------------------------------------------------- +' +Public Sub RepairColors() + RepairColorDefinitionBlocks +End Sub diff --git a/Version Control.accda.src/modules/modAddIn.bas b/Version Control.accda.src/modules/modAddIn.bas index a67a696a..f895f485 100644 --- a/Version Control.accda.src/modules/modAddIn.bas +++ b/Version Control.accda.src/modules/modAddIn.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modAddIn" '--------------------------------------------------------------------------------------- ' Module : modAddIn ' Author : Adam Waller @@ -225,7 +226,7 @@ End Function Private Sub LoadVCSAddIn() ' The following lines will load the add-in at the application level, ' but will not actually call the function. Ignore the error of function not found. - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next Application.Run GetAddinFileName & "!DummyFunction" End Sub @@ -237,14 +238,22 @@ End Sub ' Purpose : Increments the build version (1.0.12) '--------------------------------------------------------------------------------------- ' -Public Sub IncrementAppVersion(ReleaseType As eReleaseType) +Public Sub IncrementAppVersion(Optional ReleaseType As eReleaseType = Build_xxV) + Dim varParts As Variant + Dim strFrom As String + If ReleaseType = Same_Version Then Exit Sub + strFrom = AppVersion varParts = Split(AppVersion, ".") varParts(ReleaseType) = varParts(ReleaseType) + 1 If ReleaseType < Minor_xVx Then varParts(Minor_xVx) = 0 If ReleaseType < Build_xxV Then varParts(Build_xxV) = 0 AppVersion = Join(varParts, ".") + + ' Display old and new versions + Debug.Print "Updated from " & strFrom & " to " & AppVersion + End Sub @@ -305,4 +314,5 @@ Public Sub PreloadVBE() DoCmd.Hourglass True strName = VBE.ActiveVBProject.Name DoCmd.Hourglass False -End Sub \ No newline at end of file +End Sub + diff --git a/Version Control.accda.src/modules/modConnect.bas b/Version Control.accda.src/modules/modConnect.bas index ac59d3bc..1af3860f 100644 --- a/Version Control.accda.src/modules/modConnect.bas +++ b/Version Control.accda.src/modules/modConnect.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modConnect" '--------------------------------------------------------------------------------------- ' Module : modConnect ' Author : hecon5 @@ -156,4 +157,5 @@ Private Function GetConnectPath(strConnect As String) As String ' Return path, if any GetConnectPath = strPath -End Function \ No newline at end of file +End Function + diff --git a/Version Control.accda.src/modules/modConstants.bas b/Version Control.accda.src/modules/modConstants.bas index 2076d610..0ce43a14 100644 --- a/Version Control.accda.src/modules/modConstants.bas +++ b/Version Control.accda.src/modules/modConstants.bas @@ -1,4 +1,5 @@ -'--------------------------------------------------------------------------------------- +Attribute VB_Name = "modConstants" +'--------------------------------------------------------------------------------------- ' Module : modConstants ' Author : Adam Waller ' Date : 12/4/2020 @@ -24,6 +25,9 @@ Public Const UCS2_BOM As String = "ÿþ" ' Default hashing algorithm Public Const DefaultHashAlgorithm As String = "SHA256" +' This value seems to indicate that the theme was not used. +Public Const NO_THEME_INDEX As Integer = -1 + ' Object types used when determining SQL modification date. Public Enum eSqlObjectType estView @@ -69,6 +73,7 @@ Public Enum eDatabaseComponentType edbVbeForm edbVbeProject edbVbeReference + edbProject End Enum ' Error levels used for logging and monitoring the status @@ -78,4 +83,20 @@ Public Enum eErrorLevel eelWarning ' Logged to file eelError ' Displayed and logged eelCritical ' Cancel operation -End Enum \ No newline at end of file +End Enum + +' Compare mode for cloning dictionary object +' See CloneDictionary function +Public Enum eCompareMethod2 + ecmBinaryCompare = 0 + ecmTextCompare = 1 + ecmDatabaseCompare = 2 + ' Added this to use original compare method + ecmSourceMethod = 3 +End Enum + +' Options for resolving file conflicts +Public Enum eResolveConflict + ercSkip + ercOverwrite +End Enum diff --git a/Version Control.accda.src/modules/modDatabase.bas b/Version Control.accda.src/modules/modDatabase.bas index 6f6bf2e3..5bc8e12b 100644 --- a/Version Control.accda.src/modules/modDatabase.bas +++ b/Version Control.accda.src/modules/modDatabase.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modDatabase" '--------------------------------------------------------------------------------------- ' Module : modDatabase ' Author : Adam Waller @@ -26,7 +27,7 @@ End Function '--------------------------------------------------------------------------------------- ' Procedure : GetDBProperty ' Author : Adam Waller -' Date : 9/1/2017 +' Date : 5/6/2021 ' Purpose : Get a database property (Default to MDB version) '--------------------------------------------------------------------------------------- ' @@ -35,12 +36,23 @@ Public Function GetDBProperty(strName As String, Optional dbs As DAO.Database) A Dim prp As Object ' DAO.Property Dim oParent As Object - ' Get parent container for properties - If CurrentProject.ProjectType = acADP Then - Set oParent = CurrentProject.Properties - Else - If dbs Is Nothing Then Set dbs = CurrentDb + ' Check for database reference + If Not dbs Is Nothing Then Set oParent = dbs.Properties + Else + If DatabaseOpen Then + ' Get parent container for properties + If CurrentProject.ProjectType = acADP Then + Set oParent = CurrentProject.Properties + Else + If dbs Is Nothing Then Set dbs = CurrentDb + Set oParent = dbs.Properties + End If + Else + ' No database open + GetDBProperty = vbNullString + Exit Function + End If End If ' Look for property by name @@ -437,8 +449,90 @@ End Function '--------------------------------------------------------------------------------------- ' Public Sub DeleteObjectIfExists(intType As AcObjectType, strName As String) - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next DoCmd.DeleteObject intType, strName Catch 7874 ' Object not found CatchAny eelError, "Deleting object " & strName -End Sub \ No newline at end of file +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : DbVersion +' Author : Adam Waller +' Date : 5/4/2021 +' Purpose : Return the database version as an integer. Works in non-English locales +' : where CInt(CurrentDb.Version) doesn't work correctly. +'--------------------------------------------------------------------------------------- +' +Public Function DbVersion() As Integer + DbVersion = CInt(Split(CurrentDb.Version, ".")(0)) +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : FormLoaded +' Author : Adam Waller +' Date : 7/8/2021 +' Purpose : Helps identify if a form has been closed, but is still running code +' : after the close event. +'--------------------------------------------------------------------------------------- +' +Public Function FormLoaded(frmMe As Form) As Boolean + Dim strName As String + ' If no forms are open, we already have our answer. :-) + If Forms.Count > 0 Then + ' We will throw an error accessing the name property if the form is closed + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next + strName = frmMe.Name + ' Return true if we were able to read the name property + FormLoaded = strName <> vbNullString + End If +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : VerifyFocus +' Author : Adam Waller +' Date : 7/8/2021 +' Purpose : Verify that a control currently has the focus. (Is the active control) +'--------------------------------------------------------------------------------------- +' +Public Function VerifyFocus(ctlWithFocus As Control) As Boolean + + Dim frmParent As Form + Dim objParent As Object + Dim ctlCurrentFocus As Control + + ' Determine parent form for control + Set objParent = ctlWithFocus + Do While Not TypeOf objParent Is Form + Set objParent = objParent.Parent + Loop + Set frmParent = objParent + + ' Ignore any errors with Screen.* functions + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next + + ' Verify focus of parent form + Set frmParent = Screen.ActiveForm + If Not frmParent Is objParent Then + Set frmParent = objParent + frmParent.SetFocus + DoEvents + End If + + ' Verify focus of control on form + Set ctlCurrentFocus = frmParent.ActiveControl + If Not ctlCurrentFocus Is ctlWithFocus Then + ctlWithFocus.SetFocus + DoEvents + End If + + ' Return true if the control currently has the focus + VerifyFocus = frmParent.ActiveControl Is ctlWithFocus + + ' Discard any errors + CatchAny eelNoError, vbNullString, , False + +End Function + diff --git a/Version Control.accda.src/modules/modEncoding.bas b/Version Control.accda.src/modules/modEncoding.bas index 695ba38b..1c5394e9 100644 --- a/Version Control.accda.src/modules/modEncoding.bas +++ b/Version Control.accda.src/modules/modEncoding.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modEncoding" '--------------------------------------------------------------------------------------- ' Module : modEncoding ' Author : Adam Waller @@ -312,6 +313,7 @@ Public Sub ReEncodeFile(strInputFile As String, strInputCharset As String, _ End With ' Save file and log performance + VerifyPath strOutputFile objOutputStream.SaveToFile strOutputFile, intOverwriteMode objOutputStream.Close Perf.OperationEnd @@ -322,7 +324,7 @@ End Sub '--------------------------------------------------------------------------------------- ' Procedure : GetSystemEncoding ' Author : Adam Waller -' Date : 3/8/2021 +' Date : 7/1/2021 ' Purpose : Return the current encoding type used for non-UTF-8 text files. ' : (Such as VBA code modules.) ' : https://docs.microsoft.com/en-us/windows/win32/intl/code-page-identifiers @@ -330,7 +332,7 @@ End Sub ' : * Note that using utf-8 as a default system encoding may not work ' : correctly with some extended characters in VBA code modules. The VBA IDE ' : does not support Unicode characters, and requires code pages to display -' : extended/non-English characters. See Issues #60, #186, #180 +' : extended/non-English characters. See Issues #60, #186, #180, #246 '--------------------------------------------------------------------------------------- ' Public Function GetSystemEncoding() As String @@ -341,15 +343,134 @@ Public Function GetSystemEncoding() As String If lngEncoding = 0 Then lngEncoding = GetACP Select Case lngEncoding - ' Language encoding mappings can be defined here - Case msoEncodingISO88591Latin1: GetSystemEncoding = "iso-8859-1" - Case msoEncodingWestern: GetSystemEncoding = "windows-1252" + ' Language encoding mappings are defined here, based on the following sources: + ' https://docs.microsoft.com/en-us/office/vba/api/office.msoencoding + ' https://docs.microsoft.com/en-us/dotnet/api/system.text.encoding?view=net-5.0 + Case msoEncodingEBCDICUSCanada: GetSystemEncoding = "IBM037" + Case msoEncodingOEMUnitedStates: GetSystemEncoding = "IBM437" + Case msoEncodingEBCDICInternational: GetSystemEncoding = "IBM500" + Case msoEncodingArabicASMO: GetSystemEncoding = "ASMO-708" + Case msoEncodingArabicTransparentASMO: GetSystemEncoding = "DOS-720" + Case msoEncodingOEMGreek437G: GetSystemEncoding = "ibm737" + Case msoEncodingOEMBaltic: GetSystemEncoding = "ibm775" + Case msoEncodingOEMMultilingualLatinI: GetSystemEncoding = "ibm850" + Case msoEncodingOEMMultilingualLatinII: GetSystemEncoding = "ibm852" + Case msoEncodingOEMCyrillic: GetSystemEncoding = "IBM855" + Case msoEncodingOEMTurkish: GetSystemEncoding = "ibm857" + Case msoEncodingOEMPortuguese: GetSystemEncoding = "IBM860" + Case msoEncodingOEMIcelandic: GetSystemEncoding = "ibm861" + Case msoEncodingOEMHebrew: GetSystemEncoding = "DOS-862" + Case msoEncodingOEMCanadianFrench: GetSystemEncoding = "IBM863" + Case msoEncodingOEMArabic: GetSystemEncoding = "IBM864" + Case msoEncodingOEMNordic: GetSystemEncoding = "IBM865" + Case msoEncodingOEMCyrillicII: GetSystemEncoding = "cp866" + Case msoEncodingOEMModernGreek: GetSystemEncoding = "ibm869" + Case msoEncodingEBCDICMultilingualROECELatin2: GetSystemEncoding = "IBM870" + Case msoEncodingThai: GetSystemEncoding = "windows-874" + Case msoEncodingEBCDICGreekModern: GetSystemEncoding = "cp875" + Case msoEncodingJapaneseShiftJIS: GetSystemEncoding = "shift_jis" + Case msoEncodingSimplifiedChineseGBK: GetSystemEncoding = "gb2312" + Case msoEncodingKorean: GetSystemEncoding = "ks_c_5601-1987" + Case msoEncodingTraditionalChineseBig5: GetSystemEncoding = "big5" + Case msoEncodingEBCDICTurkishLatin5: GetSystemEncoding = "IBM1026" + Case msoEncodingUnicodeLittleEndian: GetSystemEncoding = "utf-16" + Case msoEncodingUnicodeBigEndian: GetSystemEncoding = "unicodeFFFE" + Case msoEncodingCentralEuropean: GetSystemEncoding = "windows-1250" + Case msoEncodingCyrillic: GetSystemEncoding = "windows-1251" + Case msoEncodingWestern: GetSystemEncoding = "Windows-1252" + Case msoEncodingGreek: GetSystemEncoding = "windows-1253" + Case msoEncodingTurkish: GetSystemEncoding = "windows-1254" + Case msoEncodingHebrew: GetSystemEncoding = "windows-1255" + Case msoEncodingArabic: GetSystemEncoding = "windows-1256" + Case msoEncodingBaltic: GetSystemEncoding = "windows-1257" + Case msoEncodingVietnamese: GetSystemEncoding = "windows-1258" + Case msoEncodingKoreanJohab: GetSystemEncoding = "Johab" + Case msoEncodingMacRoman: GetSystemEncoding = "macintosh" + Case msoEncodingMacJapanese: GetSystemEncoding = "x-mac-japanese" + Case msoEncodingMacTraditionalChineseBig5: GetSystemEncoding = "x-mac-chinesetrad" + Case msoEncodingMacKorean: GetSystemEncoding = "x-mac-korean" + Case msoEncodingMacArabic: GetSystemEncoding = "x-mac-arabic" + Case msoEncodingMacHebrew: GetSystemEncoding = "x-mac-hebrew" + Case msoEncodingMacGreek1: GetSystemEncoding = "x-mac-greek" + Case msoEncodingMacCyrillic: GetSystemEncoding = "x-mac-cyrillic" + Case msoEncodingMacSimplifiedChineseGB2312: GetSystemEncoding = "x-mac-chinesesimp" + Case msoEncodingMacRomania: GetSystemEncoding = "x-mac-romanian" + Case msoEncodingMacUkraine: GetSystemEncoding = "x-mac-ukrainian" + Case msoEncodingMacLatin2: GetSystemEncoding = "x-mac-ce" + Case msoEncodingMacIcelandic: GetSystemEncoding = "x-mac-icelandic" + Case msoEncodingMacTurkish: GetSystemEncoding = "x-mac-turkish" + Case msoEncodingMacCroatia: GetSystemEncoding = "x-mac-croatian" + Case msoEncodingTaiwanCNS: GetSystemEncoding = "x-Chinese-CNS" + Case msoEncodingTaiwanTCA: GetSystemEncoding = "x-cp20001" + Case msoEncodingTaiwanEten: GetSystemEncoding = "x-Chinese-Eten" + Case msoEncodingTaiwanIBM5550: GetSystemEncoding = "x-cp20003" + Case msoEncodingTaiwanTeleText: GetSystemEncoding = "x-cp20004" + Case msoEncodingTaiwanWang: GetSystemEncoding = "x-cp20005" + Case msoEncodingIA5IRV: GetSystemEncoding = "x-IA5" + Case msoEncodingIA5German: GetSystemEncoding = "x-IA5-German" + Case msoEncodingIA5Swedish: GetSystemEncoding = "x-IA5-Swedish" + Case msoEncodingIA5Norwegian: GetSystemEncoding = "x-IA5-Norwegian" + Case msoEncodingUSASCII: GetSystemEncoding = "us-ascii" + Case msoEncodingT61: GetSystemEncoding = "x-cp20261" + Case msoEncodingISO6937NonSpacingAccent: GetSystemEncoding = "x-cp20269" + Case msoEncodingEBCDICGermany: GetSystemEncoding = "IBM273" + Case msoEncodingEBCDICDenmarkNorway: GetSystemEncoding = "IBM277" + Case msoEncodingEBCDICFinlandSweden: GetSystemEncoding = "IBM278" + Case msoEncodingEBCDICItaly: GetSystemEncoding = "IBM280" + Case msoEncodingEBCDICLatinAmericaSpain: GetSystemEncoding = "IBM284" + Case msoEncodingEBCDICUnitedKingdom: GetSystemEncoding = "IBM285" + Case msoEncodingEBCDICJapaneseKatakanaExtended: GetSystemEncoding = "IBM290" + Case msoEncodingEBCDICFrance: GetSystemEncoding = "IBM297" + Case msoEncodingEBCDICArabic: GetSystemEncoding = "IBM420" + Case msoEncodingEBCDICGreek: GetSystemEncoding = "IBM423" + Case msoEncodingEBCDICHebrew: GetSystemEncoding = "IBM424" + Case msoEncodingEBCDICKoreanExtended: GetSystemEncoding = "x-EBCDIC-KoreanExtended" + Case msoEncodingEBCDICThai: GetSystemEncoding = "IBM-Thai" + Case msoEncodingKOI8R: GetSystemEncoding = "koi8-r" + Case msoEncodingEBCDICIcelandic: GetSystemEncoding = "IBM871" + Case msoEncodingEBCDICRussian: GetSystemEncoding = "IBM880" + Case msoEncodingEBCDICTurkish: GetSystemEncoding = "IBM905" + Case msoEncodingEBCDICSerbianBulgarian: GetSystemEncoding = "cp1025" + Case msoEncodingKOI8U: GetSystemEncoding = "koi8-u" + Case msoEncodingISO88591Latin1: GetSystemEncoding = "iso-8859-1" + Case msoEncodingISO88592CentralEurope: GetSystemEncoding = "iso-8859-2" + Case msoEncodingISO88593Latin3: GetSystemEncoding = "iso-8859-3" + Case msoEncodingISO88594Baltic: GetSystemEncoding = "iso-8859-4" + Case msoEncodingISO88595Cyrillic: GetSystemEncoding = "iso-8859-5" + Case msoEncodingISO88596Arabic: GetSystemEncoding = "iso-8859-6" + Case msoEncodingISO88597Greek: GetSystemEncoding = "iso-8859-7" + Case msoEncodingISO88598Hebrew: GetSystemEncoding = "iso-8859-8" + Case msoEncodingISO88599Turkish: GetSystemEncoding = "iso-8859-9" + Case msoEncodingISO885915Latin9: GetSystemEncoding = "iso-8859-15" + Case msoEncodingEuropa3: GetSystemEncoding = "x-Europa" + Case msoEncodingISO88598HebrewLogical: GetSystemEncoding = "iso-8859-8-i" + Case msoEncodingISO2022JPNoHalfwidthKatakana: GetSystemEncoding = "iso-2022-jp" + Case msoEncodingISO2022JPJISX02021984: GetSystemEncoding = "csISO2022JP" + Case msoEncodingISO2022JPJISX02011989: GetSystemEncoding = "iso-2022-jp" + Case msoEncodingISO2022KR: GetSystemEncoding = "iso-2022-kr" + Case msoEncodingISO2022CNTraditionalChinese: GetSystemEncoding = "x-cp50227" + Case msoEncodingEUCJapanese: GetSystemEncoding = "euc-jp" + Case msoEncodingEUCChineseSimplifiedChinese: GetSystemEncoding = "EUC-CN" + Case msoEncodingEUCKorean: GetSystemEncoding = "euc-kr" + Case msoEncodingHZGBSimplifiedChinese: GetSystemEncoding = "hz-gb-2312" + Case msoEncodingSimplifiedChineseGB18030: GetSystemEncoding = "GB18030" + Case msoEncodingISCIIDevanagari: GetSystemEncoding = "x-iscii-de" + Case msoEncodingISCIIBengali: GetSystemEncoding = "x-iscii-be" + Case msoEncodingISCIITamil: GetSystemEncoding = "x-iscii-ta" + Case msoEncodingISCIITelugu: GetSystemEncoding = "x-iscii-te" + Case msoEncodingISCIIAssamese: GetSystemEncoding = "x-iscii-as" + Case msoEncodingISCIIOriya: GetSystemEncoding = "x-iscii-or" + Case msoEncodingISCIIKannada: GetSystemEncoding = "x-iscii-ka" + Case msoEncodingISCIIMalayalam: GetSystemEncoding = "x-iscii-ma" + Case msoEncodingISCIIGujarati: GetSystemEncoding = "x-iscii-gu" + Case msoEncodingISCIIPunjabi: GetSystemEncoding = "x-iscii-pa" + Case msoEncodingUTF7: GetSystemEncoding = "utf-7" + Case msoEncodingUTF8: GetSystemEncoding = "utf-8" '* See note ' *In Windows 10, this is a checkbox in Region settings for ' "Beta: Use Unicode UTF-8 for worldwide language support" - Case msoEncodingUTF8: GetSystemEncoding = "utf-8" - ' Any other language encoding not defined above + ' Any other language encoding not defined above (should be very rare) Case Else ' Attempt to autodetect the language based on the content. ' (Note that this does not work as well on code as it does @@ -357,4 +478,5 @@ Public Function GetSystemEncoding() As String GetSystemEncoding = "_autodetect_all" End Select -End Function \ No newline at end of file +End Function + diff --git a/Version Control.accda.src/modules/modFileAccess.bas b/Version Control.accda.src/modules/modFileAccess.bas index 3f7d78a9..dd90dde1 100644 --- a/Version Control.accda.src/modules/modFileAccess.bas +++ b/Version Control.accda.src/modules/modFileAccess.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modFileAccess" '--------------------------------------------------------------------------------------- ' Module : modFileAccess ' Author : Adam Waller @@ -87,7 +88,7 @@ End Function ' : is found in the file. https://stackoverflow.com/a/53036838/4121863 '--------------------------------------------------------------------------------------- ' -Public Sub WriteFile(strText As String, strPath As String) +Public Sub WriteFile(strText As String, strPath As String, Optional strEncoding As String = "utf-8") Dim strContent As String Dim dblPos As Double @@ -98,7 +99,7 @@ Public Sub WriteFile(strText As String, strPath As String) With New ADODB.Stream .Type = adTypeText .Open - .Charset = "utf-8" + .Charset = strEncoding .WriteText strText ' Ensure that we are ending the content with a vbcrlf If Right(strText, 2) <> vbCrLf Then .WriteText vbCrLf @@ -134,6 +135,27 @@ Public Function GetFileBytes(strPath As String, Optional lngBytes As Long = adRe End Function +'--------------------------------------------------------------------------------------- +' Procedure : WriteBinaryFile +' Author : Adam Waller +' Date : 7/9/2021 +' Purpose : Writes the file bytes to a file (with Unicode path support) +'--------------------------------------------------------------------------------------- +' +Public Function WriteBinaryFile(strPath As String, bteArray() As Byte) + Perf.OperationStart "Write Binary File" + With New ADODB.Stream + .Type = adTypeBinary + .Open + .Write bteArray + VerifyPath strPath + .SaveToFile strPath, adSaveCreateOverWrite + .Close + End With + Perf.OperationEnd +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : DeleteFile ' Author : Adam Waller @@ -206,6 +228,8 @@ Public Sub VerifyPath(strPath As String) Dim intPart As Integer Dim strVerified As String + If strPath = vbNullString Then Exit Sub + Perf.OperationStart "Verify Path" ' Determine if the path is a file or folder @@ -463,4 +487,5 @@ Public Function StripSlash(strText As String) As String Else StripSlash = strText End If -End Function \ No newline at end of file +End Function + diff --git a/Version Control.accda.src/modules/modFunctions.bas b/Version Control.accda.src/modules/modFunctions.bas index e775581d..36a3f336 100644 --- a/Version Control.accda.src/modules/modFunctions.bas +++ b/Version Control.accda.src/modules/modFunctions.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modFunctions" '--------------------------------------------------------------------------------------- ' Module : modFunctions ' Author : Adam Waller @@ -211,7 +212,9 @@ Public Function MsgBox2(strBold As String, Optional strLine1 As String, Optional If varLines(3) = vbNullString Then varLines(3) = Application.VBE.ActiveVBProject.Name strMsg = "MsgBox('" & varLines(0) & "@" & varLines(1) & "@" & varLines(2) & "@'," & intButtons & ",'" & varLines(3) & "')" + Perf.OperationStart "Wait for MsgBox Response" MsgBox2 = Eval(strMsg) + Perf.OperationEnd ' Restore MousePointer (if needed) If intCursor > 0 Then Screen.MousePointer = intCursor @@ -360,6 +363,7 @@ Public Function SortDictionaryByKeys(dSource As Dictionary) As Dictionary ' Build and return new dictionary using sorted keys Set dSorted = New Dictionary + dSorted.CompareMode = dSource.CompareMode For lngCnt = 0 To dSource.Count - 1 dSorted.Add varKeys(lngCnt), dSource(varKeys(lngCnt)) Next lngCnt @@ -455,6 +459,53 @@ Public Function DictionaryEqual(dOne As Dictionary, dTwo As Dictionary) As Boole End Function +'--------------------------------------------------------------------------------------- +' Procedure : CloneDictionary +' Author : Adam Waller +' Date : 3/30/2021 +' Purpose : Recursive function to deep-clone a dictionary object, including nested +' : dictionaries. +' : NOTE: All other object types are cloned as a reference to the same object +' : referenced by the original dictionary, not a new object. +'--------------------------------------------------------------------------------------- +' +Public Function CloneDictionary(dSource As Dictionary, _ + Optional Compare As eCompareMethod2 = ecmSourceMethod) As Dictionary + + Dim dNew As Dictionary + Dim dChild As Dictionary + Dim varKey As Variant + + ' No object returned if source is nothing + If dSource Is Nothing Then Exit Function + + ' Create new dictionary object and set compare mode + Set dNew = New Dictionary + If Compare = ecmSourceMethod Then + ' Use the same compare mode as the original dictionary. + dNew.CompareMode = dSource.CompareMode + Else + dNew.CompareMode = Compare + End If + + ' Loop through keys + For Each varKey In dSource.Keys + If TypeOf varKey Is Dictionary Then + ' Call this function recursively to add nested dictionary + Set dChild = varKey + dNew.Add varKey, CloneDictionary(dChild, Compare) + Else + ' Add key to dictionary + dNew.Add varKey, dSource(varKey) + End If + Next varKey + + ' Return new dictionary + Set CloneDictionary = dNew + +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : Pause ' Author : Adam Waller @@ -614,4 +665,35 @@ Public Function Nz2(varValue, Optional varIfNull) As Variant Nz2 = varValue End If End Select -End Function \ No newline at end of file +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : Repeat +' Author : Adam Waller +' Date : 4/29/2021 +' Purpose : Repeat a string a specified number of times +'--------------------------------------------------------------------------------------- +' +Public Function Repeat(strText As String, lngTimes As Long) As String + Repeat = Replace$(Space$(lngTimes), " ", strText) +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : Coalesce +' Author : Adam Waller +' Date : 5/15/2021 +' Purpose : Return the first non-empty string from an array of string values +'--------------------------------------------------------------------------------------- +' +Public Function Coalesce(ParamArray varStrings()) As String + Dim intString As Integer + For intString = 0 To UBound(varStrings) + If Nz(varStrings(intString)) <> vbNullString Then + Coalesce = varStrings(intString) + Exit For + End If + Next intString +End Function + diff --git a/Version Control.accda.src/modules/modHash.bas b/Version Control.accda.src/modules/modHash.bas index 730766f4..9a619dea 100644 --- a/Version Control.accda.src/modules/modHash.bas +++ b/Version Control.accda.src/modules/modHash.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modHash" '--------------------------------------------------------------------------------------- ' Module : modHash ' Author : Adam Waller, Erik A, 2019; hecon5, 2021 @@ -20,17 +21,17 @@ Option Private Module Option Explicit -Public Declare PtrSafe Function BCryptOpenAlgorithmProvider Lib "BCrypt.dll" ( _ +Private Declare PtrSafe Function BCryptOpenAlgorithmProvider Lib "BCrypt.dll" ( _ ByRef phAlgorithm As LongPtr, _ ByVal pszAlgId As LongPtr, _ ByVal pszImplementation As LongPtr, _ ByVal dwFlags As Long) As Long -Public Declare PtrSafe Function BCryptCloseAlgorithmProvider Lib "BCrypt.dll" ( _ +Private Declare PtrSafe Function BCryptCloseAlgorithmProvider Lib "BCrypt.dll" ( _ ByVal hAlgorithm As LongPtr, _ ByVal dwFlags As Long) As Long -Public Declare PtrSafe Function BCryptCreateHash Lib "BCrypt.dll" ( _ +Private Declare PtrSafe Function BCryptCreateHash Lib "BCrypt.dll" ( _ ByVal hAlgorithm As LongPtr, _ ByRef phHash As LongPtr, pbHashObject As Any, _ ByVal cbHashObject As Long, _ @@ -38,21 +39,21 @@ Public Declare PtrSafe Function BCryptCreateHash Lib "BCrypt.dll" ( _ ByVal cbSecret As Long, _ ByVal dwFlags As Long) As Long -Public Declare PtrSafe Function BCryptHashData Lib "BCrypt.dll" ( _ +Private Declare PtrSafe Function BCryptHashData Lib "BCrypt.dll" ( _ ByVal hHash As LongPtr, _ pbInput As Any, _ ByVal cbInput As Long, _ Optional ByVal dwFlags As Long = 0) As Long -Public Declare PtrSafe Function BCryptFinishHash Lib "BCrypt.dll" ( _ +Private Declare PtrSafe Function BCryptFinishHash Lib "BCrypt.dll" ( _ ByVal hHash As LongPtr, _ pbOutput As Any, _ ByVal cbOutput As Long, _ ByVal dwFlags As Long) As Long -Public Declare PtrSafe Function BCryptDestroyHash Lib "BCrypt.dll" (ByVal hHash As LongPtr) As Long +Private Declare PtrSafe Function BCryptDestroyHash Lib "BCrypt.dll" (ByVal hHash As LongPtr) As Long -Public Declare PtrSafe Function BCryptGetProperty Lib "BCrypt.dll" ( _ +Private Declare PtrSafe Function BCryptGetProperty Lib "BCrypt.dll" ( _ ByVal hObject As LongPtr, _ ByVal pszProperty As LongPtr, _ ByRef pbOutput As Any, _ @@ -131,14 +132,14 @@ End Function '--------------------------------------------------------------------------------------- ' Private Function HashBytes(Data() As Byte, Optional HashingAlgorithm As String = DefaultHashAlgorithm) As Byte() - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next HashBytes = NGHash(VarPtr(Data(LBound(Data))), UBound(Data) - LBound(Data) + 1, HashingAlgorithm) If Catch(9) Then HashBytes = NGHash(VarPtr(Null), UBound(Data) - LBound(Data) + 1, HashingAlgorithm) CatchAny eelCritical, "Error hashing data!", ModuleName & ".HashBytes", True, True End Function Private Function HashString(str As String, Optional HashingAlgorithm As String = DefaultHashAlgorithm) As Byte() - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next HashString = NGHash(StrPtr(str), Len(str) * 2, HashingAlgorithm) If Catch(9) Then HashString = NGHash(StrPtr(vbNullString), Len(str) * 2, HashingAlgorithm) CatchAny eelCritical, "Error hashing string!", ModuleName & ".HashString", True, True @@ -258,11 +259,11 @@ Public Function GetCodeModuleHash(intType As eDatabaseComponentType, strName As Set proj = GetVBProjectForCurrentDB ' Attempt to locate the object in the VBComponents collection - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next Set cmpItem = proj.VBComponents(strPrefix & strName) Catch 9 ' Component not found. (Could be an object with no code module) CatchAny eelError, "Error accessing VBComponent for '" & strPrefix & strName & "'", ModuleName & ".GetCodeModuleHash" - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Output the hash If Not cmpItem Is Nothing Then @@ -277,4 +278,5 @@ Public Function GetCodeModuleHash(intType As eDatabaseComponentType, strName As GetCodeModuleHash = strHash Perf.OperationEnd -End Function \ No newline at end of file +End Function + diff --git a/Version Control.accda.src/modules/modImportExport.bas b/Version Control.accda.src/modules/modImportExport.bas index 447335e8..f9bff27a 100644 --- a/Version Control.accda.src/modules/modImportExport.bas +++ b/Version Control.accda.src/modules/modImportExport.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modImportExport" '--------------------------------------------------------------------------------------- ' Module : modImportExport ' Author : Adam Waller @@ -25,7 +26,7 @@ Public Sub ExportSource(blnFullExport As Boolean) Dim lngCount As Long ' Use inline error handling functions to trap and log errors. - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Can't export without an open database If CurrentDb Is Nothing And CurrentProject.Connection Is Nothing Then Exit Sub @@ -53,14 +54,6 @@ Public Sub ExportSource(blnFullExport As Boolean) Log.Active = True Perf.StartTiming - ' Run any custom sub before export - If Options.RunBeforeExport <> vbNullString Then - Log.Add "Running " & Options.RunBeforeExport & "..." - Perf.OperationStart "RunBeforeExport" - RunSubInCurrentProject Options.RunBeforeExport - Perf.OperationEnd - End If - ' If options (or VCS version) have changed, a full export will be required If (VCSIndex.OptionsHash <> Options.GetHash) Then blnFullExport = True @@ -77,10 +70,21 @@ Public Sub ExportSource(blnFullExport As Boolean) Log.Add "VCS Version " & GetVCSVersion Log.Add IIf(blnFullExport, "Performing Full Export", "Using Fast Save") Log.Add Now - Log.Spacer - Log.Flush End With + ' Run any custom sub before export + If Options.RunBeforeExport <> vbNullString Then + Log.Add "Running " & Options.RunBeforeExport & "..." + Log.Flush + Perf.OperationStart "RunBeforeExport" + RunSubInCurrentProject Options.RunBeforeExport + Perf.OperationEnd + End If + + ' Finish header section + Log.Spacer + Log.Flush + ' Loop through all categories For Each cCategory In GetAllContainers @@ -108,6 +112,9 @@ Public Sub ExportSource(blnFullExport As Boolean) cDbObject.Export CatchAny eelError, "Error exporting " & cDbObject.Name, ModuleName & ".ExportSource", True, True + ' Bail out if we hit a critical error. + If Log.ErrorLevel = eelCritical Then Log.Add vbNullString: GoTo CleanUp + ' Some kinds of objects are combined into a single export file, such ' as database properties. For these, we just need to run the export once. If cCategory.SingleFile Then Exit For @@ -120,9 +127,6 @@ Public Sub ExportSource(blnFullExport As Boolean) Perf.ComponentEnd lngCount End If - ' Bail out if we hit a critical error. - If Log.ErrorLevel = eelCritical Then GoTo CleanUp - Next cCategory ' Run any cleanup routines @@ -139,8 +143,10 @@ Public Sub ExportSource(blnFullExport As Boolean) ' Show final output and save log Log.Spacer - Log.Add "Done. (" & Round(Timer - sngStart, 2) & " seconds)" - + Log.Add "Done. (" & Round(Timer - sngStart, 2) & " seconds)", , False, "green", True + +CleanUp: + ' Add performance data to log file and save file Perf.EndTiming With Log @@ -162,8 +168,6 @@ Public Sub ExportSource(blnFullExport As Boolean) .OptionsHash = Options.GetHash .Save End With - -CleanUp: ' Clear references to FileSystemObject and other objects Set FSO = Nothing @@ -191,7 +195,7 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) Dim strText As String ' Remove later - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' The type of build will be used in various messages and log entries. strType = IIf(blnFullBuild, "Build", "Merge") @@ -227,7 +231,7 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) End If Set Options = Nothing - Options.LoadOptionsFromFile strSourceFolder & "vcs-options.json" + Options.LoadOptionsFromFile StripSlash(strSourceFolder) & PathSep & "vcs-options.json" ' Build original file name for database If blnFullBuild Then @@ -278,33 +282,51 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) ' Rename original file as a backup strBackup = GetBackupFileName(strPath) - If FSO.FileExists(strPath) Then Name strPath As strBackup - Log.Add "Saving backup of original database..." - Log.Add "Saved as " & FSO.GetFileName(strBackup) & "." + If FSO.FileExists(strPath) Then + Log.Add "Saving backup of original database..." + Name strPath As strBackup + Log.Add "Saved as " & FSO.GetFileName(strBackup) & "." + End If ' Create a new database with the original name If blnFullBuild Then + Perf.OperationStart "Create new database" If LCase$(FSO.GetExtensionName(strPath)) = "adp" Then ' ADP project Application.NewAccessProject strPath Else ' Regular Access database - Application.NewCurrentDatabase strPath + Application.NewCurrentDatabase strPath, GetFileFormat(strSourceFolder) + End If + Perf.OperationEnd + If DatabaseOpen Then + Log.Add "Created blank database for import. (v" & CurrentProject.FileFormat & ")" + Else + CatchAny eelCritical, "Unable to create database file", ModuleName & ".Build" + Log.Add "This may occur when building an older database version if the 'New database sort order' (collation) option is not set to 'Legacy'" + GoTo CleanUp End If - Log.Add "Created blank database for import." End If ' Now that we have a new database file, we can load the index. Set VCSIndex = Nothing - ' Remove any non-built-in references before importing from source. - Log.Spacer If blnFullBuild Then + + ' Remove any non-built-in references before importing from source. Log.Add "Removing non built-in references...", False RemoveNonBuiltInReferences + + ' Check for any RunBeforeBuild + If Options.RunBeforeBuild <> vbNullString Then + ' Run any pre-build bootstrapping code + PrepareRunBootstrap + End If + End If - + ' Loop through all categories + Log.Spacer For Each cCategory In GetAllContainers ' Get collection of source files @@ -339,14 +361,28 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) cCategory.Merge CStr(varFile) End If CatchAny eelError, strType & " error in: " & varFile, ModuleName & ".Build", True, True + + ' Bail out if we hit a critical error. + If Log.ErrorLevel = eelCritical Then Log.Add vbNullString: GoTo CleanUp + Next varFile ' Show category wrap-up. Log.Add "[" & colFiles.Count & "]" & IIf(Options.ShowDebug, " " & LCase(cCategory.Category) & " processed.", vbNullString) Perf.ComponentEnd colFiles.Count + + ' After importing modules, we need to save them before adding + ' other properties like descriptions or hidden attributes + If cCategory.ComponentType = edbModule Then SaveAllModules End If Next cCategory - + + ' Initialize forms to ensure that the colors/themes are rendered properly + ' (This must be done after all objects are imported, since subforms/subreports + ' may be involved, and must already exist in the database.) + Log.Add "Initializing forms..." + InitializeForms + ' Run any post-build/merge instructions If blnFullBuild Then If Options.RunAfterBuild <> vbNullString Then @@ -364,22 +400,29 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) ' Perf.OperationEnd 'End If End If - ' Log any errors after build/merge CatchAny eelError, "Error running " & CallByName(Options, "RunAfter" & strType, VbGet), ModuleName & ".Build", True, True ' Show final output and save log Log.Spacer - Log.Add "Done. (" & Round(Timer - sngStart, 2) & " seconds)" - + Log.Add "Done. (" & Round(Timer - sngStart, 2) & " seconds)", , False, "green", True + +CleanUp: + ' Add performance data to log file and save file. Perf.EndTiming With Log .Add vbCrLf & Perf.GetReports, False - .SaveFile FSO.BuildPath(Options.GetExportFolder, strType & ".log") + .SaveFile StripSlash(strSourceFolder) & PathSep & strType & ".log" .Active = False End With + ' Show message if build failed + If Log.ErrorLevel = eelCritical Then + Log.Spacer + Log.Add "Build Failed.", , , "red", True + End If + ' Wrap up build. DoCmd.Hourglass False If Forms.Count > 0 Then @@ -397,7 +440,7 @@ Public Sub Build(strSourceFolder As String, blnFullBuild As Boolean) Else VCSIndex.MergeBuildDate = DateAdd("s", 2, Now) End If - VCSIndex.Save + VCSIndex.Save strSourceFolder Set VCSIndex = Nothing ' Show MessageBox if not using GUI for build. @@ -451,6 +494,24 @@ Private Function GetBackupFileName(strPath As String) As String End Function +'--------------------------------------------------------------------------------------- +' Procedure : GetFileFormat +' Author : Adam Waller +' Date : 5/7/2021 +' Purpose : Return the file format version from the source files, or 0 if not found. +'--------------------------------------------------------------------------------------- +' +Private Function GetFileFormat(strSourcePath As String) As Long + + Dim strPath As String + + ' Attempt to read the file format version from the CurrentProject export + strPath = StripSlash(strSourcePath) & PathSep & "project.json" + GetFileFormat = dNZ(ReadJsonFile(strPath), "Items\FileFormat") + +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : RemoveThemeZipFiles ' Author : Adam Waller @@ -520,4 +581,125 @@ Private Sub CheckForLegacyModules() End If End If -End Sub \ No newline at end of file +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : PrepareRunBootstrap +' Author : Adam Waller +' Date : 4/21/2021 +' Purpose : Prepares the database to run the RunBeforeBuild code by loading all +' : GUID references and importing the module specified in RunBeforeBuild. +' : The bootstrap module (and any other objects) will get replaced from +' : source during the main build, but this allows any custom functions to +' : run before the main build, such as copying missing library files into +' : the same folder as the database. +'--------------------------------------------------------------------------------------- +' +Private Sub PrepareRunBootstrap() + + Dim strModule As String + Dim strName As String + Dim varFile As Variant + Dim cMod As clsDbModule + + ' Update output since there may be some delays + Log.Add "Loading bootstrap..." + Log.Flush + Perf.OperationStart "Bootstrap" + + ' Load all GUID references to support early binding in bootstrap sub + With New clsDbVbeReference + .ImportReferences .Parent.SourceFile, True + End With + + ' Identify and load module for bootstrap code + strModule = Split(Options.RunBeforeBuild, ".")(0) + With New clsDbModule + With .Parent + For Each varFile In .GetFileList + ' Look for matching name + strName = GetObjectNameFromFileName(CStr(varFile)) + If StrComp(strName, strModule, vbTextCompare) = 0 Then + ' This is the module we need to import + Log.Add "Importing bootstrap module '" & strName & "'", False + .Import CStr(varFile) + Exit For + End If + Next varFile + End With + End With + + ' Make sure we actually have a module before we attempt to run the code + If CurrentProject.AllModules.Count = 0 Then + ' Could not find source file + Log.Error eelError, "Could not find source file for " & strModule, ModuleName & ".PrepareRunBootstrap" + Else + ' Important: We need to Run Project.Sub not Project.Module.Sub + strName = Split(Options.RunBeforeBuild, ".")(1) + + ' Run any pre-build bootstrapping code + Log.Add "Running " & Options.RunBeforeBuild + Perf.OperationStart "RunBeforeBuild" + RunSubInCurrentProject strName + Perf.OperationEnd + End If + + ' Now go back and remove all the non built-in references so they come + ' back in the correct order, just in case a library was at a higher level. + Log.Add "Removing non built-in references after running bootstrap", False + RemoveNonBuiltInReferences + + Perf.OperationEnd ' Bootstrap + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : InitializeForms +' Author : Adam Waller +' Date : 7/2/2021 +' Purpose : Opens and closes each form in design view to complete the process of +' : fully rendering the colors and applying the theme. (This is needed to +' : provide a consistent output after importing from source.) +'--------------------------------------------------------------------------------------- +' +Public Sub InitializeForms() + + Dim cont As IDbComponent + Dim frm As IDbComponent + Dim strHash As String + + ' Trap any errors that may occur when opening forms + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next + + ' Use form class so we can update the index later. + Set cont = New clsDbForm + + ' Set up progress bar + Log.ProgMax = cont.GetAllFromDB.Count + + ' Loop through all forms + For Each frm In cont.GetAllFromDB + + ' Open each form in design view + Perf.OperationStart "Initialize Forms" + DoCmd.OpenForm frm.Name, acDesign, , , , acHidden + DoCmd.Close acForm, frm.Name, acSaveNo + Perf.OperationEnd + Log.Increment + + ' Log any errors + CatchAny eelError, "Error while initializing form " & frm.Name, ModuleName & ".InitializeForms" + + ' Update the index, since the save date has changed, but reuse the code hash + ' since we just calculated it after importing the form. + strHash = dNZ(VCSIndex.Item(frm), "hash") + VCSIndex.Update frm, eatImport, strHash + + Next frm + + ' Check for any unhandled errors + CatchAny eelError, "Unhandled error while initializing forms", ModuleName & ".InitializeForms" + +End Sub diff --git a/Version Control.accda.src/modules/modInstall.bas b/Version Control.accda.src/modules/modInstall.bas index 81d01ff1..2f9730a3 100644 --- a/Version Control.accda.src/modules/modInstall.bas +++ b/Version Control.accda.src/modules/modInstall.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modInstall" '--------------------------------------------------------------------------------------- ' Module : modInstall ' Author : Adam Waller @@ -88,7 +89,7 @@ Public Function InstallVCSAddin() As Boolean Dim strSource As String Dim strDest As String - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next strSource = CodeProject.FullName strDest = GetAddinFileName @@ -113,7 +114,7 @@ Public Function InstallVCSAddin() As Boolean ' Copy the file, overwriting any existing file. ' Requires FSO to copy open database files. (VBA.FileCopy may give a permission denied error.) ' We also use FSO to force the deletion of the existing file, if found. - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next If FSO.FileExists(strDest) Then DeleteFile strDest, True FSO.CopyFile strSource, strDest, True If Err Then @@ -123,7 +124,7 @@ Public Function InstallVCSAddin() As Boolean "Please check to be sure that the following file is not in use:" & vbCrLf & strDest, vbExclamation Err.Clear Else - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Register the Menu controls RegisterMenuItem "&VCS Open", "=AddInMenuItemLaunch()" @@ -153,7 +154,7 @@ Public Function UninstallVCSAddin() As Boolean ' Copy the file, overwriting any existing file. ' Requires FSO to copy open database files. (VBA.FileCopy give a permission denied error.) - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next DeleteFile strDest, True On Error GoTo 0 @@ -175,7 +176,7 @@ Public Function UninstallVCSAddin() As Boolean RemoveMenuItem "&Export All Source" ' Remove registry entries - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next DeleteSetting GetCodeVBProject.Name, "Install" DeleteSetting GetCodeVBProject.Name, "Build" DeleteSetting GetCodeVBProject.Name, "Add-In" @@ -232,7 +233,7 @@ Public Function IsAlreadyInstalled() As Boolean ' Check HKLM registry key With New IWshRuntimeLibrary.WshShell ' We should have a value here if the install ran in the past. - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next strTest = .RegRead(strPath) End With @@ -318,7 +319,7 @@ Private Sub RemoveMenuItem(ByVal strName As String, Optional Hive As eHive = ehH strPath = GetAddinRegPath(Hive) & strName & "\" With New IWshRuntimeLibrary.WshShell ' Just in case someone changed some of the keys... - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next .RegDelete strPath & "Expression" .RegDelete strPath & "Library" .RegDelete strPath & "Version" @@ -411,13 +412,13 @@ End Sub '--------------------------------------------------------------------------------------- -' Procedure : HasLegacyInstall +' Procedure : RunUpgrades ' Author : Adam Waller ' Date : 5/27/2020 -' Purpose : Returns true if legacy registry entries are found. +' Purpose : Process upgrade transitions and remove legacy components '--------------------------------------------------------------------------------------- ' -Public Sub CheckForLegacyInstall() +Public Sub RunUpgrades() Dim strName As String Dim strOldPath As String @@ -425,14 +426,14 @@ Public Sub CheckForLegacyInstall() Dim strTest As String Dim objShell As IWshRuntimeLibrary.WshShell - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Legacy HKLM install If InstalledVersion < "3.2.0" Then ' Check for installation in HKLM hive. strOldPath = GetAddinRegPath(ehHKLM) & "&Version Control\Library" Set objShell = New IWshRuntimeLibrary.WshShell - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next strTest = objShell.RegRead(strOldPath) If Err Then Err.Clear On Error GoTo 0 @@ -485,7 +486,21 @@ Public Sub CheckForLegacyInstall() ' Remove legacy RC4 encryption If HasLegacyRC4Keys Then DeleteSetting GetCodeVBProject.Name, "Private Keys" - CatchAny eelError, "Checking for legacy install", ModuleName & ".CheckForLegacyInstall" + ' Use standardized options folder (5/7/2021) + strOldPath = FSO.BuildPath(CodeProject.Path, FSO.GetBaseName(CodeProject.Name)) & ".json" + strNewPath = FSO.BuildPath(CodeProject.Path, "vcs-options.json") + If FSO.FileExists(strOldPath) Then + If FSO.FileExists(strNewPath) Then + ' Remove leftover legacy file + DeleteFile strOldPath + Else + ' Rename to new name + Name strOldPath As strNewPath + End If + End If + + ' Handle any uncaught errors + CatchAny eelError, "Running upgrades before install", ModuleName & ".RunUpgrades" End Sub @@ -500,7 +515,7 @@ End Sub Public Function HasLegacyRC4Keys() Dim strValue As String With New IWshRuntimeLibrary.WshShell - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next strValue = .RegRead("HKCU\SOFTWARE\VB and VBA Program Settings\MSAccessVCS\Private Keys\") HasLegacyRC4Keys = Not Catch(-2147024894) CatchAny eelError, "Checking for legacy RC4 keys", ModuleName & ".HasLegacyRC4Keys" @@ -627,7 +642,7 @@ Public Sub RemoveTrustedLocation(Optional strName As String) strPath = GetTrustedLocationRegPath(strName) With New IWshRuntimeLibrary.WshShell - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next .RegDelete strPath & "Path" .RegDelete strPath & "Date" .RegDelete strPath & "Description" @@ -676,7 +691,7 @@ End Function ' Public Function HasTrustedLocationKey(Optional strName As String) As Boolean With New IWshRuntimeLibrary.WshShell - If DebugMode Then On Error Resume Next Else On Error Resume Next + If DebugMode(True) Then On Error Resume Next Else On Error Resume Next HasTrustedLocationKey = Nz(.RegRead(GetTrustedLocationRegPath(strName) & "Path")) <> vbNullString End With End Function @@ -770,4 +785,5 @@ Public Sub OpenAddinFile(strAddinFileName As String, _ ' Execute script Shell strScriptFile, vbNormalFocus -End Sub \ No newline at end of file +End Sub + diff --git a/Version Control.accda.src/modules/modJsonConverter.bas b/Version Control.accda.src/modules/modJsonConverter.bas index 79987023..01687bb5 100644 --- a/Version Control.accda.src/modules/modJsonConverter.bas +++ b/Version Control.accda.src/modules/modJsonConverter.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modJsonConverter" '' ' VBA-JSON v2.3.1 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON @@ -177,6 +178,8 @@ Public Function ParseJson(ByVal JsonString As String) As Object Dim json_Index As Long json_Index = 1 + Perf.OperationStart "Parse JSON" + ' Remove vbCr, vbLf, and vbTab from json_String JsonString = VBA.Replace(VBA.Replace(VBA.Replace(JsonString, VBA.vbCr, vbNullString), VBA.vbLf, vbNullString), VBA.vbTab, vbNullString) @@ -190,6 +193,9 @@ Public Function ParseJson(ByVal JsonString As String) As Object ' Error: Invalid JSON string Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['") End Select + + Perf.OperationEnd + End Function '' @@ -221,6 +227,8 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp Dim json_Indentation As String Dim json_InnerIndentation As String + Perf.OperationStart "Convert to JSON" + json_LBound = -1 json_UBound = -1 json_IsFirstItem = True @@ -456,6 +464,9 @@ Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitesp ConvertToJson = JsonValue On Error GoTo 0 End Select + + Perf.OperationEnd + End Function ' ============================================= ' @@ -1129,4 +1140,5 @@ Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond) End Function -#End If \ No newline at end of file +#End If + diff --git a/Version Control.accda.src/modules/modObjects.bas b/Version Control.accda.src/modules/modObjects.bas index 276bdbe4..58fcaec6 100644 --- a/Version Control.accda.src/modules/modObjects.bas +++ b/Version Control.accda.src/modules/modObjects.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modObjects" '--------------------------------------------------------------------------------------- ' Module : modObjects ' Author : Adam Waller @@ -92,7 +93,7 @@ End Function '--------------------------------------------------------------------------------------- ' Public Property Get FSO() As Scripting.FileSystemObject - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next If m_FSO Is Nothing Then Set m_FSO = New Scripting.FileSystemObject Set FSO = m_FSO CatchAny eelCritical, "Unable to create Scripting.FileSystemObject", ModuleName & ".FSO" @@ -128,16 +129,18 @@ End Property ' Purpose : Wrapper for use in error handling. '--------------------------------------------------------------------------------------- ' -Public Function DebugMode() As Boolean +Public Function DebugMode(blnTrapUnhandledErrors As Boolean) As Boolean + + Dim blnBreak As Boolean ' Don't reference the property this till we have loaded the options. - If Not m_Options Is Nothing Then DebugMode = m_Options.BreakOnError + If Not m_Options Is Nothing Then blnBreak = m_Options.BreakOnError ' Check for any unhandled errors - If Err.Number <> 0 Then + If (Err.Number <> 0) And blnTrapUnhandledErrors Then - ' Check current debug mode - If DebugMode Then + ' Check current BreakOnError mode + If blnBreak Then ' Stop the code here so we can investigate the source of the error. Debug.Print "Error " & Err.Number & ": " & Err.Description Stop @@ -173,4 +176,7 @@ Public Function DebugMode() As Boolean End If -End Function \ No newline at end of file + ' Return debug mode + DebugMode = blnBreak + +End Function diff --git a/Version Control.accda.src/modules/modRepair.bas b/Version Control.accda.src/modules/modRepair.bas new file mode 100644 index 00000000..3240b71d --- /dev/null +++ b/Version Control.accda.src/modules/modRepair.bas @@ -0,0 +1,151 @@ +Attribute VB_Name = "modRepair" +'--------------------------------------------------------------------------------------- +' Module : modRepair +' Author : Adam Waller +' Date : 6/8/2021 +' Purpose : This module is for functions used to repair conditions in the host +' : database that may impair the functionality of the add-in. +'--------------------------------------------------------------------------------------- +Option Compare Database +Option Private Module +Option Explicit + + +'--------------------------------------------------------------------------------------- +' Procedure : RepairColorDefinitionBlocks +' Author : Adam Waller +' Date : 6/8/2021 +' Purpose : Go through all the form objects and set the color properties so that +' : the theme index lines are correctly stored in the source files. +' : See issue #183 for more details. +'--------------------------------------------------------------------------------------- +' +Public Function RepairColorDefinitionBlocks() + + Dim obj As AccessObject + Dim frm As Form + Dim ctl As Control + Dim sec As Section + Dim intSec As Integer + ' Loop through all forms + For Each obj In CurrentProject.AllForms + ' Open in design view so we can make changes. + DoCmd.OpenForm obj.Name, acDesign, , , , acHidden + Set frm = Forms(obj.Name) + ' Form properties + SetColorProperties frm.Properties + ' Control properties + For Each ctl In frm.Controls + SetColorProperties ctl.Properties + Next ctl + ' Section properties (header, detail, footer, etc...) + For intSec = acDetail To 20 ' Max sections? + On Error Resume Next + Set sec = frm.Section(intSec) + If Err Then + ' Invalid section + Err.Clear + Else + SetColorProperties sec.Properties + End If + Next intSec + ' Save and close form + DoCmd.Close acForm, obj.Name, acSaveYes + Next obj + +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : SetColorProperties +' Author : Adam Waller +' Date : 6/8/2021 +' Purpose : Reapplies the existing color properties to update the internal color +' : definitions. +'--------------------------------------------------------------------------------------- +' +Private Sub SetColorProperties(prpCollection As Properties) + + Dim prp As Property + Dim dItems As Dictionary + Dim dProp As Dictionary + Dim strBase As String + Dim varKey As Variant + Dim strProp As String + Dim lngGradient As Long + + Set dItems = New Dictionary + lngGradient = -1 + + ' Loop through properties, collecting the color-related properties + For Each prp In prpCollection + With prp + If InStr(1, .Name, "Color") > 0 _ + Or EndsWith(.Name, "Shade") _ + Or EndsWith(.Name, "Tint") Then + ' Save this property value + ' Build base name of property + strBase = MultiReplace(.Name, _ + "ThemeColorIndex", vbNullString, _ + "Color", vbNullString, _ + "Shade", vbNullString, _ + "Tint", vbNullString) + ' Save in dictionary using base name as the key + ' Fore + ' |---- ForeColor = 12345 + ' |---- ForeThemeColorIndex = 3 + ' |---- ForeShade = 4 + ' |---- ForeTint = 100 + If Not dItems.Exists(strBase) Then + Set dProp = New Dictionary + dItems.Add strBase, dProp + End If + dItems(strBase)(.Name) = .Value + + ElseIf .Name = "Gradient" Then + ' Save gradient value + lngGradient = .Value + End If + End With + Next prp + ' Now, with all the properties collected, we can check + ' for the presence of the required items to represent the color + For Each varKey In dItems.Keys + Set dProp = dItems(varKey) + strProp = varKey & "ThemeColorIndex" + If dProp.Exists(strProp) Then + ' Has index. Check value + If dProp(strProp) = -1 Then + ' Using absolute color, not theme + ReApplyValue prpCollection, dProp, varKey & "Color" + Else + ' Using theme color + ReApplyValue prpCollection, dProp, varKey & "ThemeColorIndex" + ReApplyValue prpCollection, dProp, varKey & "Shade" + ReApplyValue prpCollection, dProp, varKey & "Tint" + End If + Else + ' No theme index. Use color value + ReApplyValue prpCollection, dProp, varKey & "Color" + End If + Next varKey + + ' Restore any gradient property + If lngGradient >= 0 Then prpCollection("Gradient") = lngGradient + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : ReApplyValue +' Author : Adam Waller +' Date : 6/8/2021 +' Purpose : Reapply the property value to ensure it has been saved. +'--------------------------------------------------------------------------------------- +' +Private Sub ReApplyValue(colProps As Properties, dProps As Dictionary, strName As String) + If dProps.Exists(strName) Then + colProps(strName).Value = colProps(strName).Value + End If +End Sub + diff --git a/Version Control.accda.src/modules/modSanitize.bas b/Version Control.accda.src/modules/modSanitize.bas index 9451e784..07a1e661 100644 --- a/Version Control.accda.src/modules/modSanitize.bas +++ b/Version Control.accda.src/modules/modSanitize.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modSanitize" '--------------------------------------------------------------------------------------- ' Module : modSanitize ' Author : Adam Waller @@ -10,6 +11,11 @@ Option Explicit Private Const ModuleName = "modSanitize" +' Array of lines to skip +Private m_SkipLines() As Long +Private m_lngSkipIndex As Long +Private m_colBlocks As Collection + '--------------------------------------------------------------------------------------- ' Procedure : SanitizeFile @@ -30,10 +36,11 @@ Public Sub SanitizeFile(strPath As String) Dim intIndent As Integer Dim blnIsReport As Boolean Dim blnIsPassThroughQuery As Boolean - Dim sngStartTime As Single + Dim curStart As Currency Dim strTempFile As String + - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next ' Read text from file, and split into lines If HasUcs2Bom(strPath) Then @@ -46,21 +53,30 @@ Public Sub SanitizeFile(strPath As String) strFile = ReadFile(strTempFile) DeleteFile strTempFile Else - strFile = ReadFile(strPath) + If DbVersion <= 4 Then + ' Access 2000 format exports using system codepage + ' See issue #217 + strFile = ReadFile(strPath, GetSystemEncoding) + Else + ' Newer versions export as UTF-8 + strFile = ReadFile(strPath) + End If End If End If + Perf.OperationStart "Sanitize File" varLines = Split(strFile, vbCrLf) - ' Delete original file now so we can write it immediately - ' when the new data has been constructed. - DeleteFile strPath + If Options.SanitizeLevel = eslNone Then GoTo Build_Output + + ' Set up index of lines to skip + ReDim m_SkipLines(0 To UBound(varLines)) As Long + m_lngSkipIndex = 0 + Set m_colBlocks = New Collection ' Initialize concatenation class to include line breaks ' after each line that we add when building new file text. - sngStartTime = Timer - Set cData = New clsConcat - cData.AppendOnAdd = vbCrLf + curStart = Perf.MicroTimer ' Using a do loop since we may adjust the line counter ' during a loop iteration. @@ -72,10 +88,9 @@ Public Sub SanitizeFile(strPath As String) ' Improve performance by reducing comparisons If Len(strTLine) > 3 And blnInsideIgnoredBlock Then - ' Ignore this line + SkipLine lngLine ElseIf Len(strTLine) > 60 And StartsWith(strTLine, "0x") Then ' Add binary data line. No need to test this line further. - cData.Add strLine Else ' Run the rest of the tests Select Case strTLine @@ -84,7 +99,7 @@ Public Sub SanitizeFile(strPath As String) Case "Version =21" ' Change version down to 20 to allow import into Access 2010. ' (Haven't seen any significant issues with this.) - cData.Add "Version =20" + varLines(lngLine) = "Version =20" ' Print settings blocks to ignore Case "PrtMip = Begin", _ @@ -94,6 +109,7 @@ Public Sub SanitizeFile(strPath As String) "PrtDevNamesW = Begin" ' Set flag to ignore lines inside this block. blnInsideIgnoredBlock = True + SkipLine lngLine ' Aggressive sanitize blocks Case "GUID = Begin", _ @@ -102,68 +118,91 @@ Public Sub SanitizeFile(strPath As String) "dbBinary ""GUID"" = Begin" If Options.AggressiveSanitize Then blnInsideIgnoredBlock = True - Else - ' Include these sections - cData.Add strLine + SkipLine lngLine End If - ' Single lines to ignore - Case "NoSaveCTIWhenDisabled =1" + ' Single lines to ignore (#249) + Case "NoSaveCTIWhenDisabled =1", _ + "AllowPivotTableView =0", _ + "AllowPivotChartView =0" + SkipLine lngLine ' Publish option (used in Queries) Case "dbByte ""PublishToWeb"" =""1""", _ "PublishOption =1" - If Not Options.StripPublishOption Then cData.Add strLine + If Options.StripPublishOption Then SkipLine lngLine ' End of block section Case "End" If blnInsideIgnoredBlock Then ' Reached the end of the ignored block. blnInsideIgnoredBlock = False + SkipLine lngLine Else - ' End of included block - cData.Add strLine + ' Check for theme color index + CloseBlock End If ' See if this file is from a report object Case "Begin Report" ' Turn flag on to ignore Right and Bottom lines blnIsReport = True - cData.Add strLine + BeginBlock ' Beginning of main section Case "Begin" + BeginBlock If blnIsPassThroughQuery And Options.AggressiveSanitize Then ' Ignore remaining content. (See Issue #182) + Do While lngLine < UBound(varLines) + SkipLine lngLine + lngLine = lngLine + 1 + Loop Exit Do - Else - cData.Add strLine End If + ' Code section behind form or report object + Case "CodeBehindForm" + ' Keep everything from this point on + Exit Do + Case Else If blnInsideIgnoredBlock Then - ' Skip if we are in an ignored block + ' Skip content inside ignored blocks. + SkipLine lngLine ElseIf StartsWith(strTLine, "Checksum =") Then ' Ignore Checksum lines, since they will change. + SkipLine lngLine ElseIf StartsWith(strTLine, "BaseInfo =") Then ' BaseInfo is used with combo boxes, similar to RowSource. ' Since the value could span multiple lines, we need to ' check the indent level of the following lines to see how ' many lines to skip. + SkipLine lngLine intIndent = GetIndent(strLine) ' Preview the next line, and check the indent level Do While GetIndent(varLines(lngLine + 1)) > intIndent - ' Move + ' Skip previewed line and move to next line + SkipLine lngLine + 1 lngLine = lngLine + 1 Loop ElseIf blnIsReport And StartsWith(strLine, " Right =") Then ' Ignore this line. (Not important, and frequently changes.) + SkipLine lngLine ElseIf blnIsReport And StartsWith(strLine, " Bottom =") Then ' Turn flag back off now that we have ignored these two lines. + SkipLine lngLine blnIsReport = False + ElseIf StartsWith(strTLine, "Begin ") Then + ' Include block type name for controls + BeginBlock Mid$(strTLine, 7) + ElseIf EndsWith(strTLine, " = Begin") Then + BeginBlock Else ' All other lines will be added. - cData.Add strLine + + ' Check for color properties + If InStr(1, strTLine, " =") > 1 Then CheckColorProperties strTLine, lngLine ' Check for pass-through query connection string If StartsWith(strLine, "dbMemo ""Connect"" =""") Then @@ -178,15 +217,19 @@ Public Sub SanitizeFile(strPath As String) lngLine = lngLine + 1 Loop - ' Remove last vbcrlf - cData.Remove Len(vbCrLf) + ' Ensure that we correctly processed the nested block sequence. + If m_colBlocks.Count > 0 Then Log.Error eelWarning, Replace(Replace( _ + "Found ${BlockCount} unclosed blocks after sanitizing ${File}.", _ + "${BlockCount}", m_colBlocks.Count), _ + "${File}", strPath), ModuleName & ".SanitizeFile" + +Build_Output: + ' Build the final output + BuildOutput varLines, strPath ' Log performance Perf.OperationEnd - Log.Add " Sanitized in " & Format$(Timer - sngStartTime, "0.00") & " seconds.", Options.ShowDebug - - ' Replace original file with sanitized version - WriteFile cData.GetStr, strPath + Log.Add " Sanitized in " & Format$(Perf.MicroTimer - curStart, "0.000") & " seconds.", Options.ShowDebug ' Log any errors CatchAny eelError, "Error sanitizing file " & FSO.GetFileName(strPath), ModuleName & ".SanitizeFile" @@ -194,85 +237,386 @@ Public Sub SanitizeFile(strPath As String) End Sub +'--------------------------------------------------------------------------------------- +' Procedure : BuildOutput +' Author : Adam Waller +' Date : 6/4/2021 +' Purpose : Splitting this out into its own sub to reduce complexity. +'--------------------------------------------------------------------------------------- +' +Private Sub BuildOutput(varLines As Variant, strFile As String) + + Dim cData As clsConcat + Dim lngSkip As Long + Dim lngLine As Long + + ' Check index of skipped lines + If m_lngSkipIndex = 0 Then + ' No lines to skip + ReDim m_SkipLines(0 To 0) + m_SkipLines(0) = UBound(varLines) + 1 + Else + ' Trim and sort index array + ReDim Preserve m_SkipLines(0 To m_lngSkipIndex - 1) + QuickSort m_SkipLines + End If + + ' Use concatenation class to maximize performance + Set cData = New clsConcat + With cData + .AppendOnAdd = vbCrLf + + ' Loop through array of lines in source file + For lngLine = 0 To UBound(varLines) + + ' Iterate the sorted skipped lines index to keep up with main loop + ' (Using parallel loops to optimize performance) + If m_SkipLines(lngSkip) < lngLine Then + If lngSkip < UBound(m_SkipLines) Then lngSkip = lngSkip + 1 + End If + + ' Add content, unless the line is flagged to skip + If m_SkipLines(lngSkip) <> lngLine Then .Add CStr(varLines(lngLine)) + + Next lngLine + + ' Remove last vbcrlf + cData.Remove Len(vbCrLf) + + ' Replace original file with sanitized version + WriteFile cData.GetStr, strFile + + End With + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : SkipLine +' Author : Adam Waller +' Date : 6/4/2021 +' Purpose : Skip this line in the final output file +'--------------------------------------------------------------------------------------- +' +Private Function SkipLine(lngLine As Long) + m_SkipLines(m_lngSkipIndex) = lngLine + m_lngSkipIndex = m_lngSkipIndex + 1 +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : BeginBlock +' Author : Adam Waller +' Date : 6/4/2021 +' Purpose : Add a dictionary object to represent the block +'--------------------------------------------------------------------------------------- +' +Private Sub BeginBlock(Optional strType As String) + Dim dBlock As Dictionary + If m_colBlocks Is Nothing Then Set m_colBlocks = New Collection + Set dBlock = New Dictionary + If strType <> vbNullString Then dBlock.Add "Type", strType + m_colBlocks.Add dBlock +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : CloseBlock +' Author : Adam Waller +' Date : 6/4/2021 +' Purpose : Determine if the block used any theme-based dynamic colors that should +' : be skipped in the output file. (See issue #183) +'--------------------------------------------------------------------------------------- +' +Private Sub CloseBlock() + + Dim varBase As Variant + Dim intCnt As Integer + Dim dBlock As Dictionary + Dim strKey As String + + ' Skip if we are not using aggressive color sanitize + If Options.SanitizeColors <= eslNone Then Exit Sub + + ' Bail out if we don't have a block to review + If m_colBlocks.Count = 0 Then Exit Sub + Set dBlock = m_colBlocks(m_colBlocks.Count) + + ' Skip if we are not using themes for this control (UseTheme=0) + ' (Applies to "CommandButton", "Tab", "ToggleButton") + If dBlock.Exists("UseTheme") Then Exit Sub + + ' Build array of base properties + varBase = Array("Back", "AlternateBack", "Border", _ + "Fore", "Gridline", "HoverFore", _ + "Hover", "PressedFore", "Pressed", _ + "DatasheetFore", "DatasheetBack", "DatasheetGridlines") + + ' Loop through properties, checking for index + For intCnt = 0 To UBound(varBase) + strKey = varBase(intCnt) & "ThemeColorIndex" + If dBlock.Exists(strKey) Then + If dBlock(strKey) <> NO_THEME_INDEX Then + ' Check for corresponding color property + strKey = varBase(intCnt) & "Color" + If dBlock.Exists(strKey) Then + ' Skip the dynamic color line + SkipLine dBlock(strKey) + End If + End If + Else + Select Case dBlock("Type") + Case "Section", "FormHeader", "FormFooter" + ' Some controls like form sections don't use color values + ' if a theme index is specified. If a color value exists, + ' we should preserve it. + Case Else + ' Most controls automatically use theme indexes + ' unless otherwise specified. + ' As discussed in #183, this can be affected by incomplete + ' component definition blocks. + If Options.SanitizeColors = eslAdvancedBeta Then + strKey = varBase(intCnt) & "Color" + If dBlock.Exists(strKey) Then + ' Skip the dynamic color line + SkipLine dBlock(strKey) + End If + End If + End Select + End If + Next intCnt + + ' Remove this block + m_colBlocks.Remove m_colBlocks.Count + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : CheckColorProperties +' Author : Adam Waller +' Date : 6/4/2021 +' Purpose : Use an index to reference color properties so we can determine any lines +' : that we need to discard after finishing the block. +'--------------------------------------------------------------------------------------- +' +Private Sub CheckColorProperties(strTLine As String, lngLine As Long) + + Dim dBlock As Dictionary + Dim varParts As Variant + Dim lngCnt As Long + Dim lngID As Long + Dim strID As String + Dim lngValue As Long + Dim lngColor As Long + + ' Skip if not using this option + If Options.SanitizeColors <= eslNone Then Exit Sub + + ' Exit if we are not inside a block + If Not m_colBlocks Is Nothing Then lngCnt = m_colBlocks.Count + If lngCnt = 0 Then Exit Sub + Set dBlock = m_colBlocks(m_colBlocks.Count) + + ' Split on property/value + varParts = Split(strTLine, " =") + Select Case varParts(0) + + ' Theme color index properties + Case "BackThemeColorIndex", "AlternateBackThemeColorIndex", "BorderThemeColorIndex", _ + "ForeThemeColorIndex", "GridlineThemeColorIndex", "HoverForeThemeColorIndex", _ + "HoverThemeColorIndex", "PressedForeThemeColorIndex", "PressedThemeColorIndex", _ + "DatasheetBackThemeColorIndex", "DatasheetForeThemeColorIndex", "DatasheetGridlinesThemeColorIndex" + ' Save to dictionary if using a theme index color + dBlock.Add varParts(0), varParts(1) + + ' Matching color properties + Case "BackColor", "AlternateBackColor", "BorderColor", _ + "ForeColor", "GridlineColor", "HoverForeColor", _ + "HoverColor", "PressedForeColor", "PressedColor", _ + "DatasheetBackColor", "DatasheetForeColor", "DatasheetGridlinesColor" + + ' Check for system color constants + If IsNumeric(varParts(1)) Then lngColor = varParts(1) + If lngColor < 0 Then + ' Using a system color constant or other Access constant value. + ' https://stackoverflow.com/a/30396550/4121863 + ' Leave this color value intact. + Else + ' Save line of color property + dBlock.Add varParts(0), lngLine + End If + + Case "UseTheme" + ' You can tell certain controls to not use the theme. (Buttons, Tabs, Toggles) + If varParts(1) = 0 Then dBlock.Add varParts(0), 0 + + Case Else + ' Check for other related dynamic color properties/indexes + If StartsWith(strTLine, "DatasheetGridlinesColor") Then + ' May include the index number in the property name. (I.e. DatasheetGridlinesColor12 =0) + ' Convert to a more consistent identifier, using the index suffix as the value. + dBlock.Add "DatasheetGridlinesThemeColorIndex", Mid$(varParts(0), 24) + End If + + End Select + +End Sub + + '--------------------------------------------------------------------------------------- ' Procedure : SanitizeXML ' Author : Adam Waller -' Date : 4/27/2020 +' Date : 4/29/2021 ' Purpose : Remove non-essential data that changes every time the file is exported. '--------------------------------------------------------------------------------------- ' -Public Sub SanitizeXML(strPath As String, Options As clsOptions) +Public Sub SanitizeXML(strPath As String) - Dim sngOverall As Single - Dim sngTimer As Single + Dim curStart As Currency Dim cData As clsConcat + Dim strFile As String Dim strText As String + Dim strTLine As String + Dim strLine As String + Dim lngLine As Long Dim rxLine As VBScript_RegExp_55.RegExp Dim objMatches As VBScript_RegExp_55.MatchCollection - Dim stmInFile As ADODB.Stream - Dim blnFound As Boolean + Dim varLines As Variant - If DebugMode Then On Error GoTo 0 Else On Error Resume Next + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next Set cData = New clsConcat + cData.AppendOnAdd = vbCrLf Set rxLine = New VBScript_RegExp_55.RegExp + + ' Read text from file + strFile = ReadFile(strPath) + Perf.OperationStart "Sanitize XML" + curStart = Perf.MicroTimer - ' Timers to monitor performance - sngTimer = Timer - sngOverall = sngTimer - - ' Set line search pattern (To remove generated timestamp) - ' - rxLine.Pattern = "^\s*(?: + ' + With rxLine + .Pattern = "( generated="".+?"")" + If .Test(strLine) Then + ' Replace timestamp with empty string. + Set objMatches = .Execute(strLine) + strText = Replace(strLine, objMatches(0).SubMatches(0), vbNullString, , 1) + cData.Add strText + Else + ' Did not contain a timestamp. Keep the whole line + cData.Add strLine + End If + End With + + ' Remove non-critical single lines that are not consistent between systems + 'Case StartsWith(strTLine, "") + lngLine = lngLine + 1 + strTLine = TrimTabs(Trim$(varLines(lngLine))) + Loop + Else + ' Keep line and continue + cData.Add strLine + End If + + ' Publish to web sections + Case StartsWith(strTLine, " vbTab Then + dblStart = dblPos + Exit For + End If + Next dblPos + + ' Look for trailing tabs + dblEnd = 1 + If Right$(strText, 1) = vbTab Then + For dblPos = Len(strText) To 1 Step -1 + If Mid$(strText, dblPos, 1) <> vbTab Then + dblEnd = dblPos + 1 + Exit For + End If + Next dblPos + Else + ' No trailing tabs + dblEnd = Len(strText) + 1 + End If + + ' Return string + TrimTabs = Mid$(strText, dblStart, dblEnd - dblStart) + +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : StartsWith ' Author : Adam Waller @@ -285,6 +629,19 @@ Public Function StartsWith(strText As String, strStartsWith As String, Optional End Function +'--------------------------------------------------------------------------------------- +' Procedure : EndsWith +' Author : Adam Waller +' Date : 4/29/2021 +' Purpose : See if a string ends with a specified string. +'--------------------------------------------------------------------------------------- +' +Public Function EndsWith(strText As String, strEndsWith As String, Optional Compare As VbCompareMethod = vbBinaryCompare) As Boolean + EndsWith = (StrComp(Right$(strText, Len(strEndsWith)), strEndsWith, Compare) = 0) + 'EndsWith = (InStr(1, strText, strEndsWith, Compare) = len(strtext len(strendswith) 1) +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : GetIndent ' Author : Adam Waller @@ -296,4 +653,43 @@ Public Function GetIndent(strLine As Variant) As Integer Dim strChar As String strChar = Left$(Trim(strLine), 1) If strLine <> vbNullString Then GetIndent = InStr(1, strLine, strChar) - 1 -End Function \ No newline at end of file +End Function + + +'--------------------------------------------------------------------------------------- +' Procedure : FormatXML +' Author : Adam Waller +' Date : 4/22/2021 +' Purpose : Format XML content for consistent and readable output. +'--------------------------------------------------------------------------------------- +' +Private Function FormatXML(strSourceXML As String, _ + Optional blnOmitDeclaration As Boolean) As String + + Dim objReader As SAXXMLReader60 + Dim objWriter As MXXMLWriter60 + + Perf.OperationStart "Format XML" + Set objWriter = New MXHTMLWriter60 + Set objReader = New SAXXMLReader60 + + ' Set up writer + With objWriter + .indent = True + .omitXMLDeclaration = Not blnOmitDeclaration + Set objReader.contentHandler = objWriter + End With + + ' Prepare reader + With objReader + Set .contentHandler = objWriter + .parse strSourceXML + End With + + ' Return formatted output + FormatXML = objWriter.output + Perf.OperationEnd + +End Function + + diff --git a/Version Control.accda.src/modules/modSqlFunctions.bas b/Version Control.accda.src/modules/modSqlFunctions.bas index cb2ea5a1..7a795559 100644 --- a/Version Control.accda.src/modules/modSqlFunctions.bas +++ b/Version Control.accda.src/modules/modSqlFunctions.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modSqlFunctions" '--------------------------------------------------------------------------------------- ' Module : modAdpFunctions ' Author : Adam Waller @@ -158,4 +159,4 @@ Public Function StripDboPrefix(strName As String) As String Else StripDboPrefix = strName End If -End Function \ No newline at end of file +End Function diff --git a/Version Control.accda.src/modules/modTimer.bas b/Version Control.accda.src/modules/modTimer.bas index e2360e68..dbdc1bc8 100644 --- a/Version Control.accda.src/modules/modTimer.bas +++ b/Version Control.accda.src/modules/modTimer.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modTimer" '--------------------------------------------------------------------------------------- ' Module : modTimer ' Author : Adam Waller @@ -94,4 +95,4 @@ Public Sub ExportTimerCallback() ' Launch the export process. modAddIn.AddInMenuItemExport -End Sub \ No newline at end of file +End Sub diff --git a/Version Control.accda.src/modules/modUnitTesting.bas b/Version Control.accda.src/modules/modUnitTesting.bas index 4db2c614..f2b4d2da 100644 --- a/Version Control.accda.src/modules/modUnitTesting.bas +++ b/Version Control.accda.src/modules/modUnitTesting.bas @@ -1,4 +1,5 @@ -Option Compare Database +Attribute VB_Name = "modUnitTesting" +Option Compare Database Option Explicit Option Private Module @@ -195,4 +196,45 @@ Private Sub TestSanitizeConnectionString() Debug.Assert SanitizeConnectionString("test") = "test" Debug.Assert SanitizeConnectionString(vbNullString) = vbNullString -End Sub \ No newline at end of file +End Sub + + +'@TestMethod("CloneDictionary") +Private Sub TestCloneDictionary() + + Dim dFruit As Dictionary + Dim dApple As Dictionary + Dim dClone As Dictionary + + Set dFruit = New Dictionary + Set dApple = New Dictionary + + ' Create text compare dictionary + With dApple + .CompareMode = TextCompare + .Add "SEED1", "Apple Seed" + .Add "seed2", "Apple Seed" + End With + + ' Create binary compare dictionary with nested dictionary + With dFruit + .CompareMode = BinaryCompare + .Add "Apple", dApple + .Add "Orange", "Orange" + .Add "Pear", "Pear" + End With + + ' Clone the dictionary + Set dClone = CloneDictionary(dFruit, ecmSourceMethod) + + ' Test the results to make sure it cloned correctly. + Debug.Assert dClone.Exists("APPLE") = False + Debug.Assert dClone.Exists("Apple") = True + Debug.Assert dClone.Exists("ORANGE") = False + Debug.Assert dClone.Exists("Orange") = True + Debug.Assert dClone("Apple").CompareMode = Scripting.CompareMethod.TextCompare + Debug.Assert dClone("Apple").Exists("seed1") = True + Debug.Assert dClone("Apple").Exists("SEED1") = True + Debug.Assert dClone("Apple").Exists("Seed3") = False + +End Sub diff --git a/Version Control.accda.src/modules/modVCSUtility.bas b/Version Control.accda.src/modules/modVCSUtility.bas index 6145d79c..97cef5aa 100644 --- a/Version Control.accda.src/modules/modVCSUtility.bas +++ b/Version Control.accda.src/modules/modVCSUtility.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modVCSUtility" '--------------------------------------------------------------------------------------- ' Module : modVCSUtility ' Author : Adam Waller @@ -9,6 +10,8 @@ Option Compare Database Option Private Module Option Explicit +Private Const ModuleName = "modVCSUtility" + '--------------------------------------------------------------------------------------- ' Procedure : GetAllContainers @@ -30,7 +33,7 @@ Public Function GetAllContainers() As Collection Set GetAllContainers = New Collection With GetAllContainers ' Shared objects in both MDB and ADP formats - If blnMDB Then .Add New clsDbTheme + .Add New clsDbProject .Add New clsDbVbeProject .Add New clsDbVbeReference .Add New clsDbVbeForm @@ -45,18 +48,19 @@ Public Function GetAllContainers() As Collection .Add New clsAdpTrigger ElseIf blnMDB Then ' These objects only exist in DAO databases + .Add New clsDbProperty .Add New clsDbSharedImage + .Add New clsDbTheme .Add New clsDbImexSpec - .Add New clsDbProperty .Add New clsDbTableDef .Add New clsDbQuery End If ' Additional objects to import after ADP/MDB specific items .Add New clsDbForm .Add New clsDbMacro - .Add New clsDbModule .Add New clsDbReport .Add New clsDbTableData + .Add New clsDbModule If blnMDB Then .Add New clsDbTableDataMacro .Add New clsDbRelation @@ -187,6 +191,10 @@ Public Sub SaveComponentAsText(intType As AcObjectType, _ If FSO.FileExists(strFile) Then DeleteFile strFile FSO.MoveFile strTempFile, strFile End If + + Case acTableDataMacro + ' Table data macros are stored in XML format + If FSO.FileExists(strFile) Then SanitizeXML strFile Case Else ' Handle UCS conversion if needed @@ -308,6 +316,7 @@ Public Sub RemoveNonBuiltInReferences() Dim strName As String Dim ref As Access.Reference + Perf.OperationStart "Clear References" For intCnt = Application.References.Count To 1 Step -1 Set ref = Application.References(intCnt) If Not ref.BuiltIn Then @@ -317,6 +326,7 @@ Public Sub RemoveNonBuiltInReferences() End If Set ref = Nothing Next intCnt + Perf.OperationEnd End Sub @@ -326,7 +336,7 @@ End Sub ' Author : Adam Waller ' Date : 5/5/2020 ' Purpose : Determine the original full path of the database, based on the files -' : in the source folder. +' : in the source folder. (Assumes that options have been loaded) '--------------------------------------------------------------------------------------- ' Public Function GetOriginalDbFullPathFromSource(strFolder As String) As String @@ -334,32 +344,42 @@ Public Function GetOriginalDbFullPathFromSource(strFolder As String) As String Dim strPath As String Dim dContents As Dictionary Dim strFile As String + Dim strExportFolder As String + Dim lngLevel As Long strPath = FSO.BuildPath(strFolder, "vbe-project.json") - If FSO.FileExists(strPath) Then + If Not FSO.FileExists(strPath) Then + Log.Error eelCritical, "Unable to find source file: " & strPath, "GetOriginalDbFullPathFromSource" + GetOriginalDbFullPathFromSource = vbNullString + Else + ' Look up file name from VBE project file name Set dContents = ReadJsonFile(strPath) strFile = dNZ(dContents, "Items\FileName") - If Left$(strFile, 4) = "rel:" Then - ' Use parent folder of source folder - GetOriginalDbFullPathFromSource = BuildPath2(StripSlash(strFolder), "..", FSO.GetFileName(Mid$(strFile, 5))) - ElseIf InStr(1, strFile, "@{") > 0 Then - ' Decryption failed. - ' We might be able to figure out a relative path from the export path. - strPath = FSO.BuildPath(strFolder, "vcs-options.json") - If FSO.FileExists(strPath) Then - Set dContents = ReadJsonFile(strPath) - ' Make sure we can read something, but that the export folder is blank. - ' (Default, which indicates that it would be in the parent folder of the - ' source directory.) - If dNZ(dContents, "Info\AddinVersion") <> vbNullString _ - And dNZ(dContents, "Options\ExportFolder") = vbNullString Then - ' Use parent folder of source directory - GetOriginalDbFullPathFromSource = BuildPath2(StripSlash(strFolder), "..", FSO.GetFileName(strFile)) - End If - End If + + ' Convert legacy relative path + If Left$(strFile, 4) = "rel:" Then strFile = Mid$(strFile, 5) + + ' Trim off any tailing slash + strExportFolder = StripSlash(strFolder) + + ' Check export folder settings + If Options.ExportFolder = vbNullString Then + ' Default setting, using parent folder of source directory + GetOriginalDbFullPathFromSource = strFolder & PathSep & ".." & PathSep & strFile Else - ' Return full path to file. - GetOriginalDbFullPathFromSource = strFile + ' Check to see if we are using an absolute export path (\\* or *:*) + If StartsWith(Options.ExportFolder, PathSep & PathSep) _ + Or (InStr(2, Options.ExportFolder, ":") > 0) Then + ' We don't save the absolute path in source code, so the user + ' needs to determine the file location. + Exit Function + Else + ' Calculate how many levels deep to create original path + lngLevel = UBound(Split(StripSlash(Options.ExportFolder), PathSep)) + If lngLevel < 0 Then lngLevel = 0 ' Handle "\" to export in current folder. + GetOriginalDbFullPathFromSource = strExportFolder & PathSep & _ + Repeat(".." & PathSep, lngLevel) & strFile + End If End If End If @@ -541,4 +561,64 @@ Public Sub ClearOrphanedSourceFiles(cType As IDbComponent, ParamArray StrExtensi If oFolder.Files.Count = 0 Then oFolder.Delete True Perf.OperationEnd -End Sub \ No newline at end of file +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : CompileAndSaveAllModules +' Author : Adam Waller +' Date : 7/10/2021 +' Purpose : Compile and save the modules in the current database +'--------------------------------------------------------------------------------------- +' +Public Sub CompileAndSaveAllModules() + Perf.OperationStart "Compile/Save Modules" + ' Make sure we are running this in the CurrentDB, not the CodeDB + Set VBE.ActiveVBProject = GetVBProjectForCurrentDB + DoCmd.RunCommand acCmdCompileAndSaveAllModules + DoEvents + Perf.OperationEnd +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : SaveAllModules +' Author : Adam Waller +' Date : 7/14/2021 +' Purpose : Loop through the VBE modules and classes, saving each one in Access. +'--------------------------------------------------------------------------------------- +' +Public Sub SaveAllModules() + + Dim proj As VBProject + Dim cmp As VBComponent + Dim colNames As Collection + Dim varMod As Variant + + If DebugMode(True) Then On Error GoTo 0 Else On Error Resume Next + + Set proj = GetVBProjectForCurrentDB + Set colNames = New Collection + + ' Loop through and collect list of names. + ' (We can't save here, or we will get an error) + For Each cmp In proj.VBComponents + Select Case cmp.Type + Case vbext_ct_ClassModule, vbext_ct_StdModule + If (cmp.Saved = False) Then colNames.Add cmp.Name + End Select + Next cmp + + ' Set the active project to the CODE (add-in) project BEFORE + ' attempting to save the modules. Otherwise we will hit errors. + Set VBE.ActiveVBProject = GetCodeVBProject + + ' Save each item in the list + For Each varMod In colNames + On Error GoTo 0 + DoCmd.Save acModule, varMod + Next varMod + + CatchAny eelError, "Error saving VBA modules", ModuleName & ".SaveAllModules" + +End Sub diff --git a/Version Control.accda.src/modules/modZip.bas b/Version Control.accda.src/modules/modZip.bas index ae905c69..b7bf9af0 100644 --- a/Version Control.accda.src/modules/modZip.bas +++ b/Version Control.accda.src/modules/modZip.bas @@ -1,3 +1,4 @@ +Attribute VB_Name = "modZip" '--------------------------------------------------------------------------------------- ' Module : modZip ' Author : Adam Waller @@ -143,4 +144,5 @@ Public Sub ExtractFromZip(strZip As String, strDestFolder As String, _ Loop End If -End Sub \ No newline at end of file +End Sub + diff --git a/Version Control.accda.src/nav-pane-groups.json b/Version Control.accda.src/nav-pane-groups.json index ba324fc4..36d4e3b1 100644 --- a/Version Control.accda.src/nav-pane-groups.json +++ b/Version Control.accda.src/nav-pane-groups.json @@ -9,7 +9,7 @@ { "Name": "Custom", "Flags": 0, - "Position": 3, + "Position": 2, "Groups": [ { "Name": "Custom Group 1", diff --git a/Version Control.accda.src/project.json b/Version Control.accda.src/project.json new file mode 100644 index 00000000..00e38af0 --- /dev/null +++ b/Version Control.accda.src/project.json @@ -0,0 +1,10 @@ +{ + "Info": { + "Class": "clsDbProject", + "Description": "Project" + }, + "Items": { + "FileFormat": 12, + "RemovePersonalInformation": false + } +} diff --git a/Version Control.accda.src/vbe-project.json b/Version Control.accda.src/vbe-project.json index 8bea58c1..0b5edb2f 100644 --- a/Version Control.accda.src/vbe-project.json +++ b/Version Control.accda.src/vbe-project.json @@ -5,10 +5,11 @@ }, "Items": { "Name": "MSAccessVCS", - "Description": "Version 3.3.17 deployed on 3/19/2021", - "FileName": "rel:Version Control.accda", - "HelpFile": "100746350", + "Description": "Version 3.4.5 deployed on 6/17/2021", + "FileName": "Version Control.accda", + "HelpFile": "", "HelpContextId": 0, + "ConditionalCompilationArguments": "", "Mode": 0, "Protection": 0, "Type": 100 diff --git a/Version Control.accda.src/vbe-references.json b/Version Control.accda.src/vbe-references.json index 1865fcd6..2a14187d 100644 --- a/Version Control.accda.src/vbe-references.json +++ b/Version Control.accda.src/vbe-references.json @@ -22,7 +22,7 @@ }, "Office": { "GUID": "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}", - "Version": "2.7" + "Version": "2.5" }, "Scripting": { "GUID": "{420B2830-E718-11CF-893D-00A0C9054228}", @@ -35,6 +35,10 @@ "VBScript_RegExp_55": { "GUID": "{3F4DACA7-160D-11D2-A8E9-00104B365C9F}", "Version": "5.5" + }, + "MSXML2": { + "GUID": "{F5078F18-C551-11D3-89B9-0000F81FE221}", + "Version": "6.0" } } } diff --git a/Version Control.accda.src/vcs-options.json b/Version Control.accda.src/vcs-options.json index 1e030698..7f949af9 100644 --- a/Version Control.accda.src/vcs-options.json +++ b/Version Control.accda.src/vcs-options.json @@ -1,6 +1,6 @@ { "Info": { - "AddinVersion": "3.3.17", + "AddinVersion": "3.4.14", "AccessVersion": "14.0 32-bit" }, "Options": { @@ -35,22 +35,25 @@ "ForceImportOriginalQuerySQL": false, "SaveTableSQL": true, "StripPublishOption": true, - "AggressiveSanitize": true, + "SanitizeColors": 3, + "SanitizeLevel": 2, "ExtractThemeFiles": false, "TablesToExportData": { - "USysRibbons": { + "USysRegInfo": { "Format": "Tab Delimited" }, - "USysRegInfo": { + "USysRibbons": { "Format": "Tab Delimited" } }, "RunBeforeExport": "", "RunAfterExport": "", + "RunBeforeBuild": "", "RunAfterBuild": "", "ShowVCSLegacy": true, "HashAlgorithm": "SHA256", "UseShortHash": true, - "BreakOnError": true + "BreakOnError": true, + "PreserveRubberDuckID": false } } diff --git a/Wiki/Documentation.md b/Wiki/Documentation.md index e88aa5c2..eae6c595 100644 --- a/Wiki/Documentation.md +++ b/Wiki/Documentation.md @@ -14,4 +14,4 @@ _Note: This aspect of building the database from source files is still under dev The options dialog can be opened from the main screen by click the `Options` button. Internally the options are stored in a `vcs-options.json` file in the path of the exported source code. These options are loaded and used when exporting to source files, or when building a project from source. -[Click here for detailed Options Information](https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Options). \ No newline at end of file +[Click here for detailed Options Information](Options). diff --git a/Wiki/Editing-and-Contributing.md b/Wiki/Editing-and-Contributing.md index be84911f..42578145 100644 --- a/Wiki/Editing-and-Contributing.md +++ b/Wiki/Editing-and-Contributing.md @@ -1,42 +1,36 @@ So, you like the Addin. And you want to contribute more. Hurrah! # BLUF: -1. Make Pull Requests (PRs) on the "Dev" branch: it's the in use branch. Stable is not actively worked on, and is used to provide a "stable" base while we work out any kinks in the dev branch. -2. If you can, do not pull directly from your "dev" fork: make a working branch in your repository. This will help ensure reduced conflicts, and to ensure we know what the scope of your PR is more easily. +1. Make Pull Requests (PRs) on the `Dev` branch: it's the in use / development branch. Master / Stable is not actively worked on, and is used to provide a "stable" base while we work out any kinks in the `dev` branch. +2. If you can, do not pull directly from your `dev` fork: make a working branch in your repository. This will help ensure reduced conflicts, and to ensure we know what the scope of your PR is more easily. 3. Keep scope of PRs within a single area of focus: if you fixed two bugs, please keep them to separated PRs. Using specific work branches will help. This will ensure we don't get co-mingled issues, and is a lot cleaner to ensure we don't introduce new bugs from fixing others. # Details: If you directly edit Access Add-ins (such as this one) within the "opening" Access file, changes will not be saved. -This is a double edged sword: it allows easy debugging, and trying things out which might otherwise ruin files. Downside is that once you close the session, it will discard any settings. +This is a double edged sword: it allows easy debugging, and trying things out which might otherwise ruin files. Downside is that once you close the session, it will discard any settings or changes you made. This is a nice way to load "extras" for users and ensure they don't break things for everyone else. -If you want to make changes to your Addin (and contribute those to others!), do this: -1. Fork this [MS Access Repository](https://github.com/joyfullservice/msaccess-vcs-integration) into your GitHub account repos. +If you want to make changes to this Add-In (and contribute them!), do this: +1. Fork this [MS Access Add-In Repository](https://github.com/joyfullservice/msaccess-vcs-integration) into your GitHub account repos. ![image](https://user-images.githubusercontent.com/54177882/117137254-6d378280-ad77-11eb-923e-a7a876611fed.png) 2. Clone your fork to a local repository alongside your other Access dev repos on your machine. 3. Some put theirs alongside some other Access repositories they utilize. - ![image](https://user-images.githubusercontent.com/54177882/117137620-f353c900-ad77-11eb-9680-047cabd002da.png) -3. Switch to "Dev" Branch: We suggest renaming YOUR "dev" branch to something local to you, especially if you still use some of the legacyVCS tools. I named my local fork of this branch to "dev-addin". -4. Connect a second remote to the joyfullservice/msaccess-vcs-integration (upstream) repository. This way you can track progress on the upstream ( joyfullservice/msaccess-vcs-integration) repository. There may be changes you don't want to pull into yours, or you may want customization not present on the upstream (in some environments, users have specific changes required to ensure proper integration in their security environment and/or configurations that shouldn't be default for everyone). - +3. Switch to `Dev` Branch: We suggest renaming YOUR `dev` branch to something local to you, especially if you still use some of the legacyVCS tools. I named my local fork of this branch to `dev-addin`. +4. Connect a second remote to the `joyfullservice/msaccess-vcs-integration` (upstream) repository. This way you can track progress on the upstream ( joyfullservice/msaccess-vcs-integration) repository. There may be changes you don't want to pull into yours, or you may want customization not present on the upstream (in some environments, users have specific changes required to ensure proper integration in their security environment and/or configurations that shouldn't be default for everyone). ![image](https://user-images.githubusercontent.com/54177882/117138802-84776f80-ad79-11eb-97f0-e55e62f59c38.png) +5. Go into your new local repo, and launch the Addin directly. -5. Go into your new local repo, and launch the Addin directly. 6. Make changes, use the add-in to export the add-in code, and commit/push/pull request just like any other repository. - ![image](https://user-images.githubusercontent.com/54177882/117139316-197a6880-ad7a-11eb-95ca-1cb3c12a712f.png) 7. To edit the VCS, click the "x" button instead of the "install" on the loading form. - ![image](https://user-images.githubusercontent.com/54177882/117144981-990b3600-ad80-11eb-8413-db75258dc9ca.png) 8. To edit forms for the VCS, open in "Design View"; their loading code / functions won't run. - ![image](https://user-images.githubusercontent.com/54177882/117144997-9c9ebd00-ad80-11eb-8c31-a56ed881fc18.png) - 9. See above for PR guidelines. diff --git a/Wiki/FAQs.md b/Wiki/FAQs.md new file mode 100644 index 00000000..aaea9429 --- /dev/null +++ b/Wiki/FAQs.md @@ -0,0 +1,68 @@ +- [Is there a way to use a ribbon with this add-in?](#is-there-a-way-to-use-a-ribbon-with-this-add-in) +- [Why are some issues/ideas considered out of scope for this project?](#why-are-some-issuesideas-considered-out-of-scope-for-this-project) +- [Why am I seeing a large number of "changed" files after building my project from source?](#why-am-i-seeing-a-large-number-of-changed-files-after-building-my-project-from-source) +- [Will this fork eventually be merged back into the upstream repository?](#will-this-fork-eventually-be-merged-back-into-the-upstream-repository) + +On this page you will find answers and guidance relating to common questions that come up when using this add-in. + +## Is there a way to use a ribbon with this add-in? +We would love to use a custom ribbon to make the controls and features of this add-in more intuitive, but thus far I have been unable to create a working com add-in for Microsoft Access. See [issue #34](https://github.com/joyfullservice/msaccess-vcs-integration/issues/34) for more details. + +## Why are some issues/ideas considered out of scope for this project? +This is described in more detail on [Project-Scope](./Project-Scope.md). + +## Why am I seeing a large number of "changed" files after building my project from source? +Before going into some technical details, let me clarify that in normal operation, this add-in is designed to be able to build a project with minimal, if any, changes showing between builds. + +There are several possible reasons for files showing as changed even when you didn't intentionally change the source objects. Click the heading to view additional information that may be relevant in your case. + +
+Form source files are showing changes in color values + +This issue usually comes up in relation to a project being built on different computers, due to how Access internally stores the color values. + +The number you see in the exported source file is affected by the current color profile and settings used by your monitor to represent the colors you see on your screen. + + Example: + + ```diff + - BackColor =11830108 + + BackColor =12874308 + ``` + +
+ +
+Changes in form dimension values + +This often happens when exporting/building on computers with different screen resolutions or monitor arrangements. These changes can often be ignored, since those values are dynamically generated. + +In most cases it would be a bit too complex to try to build the logic to determine this from the source file content, to the extend that we could discard unneeded values. One place that we have successfully done this is on the `Right` and `Bottom` dimensions of reports. (See the `SanitizeFile` function for details.) +
+ +
+Query source is significantly different + +You may observe that the source file for a query seems to be updated to an entirely different file structure. This has to do with whether the query was saved in a compiled state in the database. If you have issues with this frequently causing changes in source files, you may want to review your workflow for editing queries. (Saving via the designer will save one way, while using the SQL view will save another way.) +
+ +
+Case changes in VBA code + +If you see a lot of changes happening with the capitalization of variables, keyworks, properties and methods, this may be caused by the VBA editor trying to enforce consistency in the naming. This is an internal feature to VBA that some people hate and some people love. There isn't much that you can do about this behavior in the VBA IDE, but the following tips have been helpful to me in minimizing the negative effects: +* Use Pascal casing for procedures, methods and properties +* Use Hungarian notation (or similar) for variable names (i.e `lngTotal`, `strCaption`) + +While many modern languages and IDE editors tend towards `camelCase` names, this just doesn't work as nicely in VBA. I personally find better success sticking with the original naming conventions the IDE was designed to work with. + +Example ("**c**" > "**C**"): + + ```diff + - cancel = True + + Cancel = True + ``` + +
+ +## Will this fork eventually be merged back into the upstream repository? +The **joyfullservice** branch is a near complete rewrite of the original project. It is unlikely that it will ever be merged back into the upstream project of `msaccess-vcs-integration/msaccess-vcs-integration`. This upstream link is primarily maintained to give visibility to this branch for those that may be searching for an add-in based version control solution for Microsoft Access. diff --git a/Wiki/Home.md b/Wiki/Home.md index 61f71afc..93052b86 100644 --- a/Wiki/Home.md +++ b/Wiki/Home.md @@ -1,11 +1,15 @@ # Version Control System On this project wiki you will find some more detailed information about the installation and usage of the Version Control System for Microsoft Access. -## [[Documentation]] +## [Documentation](Documentation) Describes how to install and use this tool, as well as detailed descriptions of the options provided. -## [[Supported Objects]] +### [FAQs](FAQs) + +## [Supported Objects]() Here you can find an extensive list of what is and isn't supported by this system. -## [[Editing and Contributing]] -If you really like this addin, you're welcome to contribute. Here's some guidelines for doing so, and suggested practices. \ No newline at end of file +## [Editing and Contributing](Editing-and-Contributing) +If you really like this addin, you're welcome to contribute. Here's some guidelines for doing so, and suggested practices. + +## [Project Scope](Project-Scope) \ No newline at end of file diff --git a/Wiki/Installation.md b/Wiki/Installation.md index 8c85f1dc..e28ebe41 100644 --- a/Wiki/Installation.md +++ b/Wiki/Installation.md @@ -1,5 +1,16 @@ # Install -Simply download `Version.Control.zip` from the [Releases](https://github.com/joyfullservice/msaccess-vcs-integration/releases) page, extract `Version Control.accda` and run the file. + 1. Download `Version_Control_vXXX.zip` from the [Releases](https://github.com/joyfullservice/msaccess-vcs-integration/releases) page. + 2. Double-click the `Version Control.accda` file from the zip archive. + 3. (Optional) Adjust any install options. (see below) + 4. Click **Install Add-In**. + +![Install Form Image](img/install.jpg) + +## Install Options +*NOTE:* None of these are required to use the add-in, but they are designed to allow for easier installation and use. + +* **Trust Add-In Folder (Default ON)** During installation, the dedicated VCS Addin installation folder will be added as a trusted location in Microsoft Access/Office. This allows Access to load the Add-In correctly in some protected setups, and will enable faster loading in others. The default install location is `C:\Users\%username%\AppData\Roaming\MSAccessVCS\` +* **Open after install to trust add-in file (Default OFF)** In some protected computing environments (I.e. Government, Banking), the Add-In file must also be opened from the installed folder to be properly trusted. Checking this option will cause the add-in file to be opened immediately after install, and give you the opportunity to trust the file. # Uninstall -[Click here for Uninstall Instructions](https://github.com/joyfullservice/msaccess-vcs-integration/wiki/Options#uninstalling) \ No newline at end of file +[Click here for Uninstall Instructions]() \ No newline at end of file diff --git a/Wiki/Options.md b/Wiki/Options.md index 7aeb613a..6f599cd8 100644 --- a/Wiki/Options.md +++ b/Wiki/Options.md @@ -1,52 +1,72 @@ -# Options - The options dialog can be opened from the main screen by click the `Options` button. Internally the options are stored in a `vcs-options.json` file in the path of the exported source code. These options are loaded and used when exporting to source files, or when building a project from source. -## General +## General Tab +![General Options Tab](img/options-general.jpg) + + * **Show Detailed Output** *Default: OFF* - Enable verbose output of each step; useful when you're real curious. This may slow down Export and Build operations. + + * **Debug VBA Errors** *Default: OFF* - (Advanced Users/Add-in Developers) If an unexpected error occurs in the add-in code, stop and open the VBA IDE to do further debugging. This may be helpful when debugging a problem with the add-in, or reviewing an existing issue. *You should generally keep this off unless you're trying to find the source of a bug, or doing development work on the add-in.* + + * **Show Legacy Prompts** *Default: ON* - If you're upgrading from the integrated version of this project, there may be legacy VCS modules left in your database project that are no longer needed. This will notify you if these legacy modules are found. If you would like to keep them in your project, you can uncheck this option to turn off the notification. + + * *Checked* - Prompts are on. + * *Cleared* - Prompts are off. +

+ + * **Hash Algorithm** *Default: SHA256* - You may choose the hashing algorithm here. This may affect build time if you choose a more complex option. (Hashes are used to help determine whether source files have changed between import/export operations.) + + * **Use short hashes in index** *Default: ON* - If checked, `git` style hashes (first 7 characters) will be used in the file index. *NOTE: This was done to improve readability and reduce file size, but you can always uncheck this box if you want to store the full hash.* -![](img/options-general.jpg) +

+

- * **Export Folder** - I like to keep this relative to the project, but it can be customized here. +## Export Tab +![Export Options Tab](img/options-export.jpg) + + * **Export Folder** *Default: [Blank]* - I like to keep this relative to the project, but it can be customized here.

Click to expand folder options + * *[Blank]* - Use default name of `/[database.accdb].src`, i.e. `/Test.accdb.src` * *Relative Path* - Prefix folder name with a backslash. For example, to export source into a subfolder called `Source`, you would enter `\Source` in this box. * *Absolute Path* - You may also use a full path name to a folder. I.e. `W:\Git\Projects\Vehicles Database` * *Placeholder* - In combination with the above options, you may also use a `%dbName%` [placeholder](https://github.com/joyfullservice/msaccess-vcs-integration/issues/139) to use the database filename in a custom path. I.e. `\src\%dbName%.src\` +
+ + * **Use Fast Save** *Default: ON* - Major performance gain with small changes to large projects. This attempts to only export the objects that have changed since the last export. This especially helps to not have to export forms and reports if they have not changed. - * **Use Fast Save** - Major performance gain with small changes to large projects. This attempts to only export the objects that have changed since the last export. This especially helps to not have to export forms and reports if they have not changed. - * **Show Detailed Output** - Show more verbose messages while running. - * **Strip out Publish Option** - Strips out some *Publish to Web* settings from source files that are irrelevant to most projects. - * **Aggressive Sanitize** - Removes object GUIDs, name maps, and other data that changes from build to build. (These values are recreated automatically when importing source files.) From a development perspective, these are more like binary artifacts that just add noise to the version control commits, reducing clarity on actual code changes. - * **Export Theme Files** - Microsoft Access theme files (*.thmx) are actually zip files containing XML and other files that define the specifics of a theme. If you are customizing a theme, you may wish to extract these files so your changes can be tracked in Version Control. - * **Save Report Print Settings** - Saves a copy of the print configuration for reports and forms. This is especially useful when you are using specific printer settings. The output is stored in human-readable json. By default, page orientation and paper size are saved with each report, but additional options are also available. + * **Sanitize Level** *Default: Aggressive* - Set level for sanitize routines to remove noise. Sanitizing allows you to remove noise from your exported files. Turn it off to export raw file outputs. Santization routines are checked to ensure most do not affect building of exported files.
Click to expand levels... + + **_NOTE:_ If you set Sanitize level to "*None (Off)*", none of the Sanitize Options (Sanitize Color, Strip out publish, etc.) will be used.** + * *None (Off)* Turn off sanitization, export raw files. These may not import properly, but they may be useful when trying to troubleshoot. _**Note:** Files will still be converted to UTF-8 or System Codepage encoding depending on Access Version in this mode._ + * *Basic* Only basic sanitization to ensure reliable rebuilding of files. + * *Aggressive* Remove most exported noise (GUIDs, the like). Removes object GUIDs, name maps, and other data that changes from build to build. (These values are recreated automatically when importing source files.) From a development perspective, these are more like binary artifacts that just add noise to the version control commits, reducing clarity on actual code changes. + * *Advanced (Beta)* Remove as much as possible. This may lead to unexpected changes upon rebuilding. Features that are still in testing or confirmed to be tempermental may be introduced here prior to being implemented. **_User beware!_** +

-
- Show Advanced Printer Options... + * **Sanitize Colors** *Default: Basic* - Removes color exports on forms where themes are used, or other situations where the color can be correctly set upon rebuild. These colors export differently in different machines, or different settings and are largely noise. ***NOTE:* The most aggressive options may lead to unexpected color changes on forms!** -![](img/options-printer-settings.jpg) + * **Strip out Publish Option** *Default: ON* - Strips out some *Publish to Web* settings from source files that are irrelevant to most projects. + * **Save Printer Settings** *Default: ON* - Saves a copy of the print configuration for reports and forms. This is especially useful when you are using specific printer settings. The output is stored in human-readable json. By default, page orientation and paper size are saved with each report, but additional options are also available.
Show Advanced Printer Options... +![Printer Settings Options Screen Image](img/options-printer-settings.jpg) Note that these options only determine what is *Exported* and saved to the JSON file. Any settings defined in the JSON source file will be applied when the report object is Imported, regardless of the currently specified options. +

+

+

-
+ * **Save Query SQL** *Default: ON* - In addition to the Access object, this option exports a copy of just the SQL code from queries. I find this much more readable than the source of the Access Object when reviewing what I actually changed on the SQL side. (The Access object includes other information relating to the layout of the query designer.) - * **Save Query SQL** - In addition to the Access object, this option exports a copy of just the SQL code from queries. I find this much more readable than the source of the Access Object when reviewing what I actually changed on the SQL side. (The Access object includes other information relating to the layout of the query designer.) - * **Save Table SQL** - In addition to the Access object, this creates a SQL statement like what you would use to create the table. Here again I find this easier to see at a glance what changed in the actual structure of the table between versions. - - * **Use git integration** - (Work in Progress, only part of dev at the moment). + * **Save Table SQL** *Default: ON* - In addition to the Access object, this creates a SQL statement like what you would use to create the table. Here again I find this easier to see at a glance what changed in the actual structure of the table between versions. - * **Show Legacy Prompts** - If you have the integrated VCS as part of your Access Project, the Addin will remind you those modules aren't needed. - * *Checked* - Prompts are on. - * *Cleared* - Prompts are off. + * **Extract Theme Files** *Default OFF* - Extract the contents of the `*.thmx` files. Microsoft Office Theme files `*.thmx` are actually zip files containing XML and other files that define the specifics of a theme. If you are customizing a theme, you may wish to extract these files so your changes can be tracked in Version Control. + + * **Use git integration** - (Work in Progress, only part of dev at the moment). -* **Security** - Define the security level you would like to use for potentially sensitive information like file paths, user or domain name. - * *None* - (Default) Just export everything like it is stored in the database. - * *Encrypt* - Use a basic encryption to mask sensitive data. - * *Remove* - Remove the sensitive data from the export files. (Note that you may not be able to successfully build from source if you choose this option.) * **Run Sub Before Export** - Run a VBA subroutine before exporting the source code. This can be used to clean up temporary data, mask sensitive information, or anything else you want to do. This will be called using `Application.Run`. + * **Run Sub After Export** - Similar to the option above, this allows you to specify a VBA subroutine to run *after* exporting the source code. ## Table Data - -![](img/options-table-data.jpg) +![Table Data Options Tab Image](img/options-table-data.jpg) The Table Data tab allows you to selectively include certain tables from which to include table ***data*** in version control. The *structure* of the tables is already being saved, but this gives you the additional option of saving the *data* itself. @@ -55,35 +75,37 @@ An example of where you might use this would be a table that defines options or The concept here is that you are selecting the table from which you want to save data, choosing the format to use, and clicking Update to save the changes. * **Show Hidden** - List hidden tables in the current database. - + * **Show System** - List system tables in the current database. - + * **Show Other** - List table names that are saved in the options, but do not exist in the current database. You can also manually add table names to your `vcs-options.json` file. (Add a table through the interface first, and use the same syntax.) - + * **Selected Table** - This highlights which table you have selected to set the export format. To add a table that is not listed, click the [*Other...*]() link. + * **Data to Export** - Select the format to use for the exported data. * *Tab Delimited* - Separate values with tab character. This is a good format to use when importing to Microsoft Excel, or reading the values in Version Control files. * *XML Format* - Select this option for the most complete and robust representation of the data. It is harder to read in source files, but should import back in to accurate recreate the original data. * *No Data* - Don't save data for this table. +

* **Update** - Save output specification changes for the selected table. You should see the Save Data column update in the list of tables when you click the Update button. ## Build - -![](img/options-build.jpg) +![Build Options Tab Image](img/options-build.jpg) One of the unique features of this add-in is the ability to build a fully functioning database completely from source files. This allows multi-user development in a more typical development workflow where source files are exported and combined to build the end product. * **Force import of original SQL for queries** - In some cases, such as when a query contains a subquery, _AND_ has been modified in the visual query designer, it may be imported incorrectly and unable to run. For these cases we have added an option to overwrite the .SQL property with the SQL that we saved separately during the export. See [issue #76](https://github.com/joyfullservice/msaccess-vcs-integration/issues/76) for further details. - * **Run Sub After Build** - Run the specified subroutine after building the project from source files. This is a great way to extend the add-in to add any custom post-build functionality that you need after the build finishes. For example, you might use this to trigger an automated testing routine that verifies that the application is fully functional. + * **Run Sub Before Build** - Same as below, except before the build. - * Save output specification changes for the selected table. You should see the Save Data column update in the list of tables when you click the Update button. + * **Run Sub After Build** - Run the specified subroutine after building the project from source files. This is a great way to extend the add-in to add any custom post-build functionality that you need after the build finishes. For example, you might use this to trigger an automated testing routine that verifies that the application is fully functional. -## Settings (Global) +## Settings These affect your system at large; not just the currently open Access Project. -![](img/options-settings.jpg) +![Settings Options Tab](img/options-settings.jpg) +### System Defaults * **Save as Default** - Save the current options as default for new projects. Anytime you export source and a `vcs-options.json` file does not already exist, it will use the default options that you have specified. @@ -91,5 +113,7 @@ These affect your system at large; not just the currently open Access Project. * **Clear Defaults** - Reset all the options to the default settings specified in the add-in source code. If you click this button, then the *Save as Default* button, it will reset any user customizations to the default options. -## Uninstalling +### Remove Add-In + * **Uninstall** - Uninstalls the add-in from your user profile, including all saved defaults and encryption keys. +[Click here for Install / Uninstall Instructions](Installation) \ No newline at end of file diff --git a/Wiki/Project-Scope.md b/Wiki/Project-Scope.md new file mode 100644 index 00000000..60268037 --- /dev/null +++ b/Wiki/Project-Scope.md @@ -0,0 +1,22 @@ +I personally believe that one of the keys to the long-term success of this project is establishing a clearly defined scope of what it is intended to do, and sticking to that scope. + +## Guiding Principles +Since much of this could be considered subjective archetecutual design decisions, let me outline some of the guiding principles that I am trying to keep in the forefront of this project. +* The **fundemental purpose** of this add-in is two-fold: + * **Export** database objects as source files + * **Import**/**Build**/**Merge** source files to database objects +* The goal is to replicate the original database as **closely as possible** when building from source. +* The add-in is **not intended** to fix/repair/enhance the target database, other than what is necessary to perform the basic functions of exporting and importing source files. +* The **user interface** should be as intuitive and user-friendly as possible. It should be both efficient for the expert, and easy for the beginner. Flexibility without clutter. +* The tool should be **extensible**, where internal code can be added to carry out additional tasks outside the scope of this add-in. + + +## How Features are Evaluated +Features add complexity, and complexity increases [cost of carry](https://martinfowler.com/bliki/Yagni.html). Great features are welcomed and make this tool better every year. Unecessary or overly complex features bog down the project and slow progress on more important issues. + +**Feature considerations:** +* How many users does this affect? Will this benefit everyone, or just a single user with a really unique setup? +* How complex is the feature? Is it limited to changes in a few areas of code, or are we talking about a significant refactoring? +* Do functionality changes cause any risks for those currently using the add-in in production environments? + +If your idea didn't get implemented, don't take it personally. :-) Remember, this is an ongoing work in progress, and someone has to make the hard decisions about what gets added and what doesn't. diff --git a/Wiki/Supported-Objects.md b/Wiki/Supported-Objects.md index 4f520782..41294c1d 100644 --- a/Wiki/Supported-Objects.md +++ b/Wiki/Supported-Objects.md @@ -23,62 +23,65 @@ If you are looking for a specific type of object or property that you want to ex The *Testing* column indicates whether a test item and testing code has been created in the *Testing.accdb* database to verify that particular item after import from source code. *Test location* indicates where to find the object in the database. -|Type |Export|Import|VBA Class| -|-----------------------|:----:|:----:|---------| +|Type |Export|Import|VBA Class| +|-------------------------|:----:|:----:|---------| |💼 **TABLES** -|Access Table |✔️|✔️|clsDbTableDef -|Extended Properties |✔️|✔️|clsDbTableDef -|Table SQL |✔️|✔️|clsDbTableDef -|Linked Table |✔️|✔️|clsDbTableDef -|Linked PrimaryKey |✔️|✔️|clsDbTableDef -|ODBC Table |✔️|✔️|clsDbTableDef -|Linked Structure |✔️|✔️|clsDbTableDef -|Table Data (TDF) |✔️|✔️|clsDbTableData -|Table Data (XML) |✔️|✔️|clsDbTableData -|Table Data Macros |✔️|✔️|clsDbTableDataMacro +|Access Table |✔️|✔️|clsDbTableDef +|Extended Properties |✔️|✔️|clsDbTableDef +|Table SQL |✔️|✔️|clsDbTableDef +|Linked Table |✔️|✔️|clsDbTableDef +|Linked PrimaryKey |✔️|✔️|clsDbTableDef +|ODBC Table |✔️|✔️|clsDbTableDef +|Linked Structure |✔️|✔️|clsDbTableDef +|Table Data (TDF) |✔️|✔️|clsDbTableData +|Table Data (XML) |✔️|✔️|clsDbTableData +|Table Data Macros |✔️|✔️|clsDbTableDataMacro |💼 **QUERIES** -|Designer Layout |✔️|✔️|clsDbQuery -|SQL Output |✔️|✔️|clsDbQuery -|Pass Through Queries |✔️|✔️|clsDbQuery +|Designer Layout |✔️|✔️|clsDbQuery +|SQL Output |✔️|✔️|clsDbQuery +|Pass Through Queries |✔️|✔️|clsDbQuery |💼 **FORMS** -|Form objects |✔️|✔️|clsDbForm -|Saved print settings |✔️|✔️|clsDbReport|Optional +|Form objects |✔️|✔️|clsDbForm +|Saved print settings |✔️|✔️|clsDbReport|Optional |💼 **REPORTS** -|Report objects |✔️|✔️|clsDbReport -|Saved print settings |✔️|✔️|clsDbReport|Optional +|Report objects |✔️|✔️|clsDbReport +|Saved print settings |✔️|✔️|clsDbReport|Optional |💼 **MACROS** -|Macro objects |✔️|✔️|clsDbMacro +|Macro objects |✔️|✔️|clsDbMacro |💼 **MODULES** -|Standard Modules |✔️|✔️|clsDbModule -|Class Modules |✔️|✔️|clsDbModule -|Object Modules |✔️|✔️|clsDbModule +|Standard Modules |✔️|✔️|clsDbModule +|Class Modules |✔️|✔️|clsDbModule +|Object Modules |✔️|✔️|clsDbModule +|Hidden VBE Attributes |✔️|✔️|clsDbModule |💼 **DATABASE** -|DAO Properties |✔️|✔️|clsDbProperty -|Project Properties |✔️|✔️|clsDbProjProperty -|Object Descriptions |✔️|✔️|clsDbDocument -|Application Icon |✔️|✔️|clsDbProperty -|Embedded Images |✔️|✔️|clsDbSharedImage -|Saved Imp/Exp Specs |✔️|✔️|clsDbSavedSpec -|System Imp/Exp Specs |✔️|✔️|clsDbImexSpec -|Summary Properties |✔️|✔️|clsDbDocument -|Relationships |✔️|✔️|clsDbRelation -|Nav. Pane Groups |✔️|✔️|clsNavPaneGroup -|Embedded Office Theme |✔️|✔️|clsDbTheme +|DAO Properties |✔️|✔️|clsDbProperty +|Project Properties |✔️|✔️|clsDbProjProperty +|Object Descriptions |✔️|✔️|clsDbDocument +|Hidden Attribute |✔️|✔️|clsDbHiddenAttribute +|Remove Personal Info |✔️|✔️|clsDbProject +|Application Icon |✔️|✔️|clsDbProperty +|Embedded Images |✔️|✔️|clsDbSharedImage +|Saved Imp/Exp Specs |✔️|✔️|clsDbSavedSpec +|System Imp/Exp Specs |✔️|✔️|clsDbImexSpec +|Summary Properties |✔️|✔️|clsDbDocument +|Relationships |✔️|✔️|clsDbRelation +|Nav. Pane Groups |✔️|✔️|clsDbNavPaneGroup +|Embedded Office Theme(s) |✔️|✔️|clsDbTheme |💼 **VBE PROJECT** -|Project Properties |✔️|✔️|clsDbVbeProject -|Compilation Arguments |✔️|✔️|clsDbVbeProject -|GUID References |✔️|✔️|clsDbVbeReference -|File/Lib References |✔️|✔️|clsDbVbeReference -|Forms 2.0 documents |✔️|✔️|clsDbVbeForm +|Project Properties |✔️|✔️|clsDbVbeProject +|Compilation Arguments |✔️|✔️|clsDbVbeProject +|GUID References |✔️|✔️|clsDbVbeReference +|File/Lib References |✔️|✔️|clsDbVbeReference +|Forms 2.0 documents |✔️|✔️|clsDbVbeForm |💼 **ADP PROJECTS** -|Connection Settings |||clsDbProjProperty -|SQL Functions |✔️|n/a|clsAdpFunction -|SQL Views |✔️|n/a|clsAdpServerView -|SQL Stored Procedures |✔️|n/a|clsAdpProcedure -|SQL Tables |✔️|n/a|clsAdpTable -|SQL Triggers |✔️|n/a|clsAdpTrigger +|Connection Settings |||clsDbProjProperty +|SQL Functions |✔️|n/a|clsAdpFunction +|SQL Views |✔️|n/a|clsAdpServerView +|SQL Stored Procedures |✔️|n/a|clsAdpProcedure +|SQL Tables |✔️|n/a|clsAdpTable +|SQL Triggers |✔️|n/a|clsAdpTrigger |💼 **OTHER** -|Saved VCS Options |✔️|✔️|clsOptions +|Saved VCS Options |✔️|✔️|clsOptions ## ADP Projects diff --git a/Wiki/img/install.jpg b/Wiki/img/install.jpg new file mode 100644 index 00000000..0aff9cdf Binary files /dev/null and b/Wiki/img/install.jpg differ diff --git a/Wiki/img/main.jpg b/Wiki/img/main.jpg new file mode 100644 index 00000000..f3b90ca8 Binary files /dev/null and b/Wiki/img/main.jpg differ diff --git a/Wiki/img/options-build.jpg b/Wiki/img/options-build.jpg index 69dac84c..412976eb 100644 Binary files a/Wiki/img/options-build.jpg and b/Wiki/img/options-build.jpg differ diff --git a/Wiki/img/options-export.jpg b/Wiki/img/options-export.jpg new file mode 100644 index 00000000..af29a212 Binary files /dev/null and b/Wiki/img/options-export.jpg differ diff --git a/Wiki/img/options-general.jpg b/Wiki/img/options-general.jpg index 2494c60f..12c7c827 100644 Binary files a/Wiki/img/options-general.jpg and b/Wiki/img/options-general.jpg differ