diff --git a/.gitignore b/.gitignore index f9fbdbc..3e1405a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,4 @@ -# Version Control Add-in Binaries +# Version Control Add-in Binaries # (This should be built from source and not committed to version control) *.mdb *.accd[aber] @@ -11,8 +11,19 @@ *.log # The local VCS index file is paired with the database and should not -# be comitted to version control. -vcs-index.json +# be committed to version control. +vcs-index.* # Ignore any dotenv files (used for external database connections) *.env +logs/ +test-results/ +.env.* +!.env*.example + +# Local MCP server configuration (contains machine-specific paths) +.mcp.json + +# Agent docs generated by the VCS add-in on every export +source/AGENTS.md +source/vcs-agent-docs/ diff --git a/README.md b/README.md index dc94f09..4982c60 100644 --- a/README.md +++ b/README.md @@ -7,3 +7,46 @@ Details: https://wiki.access-codelib.net/ACLib-Import-Wizard [Video: create new Access application](https://access-codelib.net/videos/ACLib-Import-Wizard/neue-anwendung-erstellen/) [Video: Import from GitHub repository](https://access-codelib.net/videos/ACLib-Import-Wizard/ACLib-Import-Wizard_ImportFromGitHub.mp4) + +#### Automation API +The wizard can be used without UI, e.g. from scripts or AI agents. +`API` returns a JSON string: + +```vba +Application.Run ".API", "", "", "" + +' Example (installed add-in) +Application.Run Environ("APPDATA") & "\Microsoft\AddIns\ACLibImportWizard.API", _ + "Resolve", "form/filter/FilterControlManager.cls", "mode=missing" +``` + +| Command | Arguments | Result | +|---|---|---| +| `GetVersion` | - | add-in and API version | +| `GetConfig` | [Options] | configured repositories, resulting source | +| `ListInstalled` | - | ACLib modules in the current database (`` from the codelib block) | +| `Resolve` | Files, [Options] | read only: files incl. dependencies, references, tests, planned action (`import`/`skip`/`overwrite`), missing files | +| `Import` | Files, [Options] | imports like the wizard form; imported/skipped files, missing dependencies, added/removed references, messages | + +* Files: `"data/SqlTools.cls;text/String2.cls"` +* Options: `"mode=missing|all|selected;tests=0|1;examples=0|1;source=config|local|github;repo=owner/name@branch"` + (defaults: `mode=missing`, `tests=0`, `examples=0`, `source=config` = local repository if configured, otherwise GitHub `AccessCodeLib/AccessCodeLib@master`) + +Result: `{"ok":true,...}` or `{"ok":false,"error":{"number":...,"source":"...","description":"..."}}` (no message boxes). + +```json +{"ok":true,"source":"local","repository":"C:\CodeLib\AccessCodeLib\\","mode":"missing","tests":false,"examples":false, + "files":[{"name":"String2","file":"text/String2.cls","type":"class","action":"import"}, + {"name":"_AccessCodeLib_license","file":"_codelib/license.bas","type":"module","action":"skip"}, + {"name":"StringTools","file":"text/StringTools.bas","type":"module","action":"import"}], + "missing":[],"references":{"added":[],"removed":[]},"executes":[],"messages":[]} +``` + +Notes: +* The add-in and the target database must be in trusted locations. Otherwise Access shows a + security prompt (the call blocks) or disables code. +* `Import` stops before importing if a selected file is not available. Missing dependencies are + skipped (as in the wizard form) and listed in `missing`. +* Compile the project after `Import` and check the result. +* With [msaccess-vcs-mcp](https://github.com/joyfullservice/msaccess-vcs-mcp): + `vcs_call_vba(database_path=".accdb", function_name=".API", args=["Resolve", "text/String2.cls"])` diff --git a/source/dbs-properties.json b/source/dbs-properties.json index 1c2eb72..a476623 100644 --- a/source/dbs-properties.json +++ b/source/dbs-properties.json @@ -68,6 +68,10 @@ "Value": 0, "Type": 4 }, + "Default Zoom Level": { + "Value": 100, + "Type": 4 + }, "DesignMasterID": { "Value": "", "Type": 15 @@ -101,7 +105,7 @@ "Type": 4 }, "NavPane Width": { - "Value": 591, + "Value": 545, "Type": 4 }, "Never Cache": { diff --git a/source/documents.json b/source/documents.json index 377b1b3..80c8531 100644 --- a/source/documents.json +++ b/source/documents.json @@ -6,16 +6,26 @@ "Items": { "Databases": { "SummaryInfo": { - "Author": "Josef Pötzl", - "Comments": "Access add-in for importing elements from the Access Code Library.", - "Company": "access-codelib.net", - "Manager": "Josef Pötzl", - "Title": "Access Code Library - Import Wizard" - } - }, - "Tables": { - "tab1DS": { - "Description": "Tabelle mit einem DS (ist in Abfragen hilfeich)" + "Author": { + "Type": 10, + "Value": "Josef Pötzl" + }, + "Comments": { + "Type": 10, + "Value": "Access add-in for importing elements from the Access Code Library." + }, + "Company": { + "Type": 10, + "Value": "access-codelib.net" + }, + "Manager": { + "Type": 10, + "Value": "Josef Pötzl" + }, + "Title": { + "Type": 10, + "Value": "Access Code Library - Import Wizard" + } } } } diff --git a/source/forms/ACLibImportWizardForm.bas b/source/forms/ACLibImportWizardForm.form similarity index 77% rename from source/forms/ACLibImportWizardForm.bas rename to source/forms/ACLibImportWizardForm.form index 786fc6b..d4d6809 100644 --- a/source/forms/ACLibImportWizardForm.bas +++ b/source/forms/ACLibImportWizardForm.form @@ -14,13 +14,13 @@ Begin Form PictureAlignment =2 DatasheetGridlinesBehavior =3 GridY =10 - Width =10214 + Width =10260 DatasheetFontHeight =11 ItemSuffix =95 - Left =4178 - Top =3030 - Right =16673 - Bottom =12195 + Left =1000 + Top =1000 + Right =50000 + Bottom =50000 OnUnload ="[Event Procedure]" RecSrcDt = Begin 0x212b6fd80e9ce340 @@ -119,7 +119,7 @@ Begin Form GridlineShade =65.0 End Begin Section - Height =8196 + Height =8220 Name ="Detail" Begin Begin CommandButton @@ -175,10 +175,6 @@ Begin Form ControlTipText ="Select local root directory" HorizontalAnchor =1 - LayoutCachedLeft =9698 - LayoutCachedTop =548 - LayoutCachedWidth =10095 - LayoutCachedHeight =945 Overlaps =1 End Begin CommandButton @@ -210,10 +206,6 @@ Begin Form UnicodeAccessKey =83 HorizontalAnchor =1 - LayoutCachedLeft =9695 - LayoutCachedTop =1350 - LayoutCachedWidth =10092 - LayoutCachedHeight =1747 End Begin TextBox TabStop = NotDefault @@ -233,10 +225,6 @@ Begin Form AfterUpdate ="[Event Procedure]" HorizontalAnchor =2 - LayoutCachedLeft =4709 - LayoutCachedTop =593 - LayoutCachedWidth =9605 - LayoutCachedHeight =908 Begin Begin Label OverlapFlags =93 @@ -247,10 +235,6 @@ Begin Form Name ="Label5" Caption ="Local root directory of the code library:" Tag ="LANG:" - LayoutCachedLeft =120 - LayoutCachedTop =593 - LayoutCachedWidth =4695 - LayoutCachedHeight =908 End End End @@ -270,10 +254,6 @@ Begin Form UnicodeAccessKey =65 HorizontalAnchor =2 - LayoutCachedLeft =120 - LayoutCachedTop =1375 - LayoutCachedWidth =9141 - LayoutCachedHeight =1690 Begin Begin Label OverlapFlags =93 @@ -284,10 +264,6 @@ Begin Form Name ="Label11" Caption ="&Attach file" Tag ="LANG:" - LayoutCachedLeft =120 - LayoutCachedTop =1035 - LayoutCachedWidth =1530 - LayoutCachedHeight =1350 End End End @@ -308,10 +284,6 @@ Begin Form ControlTipText ="Attach file from text line" HorizontalAnchor =1 - LayoutCachedLeft =9202 - LayoutCachedTop =1350 - LayoutCachedWidth =9599 - LayoutCachedHeight =1747 End Begin ListBox OverlapFlags =247 @@ -339,10 +311,6 @@ Begin Form HorizontalAnchor =2 VerticalAnchor =2 - LayoutCachedLeft =120 - LayoutCachedTop =2114 - LayoutCachedWidth =10099 - LayoutCachedHeight =5346 Begin Begin Label OverlapFlags =85 @@ -353,10 +321,6 @@ Begin Form Name ="Label13" Caption ="Selected &files:" Tag ="LANG:" - LayoutCachedLeft =127 - LayoutCachedTop =1770 - LayoutCachedWidth =2407 - LayoutCachedHeight =2085 End End End @@ -377,10 +341,6 @@ Begin Form HorizontalAnchor =1 VerticalAnchor =1 - LayoutCachedLeft =7042 - LayoutCachedTop =7456 - LayoutCachedWidth =9247 - LayoutCachedHeight =8011 Overlaps =1 End Begin OptionGroup @@ -397,10 +357,6 @@ Begin Form HorizontalAnchor =2 VerticalAnchor =1 - LayoutCachedLeft =120 - LayoutCachedTop =5520 - LayoutCachedWidth =10102 - LayoutCachedHeight =8136 Begin Begin Label OverlapFlags =215 @@ -412,10 +368,6 @@ Begin Form Caption ="Import &mode" Tag ="LANG:" VerticalAnchor =1 - LayoutCachedLeft =229 - LayoutCachedTop =5577 - LayoutCachedWidth =6814 - LayoutCachedHeight =5892 End Begin OptionButton OverlapFlags =87 @@ -425,10 +377,6 @@ Begin Form Name ="Option17" VerticalAnchor =1 - LayoutCachedLeft =359 - LayoutCachedTop =6350 - LayoutCachedWidth =619 - LayoutCachedHeight =6590 Begin Begin Label OverlapFlags =247 @@ -440,10 +388,6 @@ Begin Form Caption ="do not overwrite existing elements" Tag ="LANG:" VerticalAnchor =1 - LayoutCachedLeft =584 - LayoutCachedTop =6320 - LayoutCachedWidth =6824 - LayoutCachedHeight =6635 End End End @@ -455,10 +399,6 @@ Begin Form Name ="Option19" VerticalAnchor =1 - LayoutCachedLeft =359 - LayoutCachedTop =6740 - LayoutCachedWidth =619 - LayoutCachedHeight =6980 Begin Begin Label OverlapFlags =247 @@ -470,10 +410,6 @@ Begin Form Caption ="overwrite existing elements" Tag ="LANG:" VerticalAnchor =1 - LayoutCachedLeft =589 - LayoutCachedTop =6710 - LayoutCachedWidth =6814 - LayoutCachedHeight =7025 End End End @@ -485,10 +421,6 @@ Begin Form Name ="Option21" VerticalAnchor =1 - LayoutCachedLeft =359 - LayoutCachedTop =7595 - LayoutCachedWidth =619 - LayoutCachedHeight =7835 Begin Begin Label OverlapFlags =247 @@ -500,10 +432,6 @@ Begin Form Caption ="import only the selected file(s)" Tag ="LANG:" VerticalAnchor =1 - LayoutCachedLeft =584 - LayoutCachedTop =7565 - LayoutCachedWidth =6824 - LayoutCachedHeight =7880 End End End @@ -519,10 +447,6 @@ Begin Form Caption ="Automatically fill in missing dependencies" Tag ="LANG:" VerticalAnchor =1 - LayoutCachedLeft =292 - LayoutCachedTop =5970 - LayoutCachedWidth =6817 - LayoutCachedHeight =6255 End Begin Label OverlapFlags =215 @@ -534,10 +458,6 @@ Begin Form Caption ="no dependency check" Tag ="LANG:" VerticalAnchor =1 - LayoutCachedLeft =290 - LayoutCachedTop =7216 - LayoutCachedWidth =6815 - LayoutCachedHeight =7501 End Begin Label Visible = NotDefault @@ -555,10 +475,6 @@ Begin Form Tag ="LANG:" HorizontalAnchor =1 VerticalAnchor =1 - LayoutCachedLeft =7042 - LayoutCachedTop =7020 - LayoutCachedWidth =9937 - LayoutCachedHeight =7335 End Begin TextBox OverlapFlags =85 @@ -582,10 +498,6 @@ Begin Form HorizontalAnchor =1 VerticalAnchor =1 - LayoutCachedLeft =7042 - LayoutCachedTop =5640 - LayoutCachedWidth =7302 - LayoutCachedHeight =5880 Begin Begin Label OverlapFlags =215 @@ -598,10 +510,6 @@ Begin Form Tag ="LANG:" HorizontalAnchor =1 VerticalAnchor =1 - LayoutCachedLeft =7318 - LayoutCachedTop =5580 - LayoutCachedWidth =10048 - LayoutCachedHeight =5895 End End End @@ -632,10 +540,6 @@ Begin Form BorderColor =0 Name ="txtCodeModuleDescription" - LayoutCachedLeft =6986 - LayoutCachedTop =2436 - LayoutCachedWidth =10106 - LayoutCachedHeight =5346 End Begin TextBox Locked = NotDefault @@ -652,10 +556,6 @@ Begin Form BorderColor =0 Name ="txtCodeModuleName" - LayoutCachedLeft =6986 - LayoutCachedTop =2114 - LayoutCachedWidth =10106 - LayoutCachedHeight =2399 End Begin ToggleButton OverlapFlags =85 @@ -673,10 +573,6 @@ Begin Form Tag ="LANG:" HorizontalAnchor =1 - LayoutCachedLeft =6982 - LayoutCachedTop =1800 - LayoutCachedWidth =10087 - LayoutCachedHeight =2073 End Begin CommandButton OverlapFlags =215 @@ -693,10 +589,6 @@ Begin Form HorizontalAnchor =1 VerticalAnchor =1 - LayoutCachedLeft =9364 - LayoutCachedTop =7456 - LayoutCachedWidth =9919 - LayoutCachedHeight =8011 Overlaps =1 End Begin ComboBox @@ -726,10 +618,6 @@ Begin Form AllowValueListEdits =0 InheritValueList =0 - LayoutCachedLeft =9581 - LayoutCachedTop =56 - LayoutCachedWidth =10142 - LayoutCachedHeight =284 ThemeFontIndex =-1 BackThemeColorIndex =-1 BorderThemeColorIndex =-1 @@ -751,10 +639,6 @@ Begin Form Name ="ogRepositorySource" AfterUpdate ="[Event Procedure]" - LayoutCachedLeft =53 - LayoutCachedTop =53 - LayoutCachedWidth =9467 - LayoutCachedHeight =507 Begin Begin OptionButton OverlapFlags =87 @@ -763,10 +647,6 @@ Begin Form OptionValue =2 Name ="Option56" - LayoutCachedLeft =3878 - LayoutCachedTop =195 - LayoutCachedWidth =4138 - LayoutCachedHeight =435 Begin Begin Label OverlapFlags =247 @@ -776,10 +656,6 @@ Begin Form Height =293 Name ="Label57" Caption ="GitHub (web access)" - LayoutCachedLeft =4108 - LayoutCachedTop =165 - LayoutCachedWidth =6029 - LayoutCachedHeight =458 End End End @@ -792,10 +668,6 @@ Begin Form OptionValue =6 Name ="Option91" - LayoutCachedLeft =6180 - LayoutCachedTop =195 - LayoutCachedWidth =6545 - LayoutCachedHeight =435 Begin Begin Label OverlapFlags =247 @@ -805,10 +677,6 @@ Begin Form Height =293 Name ="Label92" Caption ="Packages" - LayoutCachedLeft =6410 - LayoutCachedTop =165 - LayoutCachedWidth =7423 - LayoutCachedHeight =458 End End End @@ -820,10 +688,6 @@ Begin Form OptionValue =1 Name ="Option58" - LayoutCachedLeft =7507 - LayoutCachedTop =195 - LayoutCachedWidth =7767 - LayoutCachedHeight =435 Begin Begin Label OverlapFlags =247 @@ -833,10 +697,6 @@ Begin Form Height =293 Name ="Label59" Caption ="Local repository" - LayoutCachedLeft =7737 - LayoutCachedTop =165 - LayoutCachedWidth =9380 - LayoutCachedHeight =458 End End End @@ -850,10 +710,6 @@ Begin Form Height =293 Name ="Label60" Caption ="Access Code Library repository source:" - LayoutCachedLeft =120 - LayoutCachedTop =158 - LayoutCachedWidth =3690 - LayoutCachedHeight =451 End Begin TextBox TabStop = NotDefault @@ -870,10 +726,6 @@ Begin Form AfterUpdate ="[Event Procedure]" HorizontalAnchor =2 - LayoutCachedLeft =5212 - LayoutCachedTop =593 - LayoutCachedWidth =10085 - LayoutCachedHeight =908 Begin Begin Label OverlapFlags =255 @@ -884,10 +736,6 @@ Begin Form Name ="Label62" Caption ="GitHub Authorization PersonalAccessToken (optional):" Tag ="LANG:" - LayoutCachedLeft =120 - LayoutCachedTop =593 - LayoutCachedWidth =5223 - LayoutCachedHeight =886 End End End @@ -899,19 +747,15 @@ Begin Form Width =10093 Name ="Line63" HorizontalAnchor =2 - LayoutCachedLeft =57 - LayoutCachedTop =510 - LayoutCachedWidth =10150 - LayoutCachedHeight =510 End Begin TextBox OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =6135 + Left =6240 Top =960 - Width =1785 - Height =293 + Width =1800 + Height =300 TabIndex =8 Name ="txtRepoName" AfterUpdate ="[Event Procedure]" @@ -920,10 +764,6 @@ Begin Form BottomPadding =150 HorizontalAnchor =2 - LayoutCachedLeft =6135 - LayoutCachedTop =960 - LayoutCachedWidth =7920 - LayoutCachedHeight =1253 ColumnStart =4 ColumnEnd =4 LayoutGroup =1 @@ -935,18 +775,14 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =3 - Left =5370 + Left =5460 Top =960 - Width =705 - Height =293 + Width =720 + Height =300 Name ="Label65" Caption ="Name:" GroupTable =1 BottomPadding =150 - LayoutCachedLeft =5370 - LayoutCachedTop =960 - LayoutCachedWidth =6075 - LayoutCachedHeight =1253 ColumnStart =3 ColumnEnd =3 LayoutGroup =1 @@ -960,10 +796,10 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =3600 + Left =3660 Top =960 - Width =1710 - Height =293 + Width =1680 + Height =300 TabIndex =7 Name ="txtRepoOwner" AfterUpdate ="[Event Procedure]" @@ -971,10 +807,6 @@ Begin Form GroupTable =1 BottomPadding =150 - LayoutCachedLeft =3600 - LayoutCachedTop =960 - LayoutCachedWidth =5310 - LayoutCachedHeight =1253 ColumnStart =2 ColumnEnd =2 LayoutGroup =1 @@ -985,18 +817,14 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =3 - Left =2730 + Left =2760 Top =960 - Width =810 - Height =293 + Width =840 + Height =300 Name ="Label69" Caption ="Owner:" GroupTable =1 BottomPadding =150 - LayoutCachedLeft =2730 - LayoutCachedTop =960 - LayoutCachedWidth =3540 - LayoutCachedHeight =1253 ColumnStart =1 ColumnEnd =1 LayoutGroup =1 @@ -1009,19 +837,15 @@ Begin Form Begin Label OverlapFlags =215 TextAlign =3 - Left =1425 + Left =1440 Top =960 - Width =1245 - Height =293 + Width =1260 + Height =300 FontWeight =700 Name ="labRepositoryData" Caption ="Repository:" GroupTable =1 BottomPadding =150 - LayoutCachedLeft =1425 - LayoutCachedTop =960 - LayoutCachedWidth =2670 - LayoutCachedHeight =1253 LayoutGroup =1 GridlineThemeColorIndex =1 GridlineShade =65.0 @@ -1031,10 +855,10 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =8790 + Left =8940 Top =960 - Width =1290 - Height =293 + Width =1320 + Height =300 TabIndex =9 Name ="txtRepoBranch" AfterUpdate ="[Event Procedure]" @@ -1043,10 +867,6 @@ Begin Form BottomPadding =150 HorizontalAnchor =2 - LayoutCachedLeft =8790 - LayoutCachedTop =960 - LayoutCachedWidth =10080 - LayoutCachedHeight =1253 ColumnStart =6 ColumnEnd =6 LayoutGroup =1 @@ -1058,18 +878,14 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =3 - Left =7980 + Left =8100 Top =960 - Width =750 - Height =293 + Width =720 + Height =300 Name ="Label78" Caption ="Branch:" GroupTable =1 BottomPadding =150 - LayoutCachedLeft =7980 - LayoutCachedTop =960 - LayoutCachedWidth =8730 - LayoutCachedHeight =1253 ColumnStart =5 ColumnEnd =5 LayoutGroup =1 @@ -1092,10 +908,6 @@ Begin Form HorizontalAnchor =1 VerticalAnchor =1 - LayoutCachedLeft =7043 - LayoutCachedTop =6015 - LayoutCachedWidth =7303 - LayoutCachedHeight =6255 Begin Begin Label OverlapFlags =215 @@ -1108,10 +920,6 @@ Begin Form Tag ="LANG:" HorizontalAnchor =1 VerticalAnchor =1 - LayoutCachedLeft =7319 - LayoutCachedTop =5955 - LayoutCachedWidth =10049 - LayoutCachedHeight =6270 End End End diff --git a/source/forms/ACLibRepositoryTreeForm.bas b/source/forms/ACLibRepositoryTreeForm.form similarity index 96% rename from source/forms/ACLibRepositoryTreeForm.bas rename to source/forms/ACLibRepositoryTreeForm.form index e1ed02f..777b60e 100644 --- a/source/forms/ACLibRepositoryTreeForm.bas +++ b/source/forms/ACLibRepositoryTreeForm.form @@ -15,10 +15,10 @@ Begin Form Width =7370 DatasheetFontHeight =11 ItemSuffix =6 - Left =10830 - Top =4065 - Right =18210 - Bottom =10980 + Left =1000 + Top =1000 + Right =50000 + Bottom =50000 OnUnload ="[Event Procedure]" RecSrcDt = Begin 0xcb7e8e855105e640 @@ -278,10 +278,6 @@ Begin Form HorizontalAnchor =2 VerticalAnchor =2 - LayoutCachedLeft =53 - LayoutCachedTop =53 - LayoutCachedWidth =5438 - LayoutCachedHeight =6856 End Begin CommandButton OverlapFlags =85 @@ -294,10 +290,6 @@ Begin Form OnClick ="[Event Procedure]" HorizontalAnchor =1 - LayoutCachedLeft =5555 - LayoutCachedTop =113 - LayoutCachedWidth =7256 - LayoutCachedHeight =453 End Begin CommandButton Cancel = NotDefault @@ -311,10 +303,6 @@ Begin Form OnClick ="[Event Procedure]" HorizontalAnchor =1 - LayoutCachedLeft =5555 - LayoutCachedTop =850 - LayoutCachedWidth =7256 - LayoutCachedHeight =1190 End Begin Label OverlapFlags =247 @@ -327,10 +315,6 @@ Begin Form ForeColor =0 Name ="labStartInfo" Caption ="Loading ..." - LayoutCachedLeft =110 - LayoutCachedTop =283 - LayoutCachedWidth =5324 - LayoutCachedHeight =2264 ForeTint =100.0 End End diff --git a/source/forms/InstallAddInForm.bas b/source/forms/InstallAddInForm.form similarity index 78% rename from source/forms/InstallAddInForm.bas rename to source/forms/InstallAddInForm.form index ac2adab..77cb85d 100644 --- a/source/forms/InstallAddInForm.bas +++ b/source/forms/InstallAddInForm.form @@ -17,13 +17,13 @@ Begin Form PictureAlignment =2 DatasheetGridlinesBehavior =3 GridY =10 - Width =7389 + Width =7380 DatasheetFontHeight =11 ItemSuffix =335 - Left =5550 - Top =3030 - Right =18705 - Bottom =14760 + Left =1000 + Top =1000 + Right =50000 + Bottom =50000 RecSrcDt = Begin 0x956642cd6e4ee640 End @@ -140,7 +140,7 @@ Begin Form GridlineShade =65.0 End Begin Section - Height =7278 + Height =7260 Name ="Detailbereich" AlternateBackThemeColorIndex =1 AlternateBackShade =95.0 @@ -152,8 +152,8 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =2070 - Top =3143 + Left =2100 + Top =3240 Width =4740 Height =300 TabIndex =5 @@ -164,10 +164,6 @@ Begin Form BottomPadding =150 ShowDatePicker =0 - LayoutCachedLeft =2070 - LayoutCachedTop =3143 - LayoutCachedWidth =6810 - LayoutCachedHeight =3443 RowStart =6 RowEnd =6 ColumnStart =1 @@ -179,8 +175,8 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =1 - Left =570 - Top =3143 + Left =600 + Top =3240 Width =1440 Height =300 Name ="lbltxtAddInName" @@ -190,10 +186,6 @@ Begin Form LeftPadding =57 BottomPadding =150 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =3143 - LayoutCachedWidth =2010 - LayoutCachedHeight =3443 RowStart =6 RowEnd =6 LayoutGroup =1 @@ -209,8 +201,8 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =2070 - Top =570 + Left =2100 + Top =600 Width =4740 Height =300 TabIndex =1 @@ -221,10 +213,6 @@ Begin Form BottomPadding =150 ShowDatePicker =0 - LayoutCachedLeft =2070 - LayoutCachedTop =570 - LayoutCachedWidth =6810 - LayoutCachedHeight =870 ColumnStart =1 ColumnEnd =2 LayoutGroup =1 @@ -234,8 +222,8 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =1 - Left =570 - Top =570 + Left =600 + Top =600 Width =1440 Height =300 Name ="lblFileName" @@ -245,10 +233,6 @@ Begin Form LeftPadding =57 BottomPadding =150 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =570 - LayoutCachedWidth =2010 - LayoutCachedHeight =870 LayoutGroup =1 ThemeFontIndex =-1 GroupTable =1 @@ -261,8 +245,8 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =2070 - Top =3623 + Left =2100 + Top =3720 Width =4740 Height =300 TabIndex =6 @@ -273,10 +257,6 @@ Begin Form BottomPadding =150 ShowDatePicker =0 - LayoutCachedLeft =2070 - LayoutCachedTop =3623 - LayoutCachedWidth =6810 - LayoutCachedHeight =3923 RowStart =7 RowEnd =7 ColumnStart =1 @@ -288,8 +268,8 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =1 - Left =570 - Top =3623 + Left =600 + Top =3720 Width =1440 Height =300 Name ="lblAddInAuthor" @@ -299,10 +279,6 @@ Begin Form LeftPadding =57 BottomPadding =150 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =3623 - LayoutCachedWidth =2010 - LayoutCachedHeight =3923 RowStart =7 RowEnd =7 LayoutGroup =1 @@ -317,8 +293,8 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =2070 - Top =4103 + Left =2100 + Top =4200 Width =4740 Height =300 TabIndex =7 @@ -329,10 +305,6 @@ Begin Form BottomPadding =150 ShowDatePicker =0 - LayoutCachedLeft =2070 - LayoutCachedTop =4103 - LayoutCachedWidth =6810 - LayoutCachedHeight =4403 RowStart =8 RowEnd =8 ColumnStart =1 @@ -344,8 +316,8 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =1 - Left =570 - Top =4103 + Left =600 + Top =4200 Width =1440 Height =300 Name ="lblAddInCompany" @@ -355,10 +327,6 @@ Begin Form LeftPadding =57 BottomPadding =150 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =4103 - LayoutCachedWidth =2010 - LayoutCachedHeight =4403 RowStart =8 RowEnd =8 LayoutGroup =1 @@ -373,10 +341,10 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =2070 - Top =4583 + Left =2100 + Top =4680 Width =4740 - Height =1125 + Height =1140 TabIndex =8 Name ="txtAddInComment" FontName ="Tahoma" @@ -386,10 +354,6 @@ Begin Form VerticalAnchor =2 ShowDatePicker =0 - LayoutCachedLeft =2070 - LayoutCachedTop =4583 - LayoutCachedWidth =6810 - LayoutCachedHeight =5708 RowStart =9 RowEnd =9 ColumnStart =1 @@ -401,10 +365,10 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =1 - Left =570 - Top =4583 + Left =600 + Top =4680 Width =1440 - Height =1125 + Height =1140 Name ="lblAddInComment" Caption ="Comment" FontName ="Tahoma" @@ -413,10 +377,6 @@ Begin Form BottomPadding =150 HorizontalAnchor =2 VerticalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =4583 - LayoutCachedWidth =2010 - LayoutCachedHeight =5708 RowStart =9 RowEnd =9 LayoutGroup =1 @@ -427,10 +387,10 @@ Begin Form End Begin CommandButton OverlapFlags =85 - Left =570 - Top =6255 + Left =600 + Top =6360 Width =6240 - Height =450 + Height =480 TabIndex =10 Name ="cmdInstallAddIn" Caption ="Install Add-in" @@ -441,10 +401,6 @@ Begin Form BottomPadding =567 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =6255 - LayoutCachedWidth =6810 - LayoutCachedHeight =6705 RowStart =11 RowEnd =11 ColumnEnd =2 @@ -457,10 +413,10 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =2070 - Top =2340 + Left =2100 + Top =2400 Width =4740 - Height =291 + Height =300 TabIndex =4 Name ="txtAddInStartFunction" FontName ="Tahoma" @@ -469,10 +425,6 @@ Begin Form BottomPadding =150 ShowDatePicker =0 - LayoutCachedLeft =2070 - LayoutCachedTop =2340 - LayoutCachedWidth =6810 - LayoutCachedHeight =2631 RowStart =4 RowEnd =4 ColumnStart =1 @@ -484,10 +436,10 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =1 - Left =570 - Top =2340 + Left =600 + Top =2400 Width =1440 - Height =291 + Height =300 Name ="lblAddInStartFunction" Caption ="Start Function" FontName ="Tahoma" @@ -495,10 +447,6 @@ Begin Form LeftPadding =57 BottomPadding =150 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =2340 - LayoutCachedWidth =2010 - LayoutCachedHeight =2631 RowStart =4 RowEnd =4 LayoutGroup =1 @@ -513,8 +461,8 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =2070 - Top =1860 + Left =2100 + Top =1920 Width =4740 Height =300 TabIndex =3 @@ -525,10 +473,6 @@ Begin Form BottomPadding =150 ShowDatePicker =0 - LayoutCachedLeft =2070 - LayoutCachedTop =1860 - LayoutCachedWidth =6810 - LayoutCachedHeight =2160 RowStart =3 RowEnd =3 ColumnStart =1 @@ -540,8 +484,8 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =1 - Left =570 - Top =1860 + Left =600 + Top =1920 Width =1440 Height =300 Name ="Bezeichnungsfeld105" @@ -551,10 +495,6 @@ Begin Form LeftPadding =57 BottomPadding =150 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =1860 - LayoutCachedWidth =2010 - LayoutCachedHeight =2160 RowStart =3 RowEnd =3 LayoutGroup =1 @@ -567,8 +507,8 @@ Begin Form FontUnderline = NotDefault OverlapFlags =85 TextAlign =1 - Left =570 - Top =1530 + Left =600 + Top =1560 Width =6240 Height =300 FontWeight =700 @@ -580,10 +520,6 @@ Begin Form RightPadding =567 BottomPadding =0 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =1530 - LayoutCachedWidth =6810 - LayoutCachedHeight =1830 RowStart =2 RowEnd =2 ColumnEnd =2 @@ -595,8 +531,8 @@ Begin Form FontUnderline = NotDefault OverlapFlags =85 TextAlign =1 - Left =570 - Top =2813 + Left =600 + Top =2880 Width =6240 Height =300 FontWeight =700 @@ -608,10 +544,6 @@ Begin Form RightPadding =567 BottomPadding =0 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =2813 - LayoutCachedWidth =6810 - LayoutCachedHeight =3113 RowStart =5 RowEnd =5 ColumnEnd =2 @@ -625,8 +557,8 @@ Begin Form OverlapFlags =85 TextAlign =1 IMESentenceMode =3 - Left =2070 - Top =1050 + Left =2100 + Top =1080 Width =4740 Height =300 TabIndex =2 @@ -637,10 +569,6 @@ Begin Form BottomPadding =150 ShowDatePicker =0 - LayoutCachedLeft =2070 - LayoutCachedTop =1050 - LayoutCachedWidth =6810 - LayoutCachedHeight =1350 RowStart =1 RowEnd =1 ColumnStart =1 @@ -652,8 +580,8 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =1 - Left =570 - Top =1050 + Left =600 + Top =1080 Width =1440 Height =300 Name ="Label247" @@ -663,10 +591,6 @@ Begin Form LeftPadding =57 BottomPadding =150 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =1050 - LayoutCachedWidth =2010 - LayoutCachedHeight =1350 RowStart =1 RowEnd =1 LayoutGroup =1 @@ -686,9 +610,9 @@ Begin Form End Begin CheckBox OverlapFlags =85 - Left =3015 - Top =5888 - Width =3795 + Left =3060 + Top =6000 + Width =3780 Height =300 TabIndex =9 Name ="cbCompileAddIn" @@ -696,10 +620,6 @@ Begin Form GroupTable =1 RightPadding =567 - LayoutCachedLeft =3015 - LayoutCachedTop =5888 - LayoutCachedWidth =6810 - LayoutCachedHeight =6188 RowStart =10 RowEnd =10 ColumnStart =2 @@ -710,9 +630,9 @@ Begin Form Begin Label OverlapFlags =85 TextAlign =1 - Left =570 - Top =5888 - Width =2415 + Left =600 + Top =6000 + Width =2400 Height =300 ForeColor =0 Name ="Label325" @@ -721,10 +641,6 @@ Begin Form LeftPadding =57 RightPadding =0 HorizontalAnchor =2 - LayoutCachedLeft =570 - LayoutCachedTop =5888 - LayoutCachedWidth =2985 - LayoutCachedHeight =6188 RowStart =10 RowEnd =10 ColumnEnd =1 @@ -744,10 +660,6 @@ Begin Form FontSize =8 Name ="lblVersionInfo" HorizontalAnchor =2 - LayoutCachedLeft =114 - LayoutCachedTop =6916 - LayoutCachedWidth =7253 - LayoutCachedHeight =7139 End End End diff --git a/source/hidden-attributes.json b/source/hidden-attributes.json deleted file mode 100644 index 20c4a85..0000000 --- a/source/hidden-attributes.json +++ /dev/null @@ -1,13 +0,0 @@ -{ - "Info": { - "Class": "clsDbHiddenAttribute", - "Description": "Database objects hidden attribute" - }, - "Items": { - "Tables": [ - "tab1DS", - "USys_AppFiles", - "USysRegInfo" - ] - } -} diff --git a/source/modules/ACLibApiImportSession.cls b/source/modules/ACLibApiImportSession.cls new file mode 100644 index 0000000..becbc73 --- /dev/null +++ b/source/modules/ACLibApiImportSession.cls @@ -0,0 +1,1016 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "ACLibApiImportSession" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'--------------------------------------------------------------------------------------- +' Class: ACLibApiImportSession +'--------------------------------------------------------------------------------------- +' +' Headless import session for the automation API (see modApi.API) +' +' Author: +' Josef Poetzl +' +' Remarks: +'--------------------------------------------------------------------------------------- +'| Uses the ACLibFileManager instance of the wizard (SilentMode during the session). +'| Public functions return the complete JSON result ({"ok":true,...}), +'| errors are raised to the caller (modApi converts them to JSON). +'--------------------------------------------------------------------------------------- +' +Option Compare Text +Option Explicit + +Private Const ERR_INVALID_ARGUMENT As Long = vbObjectError + 1001 +Private Const ERR_FILE_NOT_FOUND As Long = vbObjectError + 1002 + +Private Const SOURCE_CONFIG As String = "config" +Private Const SOURCE_LOCAL As String = "local" +Private Const SOURCE_GITHUB As String = "github" + +Private Const DEFAULT_GITHUB_OWNER As String = "AccessCodeLib" +Private Const DEFAULT_GITHUB_REPOSITORY As String = "AccessCodeLib" +Private Const DEFAULT_GITHUB_BRANCH As String = "master" + +Private Const MODULNAME_CONFIG_APPLICATION As String = "_config_Application" +Private Const GITHUB_NOT_FOUND_CONTENT As String = "404: Not Found" + +#Const EARLYBINDING = 0 + +Private WithEvents m_FileManager As ACLibFileManager +Attribute m_FileManager.VB_VarHelpID = -1 + +Private m_Source As String +Private m_ImportMode As CodeLibImportMode +Private m_ImportTests As Boolean +Private m_ImportExamples As Boolean + +' Settings of the predeclared ACLibGitHubImporter before the session (restored in Class_Terminate) +Private m_GitHubSettingsSaved As Boolean +Private m_SavedRepositoryOwner As String +Private m_SavedRepositoryName As String +Private m_SavedBranchName As String +Private m_SavedAuthorizationToken As String + +' Resolve/import state +Private m_PlannedModes As Collection ' key: full file path, item: CodeLibImportMode +Private m_PlannedExecutes As Collection ' key/item: execute string +Private m_ImportLog As Collection ' items: JSON objects +Private m_MissingSelectedFiles As String ' selected files (not dependencies) that are not available + +Private Sub Class_Initialize() + Set m_FileManager = CurrentACLibFileManager + m_FileManager.ResetRepositoryRootDirectory + m_FileManager.ClearMessages + m_FileManager.SilentMode = True + m_ImportMode = clim_ImportMissingItems +End Sub + +Private Sub Class_Terminate() +On Error Resume Next ' cleanup only, must not raise from Terminate + If Not m_FileManager Is Nothing Then + m_FileManager.ResetRepositoryRootDirectory + m_FileManager.SilentMode = False + m_FileManager.ClearMessages + End If + RestoreGitHubImporterSettings + Set m_FileManager = Nothing +End Sub + +'--------------------------------------------------------------------------------------- +' Sub: Configure +'--------------------------------------------------------------------------------------- +' +' Read options: "mode=missing|all|selected;tests=0|1;examples=0|1;source=config|local|github;repo=owner/name@branch" +' +'--------------------------------------------------------------------------------------- +Public Sub Configure(ByVal Options As String) + + Dim OptionItems() As String + Dim OptionItem As String + Dim OptionName As String + Dim OptionValue As String + Dim SeparatorPos As Long + Dim i As Long + Dim Source As String + Dim RepositoryString As String + + Source = SOURCE_CONFIG + m_ImportMode = clim_ImportMissingItems + m_ImportTests = False + m_ImportExamples = False + + OptionItems = Split(Options, ";") + For i = LBound(OptionItems) To UBound(OptionItems) + OptionItem = Trim$(OptionItems(i)) + If Len(OptionItem) > 0 Then + SeparatorPos = InStr(1, OptionItem, "=") + If SeparatorPos = 0 Then + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.Configure", "Invalid option '" & OptionItem & "' (expected name=value)" + End If + OptionName = LCase$(Trim$(Left$(OptionItem, SeparatorPos - 1))) + OptionValue = Trim$(Mid$(OptionItem, SeparatorPos + 1)) + Select Case OptionName + Case "mode" + m_ImportMode = ParseImportMode(OptionValue) + Case "tests" + m_ImportTests = ParseBooleanOption(OptionName, OptionValue) + Case "examples" + m_ImportExamples = ParseBooleanOption(OptionName, OptionValue) + Case "source" + Select Case OptionValue + Case SOURCE_CONFIG, SOURCE_LOCAL, SOURCE_GITHUB + Source = LCase$(OptionValue) + Case Else + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.Configure", "Invalid value for source: '" & OptionValue & "' (config|local|github)" + End Select + Case "repo" + RepositoryString = OptionValue + Case Else + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.Configure", "Unknown option '" & OptionName & "'" + End Select + End If + Next + + If Len(RepositoryString) > 0 Then + If Source = SOURCE_LOCAL Then + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.Configure", "Option repo can not be combined with source=local" + End If + Source = SOURCE_GITHUB + End If + + Select Case Source + Case SOURCE_CONFIG + If Len(CurrentACLibConfiguration.LocalRepositoryPath) > 0 Then + Source = SOURCE_LOCAL + Else + Source = SOURCE_GITHUB + End If + Case SOURCE_LOCAL + If Len(CurrentACLibConfiguration.LocalRepositoryPath) = 0 Then + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.Configure", "No local repository path configured" + End If + End Select + + m_Source = Source + If m_Source = SOURCE_GITHUB Then + ConfigureGitHubImporter RepositoryString + End If + + m_FileManager.ResetRepositoryRootDirectory + +End Sub + +Private Function ParseImportMode(ByVal ModeString As String) As CodeLibImportMode + Select Case ModeString + Case "missing" + ParseImportMode = clim_ImportMissingItems + Case "all" + ParseImportMode = clim_ImportAllUsedItems + Case "selected" + ParseImportMode = clim_ImportSelectedOnly + Case Else + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.ParseImportMode", "Invalid value for mode: '" & ModeString & "' (missing|all|selected)" + End Select +End Function + +Private Function ParseBooleanOption(ByVal OptionName As String, ByVal OptionValue As String) As Boolean + Select Case OptionValue + Case "1", "true" + ParseBooleanOption = True + Case "0", "false" + ParseBooleanOption = False + Case Else + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.ParseBooleanOption", "Invalid value for " & OptionName & ": '" & OptionValue & "' (0|1)" + End Select +End Function + +Private Sub ConfigureGitHubImporter(ByVal RepositoryString As String) +' RepositoryString: owner/name[@branch] + + Dim RepositoryOwner As String + Dim RepositoryName As String + Dim BranchName As String + Dim SeparatorPos As Long + Dim AuthorizationToken As String + + RepositoryOwner = DEFAULT_GITHUB_OWNER + RepositoryName = DEFAULT_GITHUB_REPOSITORY + BranchName = DEFAULT_GITHUB_BRANCH + + If Len(RepositoryString) > 0 Then + SeparatorPos = InStr(1, RepositoryString, "@") + If SeparatorPos > 0 Then + BranchName = Trim$(Mid$(RepositoryString, SeparatorPos + 1)) + RepositoryString = Left$(RepositoryString, SeparatorPos - 1) + End If + SeparatorPos = InStr(1, RepositoryString, "/") + If SeparatorPos = 0 Then + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.ConfigureGitHubImporter", "Invalid value for repo: '" & RepositoryString & "' (owner/name@branch)" + End If + RepositoryOwner = Trim$(Left$(RepositoryString, SeparatorPos - 1)) + RepositoryName = Trim$(Mid$(RepositoryString, SeparatorPos + 1)) + If Len(RepositoryOwner) = 0 Or Len(RepositoryName) = 0 Or Len(BranchName) = 0 Then + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.ConfigureGitHubImporter", "Invalid value for repo: '" & RepositoryString & "' (owner/name@branch)" + End If + End If + + AuthorizationToken = CurrentACLibConfiguration.GitHubAuthPersonalAccessToken + + SaveGitHubImporterSettings + With ACLibGitHubImporter + .RepositoryOwner = RepositoryOwner + .RepositoryName = RepositoryName + .BranchName = BranchName + If Len(AuthorizationToken) > 0 Then + .GitHubApiAuthorizationToken = AuthorizationToken + End If + End With + +End Sub + +Private Sub SaveGitHubImporterSettings() + If m_GitHubSettingsSaved Then Exit Sub + With ACLibGitHubImporter + m_SavedRepositoryOwner = .RepositoryOwner + m_SavedRepositoryName = .RepositoryName + m_SavedBranchName = .BranchName + m_SavedAuthorizationToken = .GitHubApiAuthorizationToken + End With + m_GitHubSettingsSaved = True +End Sub + +Private Sub RestoreGitHubImporterSettings() + If Not m_GitHubSettingsSaved Then Exit Sub + With ACLibGitHubImporter + .RepositoryOwner = m_SavedRepositoryOwner + .RepositoryName = m_SavedRepositoryName + .BranchName = m_SavedBranchName + .GitHubApiAuthorizationToken = m_SavedAuthorizationToken + End With + m_GitHubSettingsSaved = False +End Sub + +Private Property Get GitHubTempRepositoryPath() As String + GitHubTempRepositoryPath = FileTools.TempPath & "ACLibTempRepo" +End Property + +Private Property Get RepositoryDisplayName() As String + If m_Source = SOURCE_GITHUB Then + With ACLibGitHubImporter + RepositoryDisplayName = .RepositoryOwner & "/" & .RepositoryName & "@" & .BranchName + End With + Else + RepositoryDisplayName = CurrentACLibConfiguration.LocalRepositoryPath + End If +End Property + +'--------------------------------------------------------------------------------------- +' Events of ACLibFileManager +'--------------------------------------------------------------------------------------- + +Private Sub m_FileManager_PropertyMissingLocalRepositoryRootDirectory(ByRef NewValue As String) +' same behaviour as the wizard form: only answer in GitHub mode, +' otherwise ACLibFileManager uses the configured local repository + If m_Source = SOURCE_GITHUB Then + NewValue = GitHubTempRepositoryPath & "\" + End If +End Sub + +Private Sub m_FileManager_MissingLocalRepositoryFile(ByVal ACLibPath As String, ByVal FullFilePath As String) + + If m_Source <> SOURCE_GITHUB Then + Exit Sub + End If + + FileTools.CreateDirectoryIfMissing FileTools.PathFromFullFileName(FullFilePath) + ACLibGitHubImporter.DownloadACLibFileFromWeb Replace(ACLibPath, "\", "/"), FullFilePath + + If IsGitHubNotFoundFile(FullFilePath) Then + Kill FullFilePath + Err.Raise ERR_FILE_NOT_FOUND, "ACLibApiImportSession.MissingLocalRepositoryFile", "File not found on GitHub: " & Replace(ACLibPath, "\", "/") + End If + +End Sub + +Private Sub m_FileManager_ImportRepositoryFile(ByVal ObjectName As String, ByVal RepositoryFile As String, _ + ByVal ElementType As CodeLibElementType, ByRef Dependency As Variant, _ + ByRef ImportFile As Object, ByRef Cancel As Integer) + + Dim ItemMode As Variant + Dim ObjectExists As Boolean + Dim Action As String + + If m_ImportLog Is Nothing Then Exit Sub + + If Not TryGetCollectionItem(m_PlannedModes, ImportFile.Path, ItemMode) Then + ItemMode = m_ImportMode + End If + Action = DetermineAction(ObjectName, ElementType, ItemMode, ObjectExists) + + m_ImportLog.Add "{" & _ + JsonPair("name", JsonString(ObjectName)) & "," & _ + JsonPair("file", JsonString(RepositoryFile)) & "," & _ + JsonPair("type", JsonString(ElementTypeName(ElementType))) & "," & _ + JsonPair("action", JsonString(Action)) & "}" + +End Sub + +Private Function IsGitHubNotFoundFile(ByVal FilePath As String) As Boolean + + Dim FileNumber As Integer + Dim FileContent As String + + If Not FileTools.FileExists(FilePath) Then Exit Function + If FileLen(FilePath) > 64 Then Exit Function + + FileNumber = FreeFile + Open FilePath For Binary Access Read As #FileNumber + FileContent = String$(LOF(FileNumber), 0) + Get #FileNumber, , FileContent + Close #FileNumber + + IsGitHubNotFoundFile = (Trim$(Replace(Replace(FileContent, vbCr, vbNullString), vbLf, vbNullString)) = GITHUB_NOT_FOUND_CONTENT) + +End Function + +'--------------------------------------------------------------------------------------- +' Commands +'--------------------------------------------------------------------------------------- + +Public Function GetConfig() As String + + Dim ImporterJson As String + + With ACLibGitHubImporter + ImporterJson = "{" & _ + JsonPair("owner", JsonString(.RepositoryOwner)) & "," & _ + JsonPair("repo", JsonString(.RepositoryName)) & "," & _ + JsonPair("branch", JsonString(.BranchName)) & "}" + End With + + With CurrentACLibConfiguration + GetConfig = OkResult( _ + JsonPair("source", JsonString(m_Source)) & "," & _ + JsonPair("repository", JsonString(RepositoryDisplayName)) & "," & _ + JsonPair("localRepositoryPath", JsonString(.LocalRepositoryPath)) & "," & _ + JsonPair("privateRepositoryPath", JsonString(.PrivateRepositoryPath)) & "," & _ + JsonPair("github", ImporterJson) & "," & _ + JsonPair("hasGitHubToken", JsonBool(Len(.GitHubAuthPersonalAccessToken) > 0)) & "," & _ + JsonPair("importTestsDefault", JsonBool(.ImportTestsDefaultValue))) + End With + +End Function + +Public Function ListInstalled() As String + + Dim ModuleItems As Collection + Dim cli As CodeLibInfo +#If EARLYBINDING = 1 Then + Dim vbc As VBIDE.VBComponent +#Else + Dim vbc As Object +#End If + + Set ModuleItems = New Collection + + For Each vbc In m_FileManager.CurrentVbProject.VBComponents + cli = m_FileManager.GetCodeLibInfoFromCodeModule(vbc.Name) + If Len(cli.RepositoryFile) > 0 Then + ModuleItems.Add "{" & _ + JsonPair("name", JsonString(vbc.Name)) & "," & _ + JsonPair("type", JsonString(ComponentTypeName(vbc.Type, vbc.Name))) & "," & _ + JsonPair("file", JsonString(cli.RepositoryFile)) & "}" + End If + Next + + ListInstalled = OkResult( _ + JsonPair("database", JsonString(CurrentDb.Name)) & "," & _ + JsonPair("modules", JsonArray(ModuleItems))) + +End Function + +Public Function Resolve(ByVal Files As String) As String + + Dim FileItems As Collection + Dim MissingItems As Collection + + ResolveFiles Files, FileItems, MissingItems + + Resolve = OkResult( _ + SessionInfoJson & "," & _ + JsonPair("files", JsonArray(FileItems)) & "," & _ + JsonPair("missing", JsonArray(MissingItems)) & "," & _ + JsonPair("executes", JsonArray(m_PlannedExecutes, True))) + +End Function + +Public Function Import(ByVal Files As String) As String + + Dim FileItems As Collection + Dim MissingItems As Collection + Dim PathArray() As String + Dim ReferencesBefore As Collection + Dim ReferencesAfter As Collection + Dim MessageItems As Collection + Dim MessageItem As Variant + + ResolveFiles Files, FileItems, MissingItems + + ' selected files must exist, missing dependencies are reported (wizard skips them) + If Len(m_MissingSelectedFiles) > 0 Then + Err.Raise ERR_FILE_NOT_FOUND, "ACLibApiImportSession.Import", "Selected file(s) not available: " & Mid$(m_MissingSelectedFiles, 3) + End If + + PathArray = SplitFiles(Files) + ' ACLibFileManager.ImportRepositoryFiles only reads up to UBound - 1 (array from wizard form) + ReDim Preserve PathArray(UBound(PathArray) + 1) + + Set ReferencesBefore = GetReferenceItems + Set m_ImportLog = New Collection + + m_FileManager.ImportRepositoryFiles PathArray, m_ImportMode, m_ImportTests, m_ImportExamples + + Set ReferencesAfter = GetReferenceItems + + Set MessageItems = New Collection + For Each MessageItem In m_FileManager.Messages + MessageItems.Add MessageItem + Next + + Import = OkResult( _ + SessionInfoJson & "," & _ + JsonPair("files", JsonArray(m_ImportLog)) & "," & _ + JsonPair("missing", JsonArray(MissingItems)) & "," & _ + JsonPair("references", "{" & _ + JsonPair("added", JsonArray(CollectionDifference(ReferencesAfter, ReferencesBefore))) & "," & _ + JsonPair("removed", JsonArray(CollectionDifference(ReferencesBefore, ReferencesAfter))) & "}") & "," & _ + JsonPair("executes", JsonArray(m_PlannedExecutes, True)) & "," & _ + JsonPair("messages", JsonArray(MessageItems, True))) + +End Function + +Private Property Get SessionInfoJson() As String + SessionInfoJson = _ + JsonPair("source", JsonString(m_Source)) & "," & _ + JsonPair("repository", JsonString(RepositoryDisplayName)) & "," & _ + JsonPair("mode", JsonString(ImportModeName(m_ImportMode))) & "," & _ + JsonPair("tests", JsonBool(m_ImportTests)) & "," & _ + JsonPair("examples", JsonBool(m_ImportExamples)) +End Property + +'--------------------------------------------------------------------------------------- +' Resolve (read only, same rules as ACLibFileManager.ImportFile) +'--------------------------------------------------------------------------------------- + +Private Sub ResolveFiles(ByVal Files As String, ByRef FileItems As Collection, ByRef MissingItems As Collection) + + Dim SelectedFiles() As String + Dim Queue As Collection + Dim Records As Collection + Dim ReplacedFiles As Collection + Dim Record As Variant + Dim Action As String + Dim i As Long + + SelectedFiles = SplitFiles(Files) + + Set Queue = New Collection + Set Records = New Collection + Set ReplacedFiles = New Collection + Set MissingItems = New Collection + Set m_PlannedModes = New Collection + Set m_PlannedExecutes = New Collection + m_MissingSelectedFiles = vbNullString + + For i = LBound(SelectedFiles) To UBound(SelectedFiles) + Queue.Add Array(SelectedFiles(i), vbNullString, m_ImportMode, vbNullString) + Next + + Do While Queue.Count > 0 + ResolveQueueItem Queue(1), Queue, Records, ReplacedFiles, MissingItems + Queue.Remove 1 + Loop + + ' Record: Array(FullPath, JsonBeforeAction, Action, JsonAfterAction) + Set FileItems = New Collection + For Each Record In Records + Action = Record(2) + If CollectionContains(ReplacedFiles, Record(0)) Then + Action = "replaced" + End If + FileItems.Add Record(1) & JsonString(Action) & Record(3) + Next + +End Sub + +Private Sub ResolveQueueItem(ByVal QueueItem As Variant, ByVal Queue As Collection, ByVal Records As Collection, _ + ByVal ReplacedFiles As Collection, ByVal MissingItems As Collection) +' QueueItem: Array(RepositoryPath, DownloadBase, ImportMode, RequiredBy) + + Dim RepositoryPath As String + Dim DownloadBase As String + Dim ItemMode As CodeLibImportMode + Dim RequiredBy As String + Dim FullPath As String + Dim ErrorMessage As String + Dim cli As CodeLibInfo + Dim ReplacedFullPath As String + Dim ReplacedCli As CodeLibInfo + Dim ObjectExists As Boolean + Dim Action As String + Dim i As Long + + RepositoryPath = QueueItem(0) + DownloadBase = QueueItem(1) + ItemMode = QueueItem(2) + RequiredBy = QueueItem(3) + + If Not TryReadCodeLibInfo(RepositoryPath, DownloadBase, (ItemMode <> clim_ImportSelectedOnly), FullPath, cli, ErrorMessage) Then + If Not CollectionContains(MissingItems, RepositoryPath) Then + MissingItems.Add "{" & _ + JsonPair("file", JsonString(RepositoryPath)) & "," & _ + JsonPair("requiredBy", JsonStringOrNull(RequiredBy)) & "," & _ + JsonPair("message", JsonString(ErrorMessage)) & "}", RepositoryPath + End If + If Len(RequiredBy) = 0 Then + m_MissingSelectedFiles = m_MissingSelectedFiles & ", " & RepositoryPath & " (" & ErrorMessage & ")" + End If + Exit Sub + End If + + If CollectionContains(m_PlannedModes, FullPath) Then ' already resolved + Exit Sub + End If + m_PlannedModes.Add ItemMode, FullPath + + If Len(cli.RepositoryFile) > 0 Then + RequiredBy = cli.RepositoryFile + Else + RequiredBy = RepositoryPath + End If + + ' + If Len(cli.RepositoryFileReplacement) > 0 Then + If TryReadCodeLibInfo(cli.RepositoryFileReplacement, vbNullString, False, ReplacedFullPath, ReplacedCli, ErrorMessage) Then + If Not CollectionContains(ReplacedFiles, ReplacedFullPath) Then + ReplacedFiles.Add ReplacedFullPath, ReplacedFullPath + End If + End If + End If + + ' + If Len(cli.LicenseFile) > 0 Then + Queue.Add Array(cli.LicenseFile, DownloadBase, clim_ImportMissingItems, RequiredBy) + End If + + ' + If ItemMode <> clim_ImportSelectedOnly Then + If (0 / 1) + (Not Not cli.Dependency) Then + For i = 0 To UBound(cli.Dependency) + Queue.Add Array(cli.Dependency(i), DownloadBase, ItemMode, RequiredBy) + Next + End If + End If + + ' + If m_ImportTests Then + If (0 / 1) + (Not Not cli.TestFiles) Then + For i = 0 To UBound(cli.TestFiles) + Queue.Add Array(cli.TestFiles(i), DownloadBase, ItemMode, RequiredBy) + Next + End If + End If + + ' + If m_ImportExamples Then + If (0 / 1) + (Not Not cli.ExampleFiles) Then + For i = 0 To UBound(cli.ExampleFiles) + Queue.Add Array(cli.ExampleFiles(i), DownloadBase, ItemMode, RequiredBy) + Next + End If + End If + + ' + If (0 / 1) + (Not Not cli.ExecuteList) Then + For i = 0 To UBound(cli.ExecuteList) + If Not CollectionContains(m_PlannedExecutes, cli.ExecuteList(i)) Then + m_PlannedExecutes.Add cli.ExecuteList(i), cli.ExecuteList(i) + End If + Next + End If + + Action = DetermineAction(cli.Name, cli.Type, ItemMode, ObjectExists) + + Records.Add Array(FullPath, _ + "{" & _ + JsonPair("name", JsonString(cli.Name)) & "," & _ + JsonPair("file", JsonString(cli.RepositoryFile)) & "," & _ + JsonPair("requestedPath", JsonString(RepositoryPath)) & "," & _ + JsonPair("type", JsonString(ElementTypeName(cli.Type))) & "," & _ + JsonPair("exists", JsonBool(ObjectExists)) & "," & _ + """action"":", _ + Action, _ + "," & _ + JsonPair("description", JsonString(cli.Description)) & "," & _ + JsonPair("license", JsonString(cli.LicenseFile)) & "," & _ + JsonPair("replaces", JsonString(cli.RepositoryFileReplacement)) & "," & _ + JsonPair("dependencies", JsonStringArray(cli.Dependency)) & "," & _ + JsonPair("references", ReferencesJson(cli.References)) & "," & _ + JsonPair("tests", JsonStringArray(cli.TestFiles)) & "," & _ + JsonPair("examples", JsonStringArray(cli.ExampleFiles)) & "," & _ + JsonPair("executes", JsonStringArray(cli.ExecuteList)) & "}") + +End Sub + +Private Function TryReadCodeLibInfo(ByVal RepositoryPath As String, ByRef DownloadBase As String, ByVal FindDependency As Boolean, _ + ByRef FullPath As String, ByRef CodeLibInf As CodeLibInfo, ByRef ErrorMessage As String) As Boolean +' Errors are not swallowed: the error message is returned and reported as missing file + +On Error GoTo HandleErr + + FullPath = m_FileManager.GetRepositoryFullPath(RepositoryPath, DownloadBase) + If Not FileTools.FileExists(FullPath) Then + ErrorMessage = "File not found: " & FullPath + Exit Function + End If + + CodeLibInf = m_FileManager.GetCodeLibInfoFromFilePath(FullPath, FindDependency) + TryReadCodeLibInfo = True + + Exit Function + +HandleErr: + ErrorMessage = Err.Description & " (" & Err.Number & ")" + +End Function + +Private Function DetermineAction(ByVal ObjectName As String, ByVal ElementType As CodeLibElementType, _ + ByVal ItemMode As CodeLibImportMode, ByRef ObjectExists As Boolean) As String +' same rules as ACLibFileManager.ImportVbComponent / ImportAccessObject + +#If EARLYBINDING = 1 Then + Dim vbc As VBIDE.VBComponent +#Else + Dim vbc As Object +#End If + + ObjectExists = False + + Select Case ElementType + Case CodeLibElementType.clet_StdModule, CodeLibElementType.clet_ClassModule + Set vbc = FindVbComponent(ObjectName) + If vbc Is Nothing Then + DetermineAction = "import" + Else + ObjectExists = True + If vbc.Type <> ElementType Then + DetermineAction = "overwrite" + ElseIf ItemMode = clim_ImportMissingItems Then + DetermineAction = "skip" + ElseIf vbc.Name = MODULNAME_CONFIG_APPLICATION Then + DetermineAction = "skip" + Else + DetermineAction = "overwrite" + End If + End If + + Case CodeLibElementType.clet_Form, CodeLibElementType.clet_Report + If ElementType = CodeLibElementType.clet_Form Then + ObjectExists = AccessObjectExists(CurrentProject.AllForms, ObjectName) + Else + ObjectExists = AccessObjectExists(CurrentProject.AllReports, ObjectName) + End If + If Not ObjectExists Then + DetermineAction = "import" + ElseIf ItemMode = clim_ImportMissingItems Then + DetermineAction = "skip" + Else + DetermineAction = "overwrite" + End If + + Case Else ' clet_Package: codelib block only + DetermineAction = "none" + + End Select + +End Function + +Private Function FindVbComponent(ByVal ComponentName As String) As Object + +#If EARLYBINDING = 1 Then + Dim vbc As VBIDE.VBComponent +#Else + Dim vbc As Object +#End If + + For Each vbc In m_FileManager.CurrentVbProject.VBComponents + If vbc.Name = ComponentName Then + Set FindVbComponent = vbc + Exit Function + End If + Next + +End Function + +Private Function AccessObjectExists(ByVal AccessObjects As Object, ByVal ObjectName As String) As Boolean + + Dim AcObj As AccessObject + + For Each AcObj In AccessObjects + If AcObj.Name = ObjectName Then + AccessObjectExists = True + Exit Function + End If + Next + +End Function + +Private Function ReferencesJson(ByRef CodeLibRefs() As CodeLibInfoReference) As String + + Dim RefItems As Collection + Dim i As Long + + Set RefItems = New Collection + + If (0 / 1) + (Not Not CodeLibRefs) Then + For i = 0 To UBound(CodeLibRefs) + RefItems.Add "{" & _ + JsonPair("name", JsonString(CodeLibRefs(i).Name)) & "," & _ + JsonPair("guid", JsonString(CodeLibRefs(i).GUID)) & "," & _ + JsonPair("major", CStr(CodeLibRefs(i).Major)) & "," & _ + JsonPair("minor", CStr(CodeLibRefs(i).Minor)) & "," & _ + JsonPair("status", JsonString(ReferenceStatus(CodeLibRefs(i)))) & "}" + Next + End If + + ReferencesJson = JsonArray(RefItems) + +End Function + +Private Function ReferenceStatus(ByRef CodeLibRef As CodeLibInfoReference) As String +' same rules as ACLibFileManager.AddMissingReference + + Dim ref As Access.Reference + + For Each ref In Access.References + If ref.Name = CodeLibRef.Name Then + If ref.Major < CodeLibRef.Major Then + ReferenceStatus = "update" + ElseIf ref.Major = CodeLibRef.Major And ref.Minor < CodeLibRef.Minor Then + ReferenceStatus = "update" + Else + ReferenceStatus = "present" + End If + Exit Function + End If + Next + + ReferenceStatus = "add" + +End Function + +Private Function GetReferenceItems() As Collection +' key: JSON object of the reference + + Dim RefItems As Collection + Dim ref As Access.Reference + Dim RefJson As String + + Set RefItems = New Collection + + For Each ref In Access.References + RefJson = "{" & _ + JsonPair("name", JsonString(ref.Name)) & "," & _ + JsonPair("guid", JsonString(ref.GUID)) & "," & _ + JsonPair("major", CStr(ref.Major)) & "," & _ + JsonPair("minor", CStr(ref.Minor)) & "}" + If Not CollectionContains(RefItems, RefJson) Then + RefItems.Add RefJson, RefJson + End If + Next + + Set GetReferenceItems = RefItems + +End Function + +'--------------------------------------------------------------------------------------- +' Helper +'--------------------------------------------------------------------------------------- + +Private Function SplitFiles(ByVal Files As String) As String() + + Dim FileItems() As String + Dim Result() As String + Dim FileItem As String + Dim ResultIdx As Long + Dim i As Long + + FileItems = Split(Files, ";") + ResultIdx = -1 + + For i = LBound(FileItems) To UBound(FileItems) + FileItem = Replace(Trim$(FileItems(i)), "\", "/") + If Len(FileItem) > 0 Then + ResultIdx = ResultIdx + 1 + ReDim Preserve Result(ResultIdx) + Result(ResultIdx) = FileItem + End If + Next + + If ResultIdx < 0 Then + Err.Raise ERR_INVALID_ARGUMENT, "ACLibApiImportSession.SplitFiles", "No files specified" + End If + + SplitFiles = Result + +End Function + +Private Function CollectionDifference(ByVal SourceCollection As Collection, ByVal ExcludeCollection As Collection) As Collection +' items of SourceCollection which are not a key in ExcludeCollection + + Dim Result As Collection + Dim Item As Variant + + Set Result = New Collection + For Each Item In SourceCollection + If Not CollectionContains(ExcludeCollection, Item) Then + Result.Add Item + End If + Next + + Set CollectionDifference = Result + +End Function + +Private Function CollectionContains(ByVal col As Collection, ByVal Key As String) As Boolean + Dim Item As Variant + CollectionContains = TryGetCollectionItem(col, Key, Item) +End Function + +Private Function TryGetCollectionItem(ByVal col As Collection, ByVal Key As String, ByRef Item As Variant) As Boolean +' Collection has no Exists method => check via error (not found is a valid result) + +On Error GoTo HandleErr + + If col Is Nothing Then Exit Function + Item = col.Item(Key) + TryGetCollectionItem = True + + Exit Function + +HandleErr: + Err.Clear + +End Function + +Private Function ElementTypeName(ByVal ElementType As CodeLibElementType) As String + Select Case ElementType + Case CodeLibElementType.clet_StdModule + ElementTypeName = "module" + Case CodeLibElementType.clet_ClassModule + ElementTypeName = "class" + Case CodeLibElementType.clet_Form + ElementTypeName = "form" + Case CodeLibElementType.clet_Report + ElementTypeName = "report" + Case CodeLibElementType.clet_Package + ElementTypeName = "package" + Case Else + ElementTypeName = "unknown" + End Select +End Function + +Private Function ComponentTypeName(ByVal ComponentType As Long, ByVal ComponentName As String) As String + Select Case ComponentType + Case vbext_ct_StdModule + ComponentTypeName = "module" + Case vbext_ct_ClassModule + ComponentTypeName = "class" + Case vbext_ct_Document + If Left$(ComponentName, 5) = "Form_" Then + ComponentTypeName = "form" + ElseIf Left$(ComponentName, 7) = "Report_" Then + ComponentTypeName = "report" + Else + ComponentTypeName = "document" + End If + Case Else + ComponentTypeName = "unknown" + End Select +End Function + +Private Function ImportModeName(ByVal ImportMode As CodeLibImportMode) As String + Select Case ImportMode + Case clim_ImportMissingItems + ImportModeName = "missing" + Case clim_ImportAllUsedItems + ImportModeName = "all" + Case clim_ImportSelectedOnly + ImportModeName = "selected" + End Select +End Function + +'--------------------------------------------------------------------------------------- +' JSON writer +'--------------------------------------------------------------------------------------- + +Private Function OkResult(ByVal BodyJson As String) As String + OkResult = "{""ok"":true," & BodyJson & "}" +End Function + +Private Function JsonPair(ByVal Name As String, ByVal ValueJson As String) As String + JsonPair = JsonString(Name) & ":" & ValueJson +End Function + +Private Function JsonBool(ByVal Value As Boolean) As String + If Value Then + JsonBool = "true" + Else + JsonBool = "false" + End If +End Function + +Private Function JsonStringOrNull(ByVal Value As String) As String + If Len(Value) = 0 Then + JsonStringOrNull = "null" + Else + JsonStringOrNull = JsonString(Value) + End If +End Function + +Private Function JsonStringArray(ByRef Values() As String) As String + + Dim Result As String + Dim i As Long + + If (0 / 1) + (Not Not Values) Then + For i = LBound(Values) To UBound(Values) + Result = Result & "," & JsonString(Values(i)) + Next + Result = Mid$(Result, 2) + End If + + JsonStringArray = "[" & Result & "]" + +End Function + +Private Function JsonArray(ByVal Items As Collection, Optional ByVal QuoteItems As Boolean = False) As String +' Items: JSON values (QuoteItems = False) or plain strings (QuoteItems = True) + + Dim Result As String + Dim Item As Variant + + If Not Items Is Nothing Then + For Each Item In Items + If QuoteItems Then + Result = Result & "," & JsonString(Item) + Else + Result = Result & "," & Item + End If + Next + Result = Mid$(Result, 2) + End If + + JsonArray = "[" & Result & "]" + +End Function + +Private Function JsonString(ByVal Value As String) As String + + Dim Result As String + Dim CharCode As Long + Dim i As Long + + For i = 1 To Len(Value) + CharCode = AscW(Mid$(Value, i, 1)) And &HFFFF& + Select Case CharCode + Case 34 ' " + Result = Result & "\""" + Case 92 ' \ + Result = Result & "\\" + Case 8 + Result = Result & "\b" + Case 9 + Result = Result & "\t" + Case 10 + Result = Result & "\n" + Case 12 + Result = Result & "\f" + Case 13 + Result = Result & "\r" + Case Is < 32 + Result = Result & "\u" & Right$("000" & Hex$(CharCode), 4) + Case Else + Result = Result & Mid$(Value, i, 1) + End Select + Next + + JsonString = """" & Result & """" + +End Function diff --git a/source/modules/ACLibFileManager.cls b/source/modules/ACLibFileManager.cls index d072d63..4a7aa86 100644 --- a/source/modules/ACLibFileManager.cls +++ b/source/modules/ACLibFileManager.cls @@ -105,6 +105,9 @@ Private m_LocalRepositoryRootDirectory As String ' Local root directory for re Private m_PrivateRepositoryRootDirectory As String ' Local root directory for private repository export Private m_ExportAllToApplicationSourceFolder As Boolean +Private m_SilentMode As Boolean ' Collect messages instead of showing a MsgBox (used by API) +Private m_Messages As Collection + ' Events Public Event PropertyMissingLocalRepositoryRootDirectory(ByRef NewValue As String) Public Event MissingLocalRepositoryFile(ByVal ACLibPath As String, ByVal FullFilePath As String) @@ -207,6 +210,47 @@ Public Property Let ExportAllToApplicationSourceFolder(ByVal NewValue As Boolean m_ExportAllToApplicationSourceFolder = NewValue End Property +'--------------------------------------------------------------------------------------- +' Property: SilentMode +'--------------------------------------------------------------------------------------- +' +' True: messages are collected in Messages instead of being shown in a MsgBox +' +'--------------------------------------------------------------------------------------- +Public Property Get SilentMode() As Boolean + SilentMode = m_SilentMode +End Property + +Public Property Let SilentMode(ByVal NewValue As Boolean) + m_SilentMode = NewValue +End Property + +Public Property Get Messages() As Collection + If m_Messages Is Nothing Then + Set m_Messages = New Collection + End If + Set Messages = m_Messages +End Property + +Public Sub ClearMessages() + Set m_Messages = Nothing +End Sub + +Private Sub AddMessage(ByVal Message As String) + Messages.Add Message +End Sub + +'--------------------------------------------------------------------------------------- +' Sub: ResetRepositoryRootDirectory +'--------------------------------------------------------------------------------------- +' +' Remove cached local repository root, the next access raises PropertyMissingLocalRepositoryRootDirectory again +' +'--------------------------------------------------------------------------------------- +Public Sub ResetRepositoryRootDirectory() + m_LocalRepositoryRootDirectory = vbNullString +End Sub + Public Sub ExportAll() Dim ExportComponentsWithoutCodeLibInfo As Boolean @@ -406,8 +450,6 @@ Private Sub ImportFilesFromImportCollection( _ i = i + 1 Loop - - If CompileAfterImport Then ActivateCurrentProject CurrentProject.Application.DoCmd.RunCommand acCmdCompileAndSaveAllModules @@ -460,7 +502,11 @@ Private Function TryRunAddInProcedure(ByVal ProcedureCall As String) As Boolean AddInFilePath = Left(ProcedureCall, InStrRev(ProcedureCall, ".")) & "accda" If Len(VBA.Dir(AddInFilePath)) = 0 Then If Mid(ProcedureCall, 2, 1) = ":" Then ' is an add-in call, but add-in is not available => ignore it - VBA.MsgBox "Add-in '" & AddInFilePath & "' is not available, procedure call is skipped", vbInformation, "Call procedure skipped" + If m_SilentMode Then + AddMessage "Add-in '" & AddInFilePath & "' is not available, procedure call is skipped" + Else + VBA.MsgBox "Add-in '" & AddInFilePath & "' is not available, procedure call is skipped", vbInformation, "Call procedure skipped" + End If TryRunAddInProcedure = True End If Exit Function @@ -1837,7 +1883,11 @@ Private Sub RefreshAllAccessObjects(ByVal AoType As AcObjectType, _ ImportFilesFromImportCollection If ShowMessageAfterRefresh Then - MsgBox "Update is completed" + If m_SilentMode Then + AddMessage "Update is completed" + Else + MsgBox "Update is completed" + End If End If End Sub diff --git a/source/modules/_config_Application.bas b/source/modules/_config_Application.bas index 2c6169c..fdf4231 100644 --- a/source/modules/_config_Application.bas +++ b/source/modules/_config_Application.bas @@ -13,7 +13,7 @@ Option Compare Database Option Explicit 'Versionsnummer -Private Const APPLICATION_VERSION As String = "1.4.2" +Private Const APPLICATION_VERSION As String = "1.5.0" #Const USE_CLASS_ApplicationHandler_AppFile = 1 #Const USE_CLASS_ApplicationHandler_DirTextbox = 1 diff --git a/source/modules/modApi.bas b/source/modules/modApi.bas new file mode 100644 index 0000000..2202f6b --- /dev/null +++ b/source/modules/modApi.bas @@ -0,0 +1,156 @@ +Attribute VB_Name = "modApi" +'--------------------------------------------------------------------------------------- +' Package: modApi +'--------------------------------------------------------------------------------------- +' +' Automation API of the wizard (without UI, result as JSON) +' +' Author: +' Josef Poetzl +' +' Remarks: +'--------------------------------------------------------------------------------------- +'| Call (e.g. via Application.Run or msaccess-vcs-mcp vcs_call_vba): +'| Application.Run ".API", "Resolve", "data/SqlTools.cls", "mode=missing" +'| +'| Commands: +'| GetVersion +'| GetConfig [Options] +'| ListInstalled +'| Resolve Files, [Options] (read only) +'| Import Files, [Options] +'| +'| Files: "data/SqlTools.cls;form/filter/FilterControlManager.cls" +'| Options: "mode=missing|all|selected;tests=0|1;examples=0|1;source=config|local|github;repo=owner/name@branch" +'| +'| Result: {"ok":true,...} or {"ok":false,"error":{"number":..,"source":..,"description":..}} +'--------------------------------------------------------------------------------------- +' +Option Compare Text +Option Explicit + +Private Const API_VERSION As Long = 1 +Private Const ERR_INVALID_ARGUMENT As Long = vbObjectError + 1001 +Private Const ERR_UNKNOWN_COMMAND As Long = vbObjectError + 1003 + +'--------------------------------------------------------------------------------------- +' Function: API +'--------------------------------------------------------------------------------------- +' +' Dispatcher for automation commands +' +' Parameters: +' Command - GetVersion, GetConfig, ListInstalled, Resolve, Import +' Args - command arguments (strings) +' +' Returns: +' JSON string +' +' Remarks: +' Errors are returned as JSON (ok:false) at this API boundary, no MsgBox. +' +'--------------------------------------------------------------------------------------- +Public Function API(ByVal Command As String, ParamArray Args() As Variant) As String + + Dim ArgList As Variant + Dim SavedErrorHandlerMode As ACLibErrorHandlerMode + Dim ErrorHandlerModeChanged As Boolean + Dim Session As ACLibApiImportSession + Dim AppVersion As String + +On Error GoTo HandleErr + + ArgList = Args + + ' First access initializes the application (InitConfig sets the default error handler mode) + AppVersion = CurrentApplication.Version + + SavedErrorHandlerMode = modErrorHandler.DefaultErrorHandlerMode + modErrorHandler.DefaultErrorHandlerMode = ACLibErrorHandlerMode.aclibErrRaise + ErrorHandlerModeChanged = True + + Select Case Trim$(Command) + Case "GetVersion" + API = "{""ok"":true,""version"":" & JsonString(AppVersion) & ",""api"":" & API_VERSION & "}" + + Case "GetConfig" + Set Session = New ACLibApiImportSession + Session.Configure GetArg(ArgList, 0) + API = Session.GetConfig + + Case "ListInstalled" + Set Session = New ACLibApiImportSession + API = Session.ListInstalled + + Case "Resolve" + Set Session = New ACLibApiImportSession + Session.Configure GetArg(ArgList, 1) + API = Session.Resolve(GetRequiredArg(ArgList, 0, "Files")) + + Case "Import" + Set Session = New ACLibApiImportSession + Session.Configure GetArg(ArgList, 1) + API = Session.Import(GetRequiredArg(ArgList, 0, "Files")) + + Case Else + Err.Raise ERR_UNKNOWN_COMMAND, "modApi.API", "Unknown command '" & Command & "' (GetVersion, GetConfig, ListInstalled, Resolve, Import)" + + End Select + +ExitHere: + Set Session = Nothing ' Class_Terminate restores wizard state + If ErrorHandlerModeChanged Then + modErrorHandler.DefaultErrorHandlerMode = SavedErrorHandlerMode + End If + Exit Function + +HandleErr: + API = ErrorResult(Err.Number, Err.Source, Err.Description) + Resume ExitHere + +End Function + +Private Function GetArg(ByRef ArgList As Variant, ByVal Index As Long) As String + If UBound(ArgList) >= Index Then + If Not IsMissing(ArgList(Index)) Then + GetArg = Nz(ArgList(Index), vbNullString) + End If + End If +End Function + +Private Function GetRequiredArg(ByRef ArgList As Variant, ByVal Index As Long, ByVal ArgName As String) As String + GetRequiredArg = GetArg(ArgList, Index) + If Len(Trim$(GetRequiredArg)) = 0 Then + Err.Raise ERR_INVALID_ARGUMENT, "modApi.API", "Argument '" & ArgName & "' is missing" + End If +End Function + +Private Function ErrorResult(ByVal ErrNumber As Long, ByVal ErrSource As String, ByVal ErrDescription As String) As String + ErrorResult = "{""ok"":false,""error"":{" & _ + """number"":" & ErrNumber & "," & _ + """source"":" & JsonString(ErrSource) & "," & _ + """description"":" & JsonString(ErrDescription) & "}}" +End Function + +Private Function JsonString(ByVal Value As String) As String +' minimal escaping for the result envelope (full JSON writer: ACLibApiImportSession) + + Dim Result As String + Dim CharCode As Long + Dim i As Long + + For i = 1 To Len(Value) + CharCode = AscW(Mid$(Value, i, 1)) And &HFFFF& + Select Case CharCode + Case 34, 92 ' " \ + Result = Result & "\" & Mid$(Value, i, 1) + Case Is < 32 + Result = Result & "\u" & Right$("000" & Hex$(CharCode), 4) + Case Else + Result = Result & Mid$(Value, i, 1) + End Select + Next + + JsonString = """" & Result & """" + +End Function diff --git a/source/tables/L10n_Dict.xml b/source/tables/L10n_Dict.xml index 66820fc..a22fe00 100644 --- a/source/tables/L10n_Dict.xml +++ b/source/tables/L10n_Dict.xml @@ -95,11 +95,21 @@ import only the selected file(s) nur die ausgewählte Datei(en) importieren + + DE + Import process running ... + Importvorgang läuft … + DE Import process running … Importvorgang läuft … + + DE + incl. &examples + inkl. B&eispielen + DE incl. &test classes @@ -247,6 +257,11 @@ Markierte Einträge können mit {Entf}-Taste aus der Liste entfernt werden.Export Export + + EN + Export abgeschlossen + Export abgeschlossen + EN Export all existing CodeModules @@ -393,24 +408,9 @@ Marked entries can be removed from the list with {Del} key. Update all existing objects Update all existing objects - - EN - Export abgeschlossen - Export abgeschlossen - EN Update is completed Update is completed - - DE - incl. &examples - inkl. B&eispielen - - - DE - Import process running ... - Importvorgang läuft … - diff --git a/source/tables/USysRegInfo.xml b/source/tables/USysRegInfo.xml index 061e070..09e8c74 100644 --- a/source/tables/USysRegInfo.xml +++ b/source/tables/USysRegInfo.xml @@ -2,13 +2,13 @@ HKEY_CURRENT_ACCESS_PROFILE\Menu Add-Ins\ACLib Import Wizard - 4 - BitmapID - 339 + 0 HKEY_CURRENT_ACCESS_PROFILE\Menu Add-Ins\ACLib Import Wizard - 0 + 1 + Expression + =StartApplication() HKEY_CURRENT_ACCESS_PROFILE\Menu Add-Ins\ACLib Import Wizard @@ -18,9 +18,9 @@ HKEY_CURRENT_ACCESS_PROFILE\Menu Add-Ins\ACLib Import Wizard - 1 - Expression - =StartApplication() + 4 + BitmapID + 339 HKEY_CURRENT_ACCESS_PROFILE\Menu Add-Ins\ACLib Import Wizard diff --git a/source/tbldefs/L10n_Dict.xml b/source/tbldefs/L10n_Dict.xml index b28357a..3a280ce 100644 --- a/source/tbldefs/L10n_Dict.xml +++ b/source/tbldefs/L10n_Dict.xml @@ -12,24 +12,24 @@ - - + + + + + + + - - - - - - - - - - - + + + + + + @@ -37,19 +37,19 @@ - - - - - - + + + + - + + + @@ -61,19 +61,19 @@ - - - - - - + + + + - + + + @@ -85,19 +85,19 @@ - - - - - - + + + + - + + + diff --git a/source/tbldefs/USysRegInfo.json b/source/tbldefs/USysRegInfo.json new file mode 100644 index 0000000..de6bc30 --- /dev/null +++ b/source/tbldefs/USysRegInfo.json @@ -0,0 +1,9 @@ +{ + "Info": { + "Class": "clsDbTableDef", + "Description": "USysRegInfo Metadata" + }, + "Items": { + "Hidden": true + } +} diff --git a/source/tbldefs/USysRegInfo.xml b/source/tbldefs/USysRegInfo.xml index 412cdaf..aa0716b 100644 --- a/source/tbldefs/USysRegInfo.xml +++ b/source/tbldefs/USysRegInfo.xml @@ -11,15 +11,15 @@ - - - - + + + + @@ -27,16 +27,16 @@ - - - - + + + + - - + + @@ -49,31 +49,31 @@ - - + + + - + - - - - - + + + + - - + + @@ -86,16 +86,16 @@ - - - - + + + + - - + + diff --git a/source/tbldefs/USys_AppFiles.json b/source/tbldefs/USys_AppFiles.json new file mode 100644 index 0000000..cd26bb7 --- /dev/null +++ b/source/tbldefs/USys_AppFiles.json @@ -0,0 +1,9 @@ +{ + "Info": { + "Class": "clsDbTableDef", + "Description": "USys_AppFiles Metadata" + }, + "Items": { + "Hidden": true + } +} diff --git a/source/tbldefs/USys_AppFiles.xml b/source/tbldefs/USys_AppFiles.xml index 9f495aa..075f2ce 100644 --- a/source/tbldefs/USys_AppFiles.xml +++ b/source/tbldefs/USys_AppFiles.xml @@ -12,15 +12,15 @@ - - - - - + + + + + @@ -28,17 +28,17 @@ - - - - + + + + - + - + @@ -50,17 +50,17 @@ - - - - + + + + - + - + @@ -72,12 +72,12 @@ - - + + + - diff --git a/source/tbldefs/tab1DS.json b/source/tbldefs/tab1DS.json new file mode 100644 index 0000000..94829a8 --- /dev/null +++ b/source/tbldefs/tab1DS.json @@ -0,0 +1,15 @@ +{ + "Info": { + "Class": "clsDbTableDef", + "Description": "tab1DS Metadata" + }, + "Items": { + "Properties": { + "Description": { + "Type": 10, + "Value": "Tabelle mit einem DS (ist in Abfragen hilfeich)" + } + }, + "Hidden": true + } +} diff --git a/source/tbldefs/tab1DS.xml b/source/tbldefs/tab1DS.xml index 3ad0246..77e6043 100644 --- a/source/tbldefs/tab1DS.xml +++ b/source/tbldefs/tab1DS.xml @@ -12,16 +12,16 @@ - - - - - + + + + + @@ -29,28 +29,28 @@ - - + - - + + + - + - - + + + + - - diff --git a/source/vcs-options.json b/source/vcs-options.json index bd04244..a0d501e 100644 --- a/source/vcs-options.json +++ b/source/vcs-options.json @@ -1,15 +1,25 @@ { "Info": { - "AddinVersion": "4.1.3", + "AddinVersion": "5.1.0", "AccessVersion": "16.0 64-bit" }, "Options": { "ExportFolder": "\\source", - "ShowDebug": false, "UseFastSave": true, - "UseMergeBuild": false, - "UseGitIntegration": false, + "SplitLayoutFromVBA": true, + "ExportFormatVersion": "5.1.0", + "RunBeforeExport": "VcsRunBeforeExport", + "RunAfterExport": "", + "SanitizeLevel": 2, + "SanitizeColors": 1, + "SaveQuerySQL": true, + "FormatSQL": true, + "UseDeterministicQueryExport": true, + "SaveTableSQL": true, "SavePrintVars": true, + "DecodeConditionalFormatting": true, + "ExtractThemeFiles": false, + "UseEnvForConnections": 0, "ExportPrintSettings": { "Orientation": true, "PaperSize": true, @@ -32,15 +42,19 @@ "PaperWidth": false, "TTOption": false }, - "SaveQuerySQL": true, - "FormatSQL": true, + "ExportLayoutSvg": false, + "LayoutSvgImageEmbed": "Small", + "LayoutSvgScaleMode": "Universal", + "ExportAfterMerge": false, "ForceImportOriginalQuerySQL": false, - "SaveTableSQL": true, - "SplitLayoutFromVBA": true, - "StripPublishOption": true, - "SanitizeColors": 1, - "SanitizeLevel": 2, - "ExtractThemeFiles": false, + "UseMergeBuild": false, + "MergeTableData": true, + "SkipReopenBeforeMerge": false, + "RunBeforeBuild": "", + "RunAfterBuild": "", + "RunBeforeMerge": "", + "RunAfterMerge": "", + "ValidateAfterBuild": "", "TablesToExportData": { "L10n_Dict": { "Format": "XML Format" @@ -60,16 +74,26 @@ }, "SchemaExports": { }, - "RunBeforeExport": "VcsRunBeforeExport", - "RunAfterExport": "", - "RunBeforeBuild": "", - "RunAfterBuild": "", - "RunBeforeMerge": "", - "RunAfterMerge": "", - "ShowVCSLegacy": true, + "McpAllowImport": true, + "McpAllowCallVBA": true, + "McpAllowExecuteSQL": true, + "McpAllowRunVBA": false, + "DefaultTestFilter": "", + "ShowDebug": false, + "BreakOnError": false, + "MaxLogFiles": 20, + "StripPublishOption": true, + "PreserveRubberDuckID": false, + "SaveAllDocumentProperties": false, + "SaveLinkedTableDef": false, "HashAlgorithm": "SHA256", "UseShortHash": true, - "BreakOnError": false, - "PreserveRubberDuckID": false + "UseGitIntegration": false, + "ShowVCSLegacy": true, + "UseWebTestRunner": true, + "ExportTestResultsJUnit": true, + "ExportTestResultsHtml": true, + "ExportPerfJson": false, + "McpProgressIntervalMs": 500 } }