From 9caddc0d2ad921f1ce70a8b93a250da0991f0ee7 Mon Sep 17 00:00:00 2001 From: Benjamin Date: Wed, 1 Dec 2021 13:01:26 -0500 Subject: [PATCH] Rewrite converter (#11) Co-authored-by: Ben --- .gitignore | 395 ++++++ VBExtension.cs | 24 + frm.frm | 67 +- modConfig.bas | 27 +- modControlProperties.bas | 5 +- modConvert.bas | 1381 +----------------- modConvertForm.bas | 15 +- modOrigConvert.bas | 1283 +++++++++++++++++ modQuickConvert.bas | 1357 ++++++++++++++++++ modQuickLint.bas | 82 +- modRefScan.bas | 15 + modRegEx.bas | 2 +- modShell.bas | 6 +- modSupportFiles.bas | 2 +- modUsingEverything.bas | 1 + modUtils.bas | 20 +- modVB6ToCS.bas | 2 +- prj.vbp | 2 + prj.vbw | 22 +- quick/App.config | 6 + quick/App.xaml.cs | 17 + quick/Forms/frm.xaml | 35 + quick/Forms/frm.xaml.cs | 174 +++ quick/Forms/frmConfig.xaml | 24 + quick/Forms/frmConfig.xaml.cs | 66 + quick/Forms/frmLinter.xaml | 23 + quick/Forms/frmLinter.xaml.cs | 45 + quick/Modules/frmTest.cs | 1063 ++++++++++++++ quick/Modules/modConfig.cs | 115 ++ quick/Modules/modControlProperties.cs | 93 ++ quick/Modules/modConvert.cs | 272 ++++ quick/Modules/modConvertForm.cs | 458 ++++++ quick/Modules/modConvertUtils.cs | 138 ++ quick/Modules/modDirStack.cs | 100 ++ quick/Modules/modGit.cs | 187 +++ quick/Modules/modINI.cs | 117 ++ quick/Modules/modOrigConvert.cs | 1573 +++++++++++++++++++++ quick/Modules/modProjectFiles.cs | 138 ++ quick/Modules/modProjectSpecific.cs | 53 + quick/Modules/modQuickConvert.cs | 1807 ++++++++++++++++++++++++ quick/Modules/modQuickLint.cs | 884 ++++++++++++ quick/Modules/modRefScan.cs | 477 +++++++ quick/Modules/modRegEx.cs | 114 ++ quick/Modules/modShell.cs | 203 +++ quick/Modules/modSubTracking.cs | 284 ++++ quick/Modules/modSupportFiles.cs | 591 ++++++++ quick/Modules/modTestCases.cs | 91 ++ quick/Modules/modTextFiles.cs | 414 ++++++ quick/Modules/modUsingEverything.cs | 116 ++ quick/Modules/modUtils.cs | 745 ++++++++++ quick/Modules/modVB6ToCS.cs | 525 +++++++ quick/Properties/AssemblyInfo.cs | 55 + quick/Properties/Resources.Designer.cs | 64 + quick/Properties/Resources.resx | 118 ++ quick/Properties/Settings.Designer.cs | 26 + quick/Properties/Settings.settings | 7 + quick/VBConstants.cs | 122 ++ quick/VBExtension.cs | 980 +++++++++++++ quick/application.xaml | 8 + quick/prj.csproj | 157 ++ quick/prj.sln | 25 + 61 files changed, 15814 insertions(+), 1404 deletions(-) create mode 100644 modOrigConvert.bas create mode 100644 modQuickConvert.bas create mode 100644 quick/App.config create mode 100644 quick/App.xaml.cs create mode 100644 quick/Forms/frm.xaml create mode 100644 quick/Forms/frm.xaml.cs create mode 100644 quick/Forms/frmConfig.xaml create mode 100644 quick/Forms/frmConfig.xaml.cs create mode 100644 quick/Forms/frmLinter.xaml create mode 100644 quick/Forms/frmLinter.xaml.cs create mode 100644 quick/Modules/frmTest.cs create mode 100644 quick/Modules/modConfig.cs create mode 100644 quick/Modules/modControlProperties.cs create mode 100644 quick/Modules/modConvert.cs create mode 100644 quick/Modules/modConvertForm.cs create mode 100644 quick/Modules/modConvertUtils.cs create mode 100644 quick/Modules/modDirStack.cs create mode 100644 quick/Modules/modGit.cs create mode 100644 quick/Modules/modINI.cs create mode 100644 quick/Modules/modOrigConvert.cs create mode 100644 quick/Modules/modProjectFiles.cs create mode 100644 quick/Modules/modProjectSpecific.cs create mode 100644 quick/Modules/modQuickConvert.cs create mode 100644 quick/Modules/modQuickLint.cs create mode 100644 quick/Modules/modRefScan.cs create mode 100644 quick/Modules/modRegEx.cs create mode 100644 quick/Modules/modShell.cs create mode 100644 quick/Modules/modSubTracking.cs create mode 100644 quick/Modules/modSupportFiles.cs create mode 100644 quick/Modules/modTestCases.cs create mode 100644 quick/Modules/modTextFiles.cs create mode 100644 quick/Modules/modUsingEverything.cs create mode 100644 quick/Modules/modUtils.cs create mode 100644 quick/Modules/modVB6ToCS.cs create mode 100644 quick/Properties/AssemblyInfo.cs create mode 100644 quick/Properties/Resources.Designer.cs create mode 100644 quick/Properties/Resources.resx create mode 100644 quick/Properties/Settings.Designer.cs create mode 100644 quick/Properties/Settings.settings create mode 100644 quick/VBConstants.cs create mode 100644 quick/VBExtension.cs create mode 100644 quick/application.xaml create mode 100644 quick/prj.csproj create mode 100644 quick/prj.sln diff --git a/.gitignore b/.gitignore index bf6ff7f..99fddbb 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,398 @@ controls.txt VB6toCS.INI VisualBasicPowerPacks3Setup.exe *.tmp +quick/obj/ +.i.cache +.i.lref +.vs/ + + + +## Ignore Visual Studio temporary files, build results, and +## files generated by popular Visual Studio add-ons. +## +## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore + +# User-specific files +*.rsuser +*.suo +*.user +*.userosscache +*.sln.docstates + +# User-specific files (MonoDevelop/Xamarin Studio) +*.userprefs + +# Mono auto generated files +mono_crash.* + +# Build results +[Dd]ebug/ +[Dd]ebugPublic/ +[Rr]elease/ +[Rr]eleases/ +x64/ +x86/ +[Ww][Ii][Nn]32/ +[Aa][Rr][Mm]/ +[Aa][Rr][Mm]64/ +bld/ +[Bb]in/ +[Oo]bj/ +[Ll]og/ +[Ll]ogs/ + +# Visual Studio 2015/2017 cache/options directory +.vs/ +# Uncomment if you have tasks that create the project's static files in wwwroot +#wwwroot/ + +# Visual Studio 2017 auto generated files +Generated\ Files/ + +# MSTest test Results +[Tt]est[Rr]esult*/ +[Bb]uild[Ll]og.* + +# NUnit +*.VisualState.xml +TestResult.xml +nunit-*.xml + +# Build Results of an ATL Project +[Dd]ebugPS/ +[Rr]eleasePS/ +dlldata.c + +# Benchmark Results +BenchmarkDotNet.Artifacts/ + +# .NET Core +project.lock.json +project.fragment.lock.json +artifacts/ + +# ASP.NET Scaffolding +ScaffoldingReadMe.txt + +# StyleCop +StyleCopReport.xml + +# Files built by Visual Studio +*_i.c +*_p.c +*_h.h +*.ilk +*.meta +*.obj +*.iobj +*.pch +*.pdb +*.ipdb +*.pgc +*.pgd +*.rsp +*.sbr +*.tlb +*.tli +*.tlh +*.tmp +*.tmp_proj +*_wpftmp.csproj +*.log +*.tlog +*.vspscc +*.vssscc +.builds +*.pidb +*.svclog +*.scc + +# Chutzpah Test files +_Chutzpah* + +# Visual C++ cache files +ipch/ +*.aps +*.ncb +*.opendb +*.opensdf +*.sdf +*.cachefile +*.VC.db +*.VC.VC.opendb + +# Visual Studio profiler +*.psess +*.vsp +*.vspx +*.sap + +# Visual Studio Trace Files +*.e2e + +# TFS 2012 Local Workspace +$tf/ + +# Guidance Automation Toolkit +*.gpState + +# ReSharper is a .NET coding add-in +_ReSharper*/ +*.[Rr]e[Ss]harper +*.DotSettings.user + +# TeamCity is a build add-in +_TeamCity* + +# DotCover is a Code Coverage Tool +*.dotCover + +# AxoCover is a Code Coverage Tool +.axoCover/* +!.axoCover/settings.json + +# Coverlet is a free, cross platform Code Coverage Tool +coverage*.json +coverage*.xml +coverage*.info + +# Visual Studio code coverage results +*.coverage +*.coveragexml + +# NCrunch +_NCrunch_* +.*crunch*.local.xml +nCrunchTemp_* + +# MightyMoose +*.mm.* +AutoTest.Net/ + +# Web workbench (sass) +.sass-cache/ + +# Installshield output folder +[Ee]xpress/ + +# DocProject is a documentation generator add-in +DocProject/buildhelp/ +DocProject/Help/*.HxT +DocProject/Help/*.HxC +DocProject/Help/*.hhc +DocProject/Help/*.hhk +DocProject/Help/*.hhp +DocProject/Help/Html2 +DocProject/Help/html + +# Click-Once directory +publish/ + +# Publish Web Output +*.[Pp]ublish.xml +*.azurePubxml +# Note: Comment the next line if you want to checkin your web deploy settings, +# but database connection strings (with potential passwords) will be unencrypted +*.pubxml +*.publishproj + +# Microsoft Azure Web App publish settings. Comment the next line if you want to +# checkin your Azure Web App publish settings, but sensitive information contained +# in these scripts will be unencrypted +PublishScripts/ + +# NuGet Packages +*.nupkg +# NuGet Symbol Packages +*.snupkg +# The packages folder can be ignored because of Package Restore +**/[Pp]ackages/* +# except build/, which is used as an MSBuild target. +!**/[Pp]ackages/build/ +# Uncomment if necessary however generally it will be regenerated when needed +#!**/[Pp]ackages/repositories.config +# NuGet v3's project.json files produces more ignorable files +*.nuget.props +*.nuget.targets + +# Nuget personal access tokens and Credentials +# nuget.config + +# Microsoft Azure Build Output +csx/ +*.build.csdef + +# Microsoft Azure Emulator +ecf/ +rcf/ + +# Windows Store app package directories and files +AppPackages/ +BundleArtifacts/ +Package.StoreAssociation.xml +_pkginfo.txt +*.appx +*.appxbundle +*.appxupload + +# Visual Studio cache files +# files ending in .cache can be ignored +*.[Cc]ache +# but keep track of directories ending in .cache +!?*.[Cc]ache/ + +# Others +ClientBin/ +~$* +*~ +*.dbmdl +*.dbproj.schemaview +*.jfm +*.pfx +*.publishsettings +orleans.codegen.cs + +# Including strong name files can present a security risk +# (https://github.com/github/gitignore/pull/2483#issue-259490424) +#*.snk + +# Since there are multiple workflows, uncomment next line to ignore bower_components +# (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) +#bower_components/ + +# RIA/Silverlight projects +Generated_Code/ + +# Backup & report files from converting an old project file +# to a newer Visual Studio version. Backup files are not needed, +# because we have git ;-) +_UpgradeReport_Files/ +Backup*/ +UpgradeLog*.XML +UpgradeLog*.htm +ServiceFabricBackup/ +*.rptproj.bak + +# SQL Server files +*.mdf +*.ldf +*.ndf + +# Business Intelligence projects +*.rdl.data +*.bim.layout +*.bim_*.settings +*.rptproj.rsuser +*- [Bb]ackup.rdl +*- [Bb]ackup ([0-9]).rdl +*- [Bb]ackup ([0-9][0-9]).rdl + +# Microsoft Fakes +FakesAssemblies/ + +# GhostDoc plugin setting file +*.GhostDoc.xml + +# Node.js Tools for Visual Studio +.ntvs_analysis.dat +node_modules/ + +# Visual Studio 6 build log +*.plg + +# Visual Studio 6 workspace options file +*.opt + +# Visual Studio 6 auto-generated workspace file (contains which files were open etc.) +*.vbw + +# Visual Studio LightSwitch build output +**/*.HTMLClient/GeneratedArtifacts +**/*.DesktopClient/GeneratedArtifacts +**/*.DesktopClient/ModelManifest.xml +**/*.Server/GeneratedArtifacts +**/*.Server/ModelManifest.xml +_Pvt_Extensions + +# Paket dependency manager +.paket/paket.exe +paket-files/ + +# FAKE - F# Make +.fake/ + +# CodeRush personal settings +.cr/personal + +# Python Tools for Visual Studio (PTVS) +__pycache__/ +*.pyc + +# Cake - Uncomment if you are using it +# tools/** +# !tools/packages.config + +# Tabs Studio +*.tss + +# Telerik's JustMock configuration file +*.jmconfig + +# BizTalk build output +*.btp.cs +*.btm.cs +*.odx.cs +*.xsd.cs + +# OpenCover UI analysis results +OpenCover/ + +# Azure Stream Analytics local run output +ASALocalRun/ + +# MSBuild Binary and Structured Log +*.binlog + +# NVidia Nsight GPU debugger configuration file +*.nvuser + +# MFractors (Xamarin productivity tool) working folder +.mfractor/ + +# Local History for Visual Studio +.localhistory/ + +# BeatPulse healthcheck temp database +healthchecksdb + +# Backup folder for Package Reference Convert tool in Visual Studio 2017 +MigrationBackup/ + +# Ionide (cross platform F# VS Code tools) working folder +.ionide/ + +# Fody - auto-generated XML schema +FodyWeavers.xsd + +# VS Code files for those working on multiple tools +.vscode/* +!.vscode/settings.json +!.vscode/tasks.json +!.vscode/launch.json +!.vscode/extensions.json +*.code-workspace + +# Local History for Visual Studio Code +.history/ + +# Windows Installer files from build outputs +*.cab +*.msi +*.msix +*.msm +*.msp + +# JetBrains Rider +.idea/ +*.sln.iml diff --git a/VBExtension.cs b/VBExtension.cs index a90839b..55c1ba0 100644 --- a/VBExtension.cs +++ b/VBExtension.cs @@ -3,6 +3,7 @@ using System; using System.Collections.Generic; using System.Globalization; +using System.Linq; using System.Windows; using System.Windows.Controls; using System.Windows.Controls.Primitives; @@ -691,6 +692,26 @@ public bool IsEnabled public void startTimerSeconds(int Seconds, dynamic setTag) { Tag = setTag; startTimerSeconds(Seconds); } public void stopTimer() { Enabled = false; } } + + + + public static void unloadControls(this Window Frm, string Name, int baseIndex = -1) + { + Panel G = (Panel)Frm.Content; + foreach (var C in Frm.Controls()) + { + string N = ((FrameworkElement)C).Name; + if (N.StartsWith(Name + "_")) + { + if (controlIndex(N) == baseIndex) continue; + G.Children.Remove(C); + } + } + } + + public static int LBound(this List FL) => 0; + public static int UBound(this List FL) => FL.Count - 1; + public static List controlArray(this Window Frm, string name) { List res = new List(); @@ -699,6 +720,9 @@ public static List controlArray(this Window Frm, string name) if (((FrameworkElement)C).Name.StartsWith(name + "_")) res.Add((FrameworkElement)C); return res; } + + public static List controlArray(this Window Frm, string name) => controlArray(Frm, name).Cast().ToList(); + public static int controlIndex(String name) { try { return ValI(Strings.Mid(name, name.LastIndexOf('_') + 1)); } catch (Exception e) { } return -1; } public static int controlIndex(this Control C) { try { return ValI(Strings.Mid(C.Name, C.Name.LastIndexOf('_') + 1)); } catch (Exception e) { } return -1; } public static FrameworkElement getControlByIndex(this Window Frm, string Name, int Idx) diff --git a/frm.frm b/frm.frm index 1097d94..74d84ee 100644 --- a/frm.frm +++ b/frm.frm @@ -1,20 +1,39 @@ VERSION 5.00 Begin VB.Form frm Caption = "VB6 -> .NET" - ClientHeight = 4560 + ClientHeight = 5205 ClientLeft = 120 ClientTop = 465 ClientWidth = 5190 LinkTopic = "Form1" - ScaleHeight = 4560 + ScaleHeight = 5205 ScaleWidth = 5190 StartUpPosition = 3 'Windows Default Begin VB.Frame fra - Height = 4335 + Height = 4935 Left = 120 TabIndex = 0 Top = 120 Width = 4935 + Begin VB.OptionButton optVersion + Caption = "v2" + Height = 255 + Index = 1 + Left = 2648 + TabIndex = 17 + Top = 1080 + Width = 615 + End + Begin VB.OptionButton optVersion + Caption = "v1" + Height = 255 + Index = 0 + Left = 1928 + TabIndex = 16 + Top = 1080 + Value = -1 'True + Width = 615 + End Begin VB.CommandButton cmdSupport Caption = "SUPPORT" Height = 285 @@ -36,14 +55,14 @@ Begin VB.Form frm Height = 495 Left = 240 TabIndex = 6 - Top = 1080 + Top = 1680 Width = 1455 End Begin VB.TextBox txtFile Height = 285 Left = 2040 TabIndex = 5 - Top = 1200 + Top = 1800 Width = 2415 End Begin VB.CommandButton cmdLint @@ -70,7 +89,7 @@ Begin VB.Form frm MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 12 - Top = 1560 + Top = 2160 Width = 2655 End Begin VB.CommandButton cmdClasses @@ -78,7 +97,7 @@ Begin VB.Form frm Height = 495 Left = 240 TabIndex = 8 - Top = 2280 + Top = 2880 Width = 1455 End Begin VB.CommandButton cmdModules @@ -86,7 +105,7 @@ Begin VB.Form frm Height = 495 Left = 240 TabIndex = 9 - Top = 2880 + Top = 3480 Width = 1455 End Begin VB.CommandButton cmdAll @@ -94,7 +113,7 @@ Begin VB.Form frm Height = 495 Left = 240 TabIndex = 10 - Top = 3720 + Top = 4320 Width = 1455 End Begin VB.CommandButton cmdForms @@ -102,7 +121,7 @@ Begin VB.Form frm Height = 495 Left = 240 TabIndex = 7 - Top = 1680 + Top = 2280 Width = 1455 End Begin VB.CommandButton cmdExit @@ -111,7 +130,7 @@ Begin VB.Form frm Height = 495 Left = 3240 TabIndex = 11 - Top = 3720 + Top = 4320 Width = 1455 End Begin VB.TextBox txtSrc @@ -129,14 +148,14 @@ Begin VB.Form frm Height = 255 Left = 2040 TabIndex = 13 - Top = 3360 + Top = 4200 Width = 2415 End Begin VB.Shape shpPrgBack BackColor = &H00FFC0C0& Height = 255 Left = 2040 - Top = 3360 + Top = 3960 Width = 2415 End Begin VB.Shape shpPrg @@ -145,7 +164,7 @@ Begin VB.Form frm BorderStyle = 0 'Transparent Height = 255 Left = 2040 - Top = 3360 + Top = 3960 Visible = 0 'False Width = 1335 End @@ -169,17 +188,26 @@ Option Explicit Public pMax As Long +Public Property Get ConverterVersion() As String + Dim I As Long + For I = optVersion.LBound To optVersion.UBound + If optVersion(I) Then ConverterVersion = optVersion(I).Caption: Exit Function + Next + ConverterVersion = CONVERTER_VERSION_1 +End Property + Private Sub cmdAll_Click() If Not ConfigValid Then Exit Sub IsWorking - ConvertProject txtSrc + ConvertProject txtSrc, ConverterVersion IsWorking True + MsgBox "Complete" End Sub Private Sub cmdClasses_Click() If Not ConfigValid Then Exit Sub IsWorking - ConvertFileList FilePath(txtSrc), VBPClasses(txtSrc) + ConvertFileList FilePath(txtSrc), VBPClasses(txtSrc), vbCrLf, ConverterVersion IsWorking True End Sub @@ -200,7 +228,7 @@ Private Sub cmdFile_Click() End If If Not ConfigValid Then Exit Sub IsWorking - Success = ConvertFile(txtFile) + Success = ConvertFile(txtFile, False, ConverterVersion) IsWorking True If Success Then MsgBox "Converted " & txtFile & "." End Sub @@ -208,14 +236,14 @@ End Sub Private Sub cmdForms_Click() If Not ConfigValid Then Exit Sub IsWorking - ConvertFileList FilePath(txtSrc), VBPForms(txtSrc) + ConvertFileList FilePath(txtSrc), VBPForms(txtSrc), vbCrLf, ConverterVersion IsWorking True End Sub Private Sub cmdModules_Click() If Not ConfigValid Then Exit Sub IsWorking - ConvertFileList FilePath(txtSrc), VBPModules(txtSrc) + ConvertFileList FilePath(txtSrc), VBPModules(txtSrc), vbCrLf, ConverterVersion IsWorking True End Sub @@ -286,3 +314,4 @@ Private Sub Form_Load() modConfig.Hush = False txtSrc = vbpFile End Sub + diff --git a/modConfig.bas b/modConfig.bas index 7fde2a0..4096f8a 100644 --- a/modConfig.bas +++ b/modConfig.bas @@ -21,9 +21,20 @@ Public Const INIKey_VBPFile As String = "VBPFile" Public Const INIKey_OutputFolder As String = "OutputFolder" Public Const INIKey_AssemblyName As String = "AssemblyName" -Public Function INIFile() As String + +Public Property Get vbpFile() As String + LoadSettings + If mVBPFile = "" Then mVBPFile = def_vbpFile + vbpFile = mVBPFile +End Property + +Public Property Get vbpPath() As String + vbpPath = FilePath(vbpFile) +End Property + +Public Property Get INIFile() As String INIFile = App.Path & "\VB6toCS.INI" -End Function +End Property Public Sub LoadSettings(Optional ByVal Force As Boolean = False) If Loaded And Not Force Then Exit Sub @@ -63,15 +74,3 @@ Public Function OutputSubFolder(ByVal F As String) As String Case Else: OutputSubFolder = "" End Select End Function - -Public Property Get vbpFile() As String - LoadSettings - If mVBPFile = "" Then mVBPFile = def_vbpFile - vbpFile = mVBPFile -End Property - -Public Property Get vbpPath() As String - vbpPath = FilePath(vbpFile) -End Property - - diff --git a/modControlProperties.bas b/modControlProperties.bas index 620fd4f..9516688 100644 --- a/modControlProperties.bas +++ b/modControlProperties.bas @@ -23,6 +23,9 @@ Public Function ConvertControlProperty(ByVal Src As String, ByVal vProp As Strin If cType = "VB.ListBox" Then ConvertControlProperty = "Items.Count" Case "Default": ConvertControlProperty = "IsDefault" Case "Cancel": ConvertControlProperty = "IsCancel" + + Case "LBound": ConvertControlProperty = "LBound()" + Case "UBound": ConvertControlProperty = "UBound()" Case "" Select Case cType @@ -31,10 +34,10 @@ Public Function ConvertControlProperty(ByVal Src As String, ByVal vProp As Strin Case "VB.ComboBox": ConvertControlProperty = "Text" Case "VB.PictureBox": ConvertControlProperty = "Source" Case "VB.Image": ConvertControlProperty = "Source" - Case "VB.ComboBox": ConvertControlProperty = "Text" Case "VB.OptionButton": ConvertControlProperty = "IsChecked" Case "VB.CheckBox": ConvertControlProperty = "IsChecked" Case "VB.Frame": ConvertControlProperty = "Content" + Case "VB.Label": ConvertControlProperty = "Content" Case Else: ConvertControlProperty = "DefaultProperty" End Select End Select diff --git a/modConvert.bas b/modConvert.bas index 1608316..2bcbc27 100644 --- a/modConvert.bas +++ b/modConvert.bas @@ -11,16 +11,29 @@ Dim CurrentModule As String Dim CurrSub As String -Public Sub ConvertProject(ByVal vbpFile As String) +Public Const CONVERTER_VERSION_1 As String = "v1" +Public Const CONVERTER_VERSION_2 As String = "v2" +Public Const CONVERTER_VERSION_DEFAULT As String = CONVERTER_VERSION_2 + +Public Function QuickConvertProject() As Boolean + QuickConvertProject = ConvertProject(vbpFile, CONVERTER_VERSION_2) +End Function + +Public Function QuickConvert() As Boolean + QuickConvert = ConvertFile("modQuickConvert.bas", False, CONVERTER_VERSION_2) +End Function + +Public Function ConvertProject(Optional ByVal vbpFile As String = "", Optional ByVal ConverterVersion As String = CONVERTER_VERSION_DEFAULT) As Boolean + If vbpFile = "" Then vbpFile = modConfig.vbpFile Prg 0, 1, "Preparing..." ScanRefs CreateProjectFile vbpFile CreateProjectSupportFiles - ConvertFileList FilePath(vbpFile), VBPModules(vbpFile) & vbCrLf & VBPClasses(vbpFile) & vbCrLf & VBPForms(vbpFile) '& vbCrLf & VBPUserControls(vbpFile) - MsgBox "Complete." -End Sub + ConvertFileList FilePath(vbpFile), VBPModules(vbpFile) & vbCrLf & VBPClasses(vbpFile) & vbCrLf & VBPForms(vbpFile), vbCrLf, ConverterVersion + ConvertProject = True +End Function -Public Function ConvertFileList(ByVal Path As String, ByVal List As String, Optional ByVal Sep As String = vbCrLf) As Boolean +Public Function ConvertFileList(ByVal Path As String, ByVal List As String, Optional ByVal Sep As String = vbCrLf, Optional ByVal ConverterVersion As String = CONVERTER_VERSION_DEFAULT) As Boolean Dim L As Variant, V As Long, N As Long V = StrCnt(List, Sep) + 1 Prg 0, V, N & "/" & V & "..." @@ -30,7 +43,7 @@ Public Function ConvertFileList(ByVal Path As String, ByVal List As String, Opti If L = "modFunctionList.bas" Then GoTo NextItem - ConvertFile Path & L + ConvertFile Path & L, False, ConverterVersion NextItem: Prg N, , N & "/" & V & ": " & L @@ -39,21 +52,21 @@ NextItem: Prg End Function -Public Function ConvertFile(ByVal someFile As String, Optional ByVal UIOnly As Boolean = False) As Boolean - If Not IsInStr(someFile, "\") Then someFile = vbpPath & someFile +Public Function ConvertFile(ByVal SomeFile As String, Optional ByVal UIOnly As Boolean = False, Optional ByVal ConverterVersion As String = CONVERTER_VERSION_DEFAULT) As Boolean + If Not IsInStr(SomeFile, "\") Then SomeFile = vbpPath & SomeFile CurrentModule = "" - Select Case LCase(FileExt(someFile)) - Case ".bas": ConvertFile = ConvertModule(someFile) - Case ".cls": ConvertFile = ConvertClass(someFile) - Case ".frm": FormName = FileBaseName(someFile): ConvertFile = ConvertForm(someFile, UIOnly) + Select Case LCase(FileExt(SomeFile)) + Case ".bas": ConvertFile = ConvertModule(SomeFile, ConverterVersion) + Case ".cls": ConvertFile = ConvertClass(SomeFile, ConverterVersion) + Case ".frm": FormName = FileBaseName(SomeFile): ConvertFile = ConvertForm(SomeFile, UIOnly, ConverterVersion) ' Case ".ctl": ConvertModule someFile - Case Else: MsgBox "UNKNOWN VB TYPE: " & someFile: Exit Function + Case Else: MsgBox "UNKNOWN VB TYPE: " & SomeFile: Exit Function End Select FormName = "" ConvertFile = True End Function -Public Function ConvertForm(ByVal frmFile As String, Optional ByVal UIOnly As Boolean = False) As Boolean +Public Function ConvertForm(ByVal frmFile As String, Optional ByVal UIOnly As Boolean = False, Optional ByVal ConverterVersion As String = CONVERTER_VERSION_DEFAULT) As Boolean Dim S As String, J As Long, Preamble As String, Code As String, Globals As String, Functions As String Dim X As String, fName As String Dim F As String @@ -77,10 +90,29 @@ Public Function ConvertForm(ByVal frmFile As String, Optional ByVal UIOnly As Bo WriteOut F, X, frmFile If UIOnly Then Exit Function - J = CodeSectionGlobalEndLoc(Code) - Globals = ConvertGlobals(Left(Code, J)) - InitLocalFuncs FormControls(fName, Preamble) & ScanRefsFileToString(frmFile) - Functions = ConvertCodeSegment(Mid(Code, J)) + + Dim ConvertedCode As String + If ConverterVersion = CONVERTER_VERSION_2 Then + ConvertedCode = "" + Dim ControlArrays As String, VV As Variant + ControlArrays = Replace(Replace(Replace(modConvertForm.FormControlArrays, "][", ";"), "[", ""), "]", "") + For Each VV In Split(ControlArrays, ";") + Dim ControlArrayParts() As String + ControlArrayParts = Split(VV, ",") + ConvertedCode = ConvertedCode & "public List<" & ControlArrayParts(1) & "> " & ControlArrayParts(0) & " { get => VBExtension.controlArray<" & ControlArrayParts(1) & ">(this, """ & ControlArrayParts(0) & """); }" & vbCrLf2 + +' ConvertedCode = ConvertedCode & "public ControlArrayList<" & ControlArrayParts(1) & "> " & ControlArrayParts(0) & "() => VBExtension.controlArray(this, """ & ControlArrayParts(1) & """).Cast<" & ControlArrayParts(1) & ">().ToList();" & vbCrLf +' ConvertedCode = ConvertedCode & "public " & ControlArrayParts(1) & " " & ControlArrayParts(0) & "(int i) => " & ControlArrayParts(0) & "()[i];" & vbCrLf2 + Next + + ConvertedCode = ConvertedCode & QuickConvertFile(frmFile) + Else + J = CodeSectionGlobalEndLoc(Code) + Globals = ConvertGlobals(Left(Code, J)) + InitLocalFuncs FormControls(fName, Preamble) & ScanRefsFileToString(frmFile) + Functions = ConvertCodeSegment(Mid(Code, J)) + ConvertedCode = Globals & vbCrLf2 & Functions + End If X = "" X = X & UsingEverything(fName) & vbCrLf @@ -95,7 +127,7 @@ Public Function ConvertForm(ByVal frmFile As String, Optional ByVal UIOnly As Bo X = X & " public " & fName & "() { InitializeComponent(); }" & vbCrLf X = X & vbCrLf X = X & vbCrLf - X = X & Globals & vbCrLf & vbCrLf & Functions + X = X & ConvertedCode X = X & vbCrLf & "}" X = X & vbCrLf & "}" @@ -105,7 +137,7 @@ Public Function ConvertForm(ByVal frmFile As String, Optional ByVal UIOnly As Bo WriteOut F, X, frmFile End Function -Public Function ConvertModule(ByVal basFile As String) As Boolean +Public Function ConvertModule(ByVal basFile As String, Optional ByVal ConverterVersion As String = CONVERTER_VERSION_DEFAULT) As Boolean Dim S As String, J As Long, Code As String, Globals As String, Functions As String Dim F As String, X As String, fName As String If Not FileExists(basFile) Then @@ -121,23 +153,29 @@ Public Function ConvertModule(ByVal basFile As String) As Boolean fName = ModuleName(S) Code = Mid(S, CodeSectionLoc(S)) - J = CodeSectionGlobalEndLoc(Code) - Globals = ConvertGlobals(Left(Code, J - 1), True) - Functions = ConvertCodeSegment(Mid(Code, J), True) + Dim UserCode As String + If ConverterVersion = CONVERTER_VERSION_2 Then + UserCode = QuickConvertFile(basFile) + Else + J = CodeSectionGlobalEndLoc(Code) + Globals = ConvertGlobals(Left(Code, J - 1), True) + Functions = ConvertCodeSegment(Mid(Code, J), True) + + UserCode = nlTrim(Globals & vbCrLf & vbCrLf & Functions) + UserCode = deWS(UserCode) + End If X = "" X = X & UsingEverything(fName) & vbCrLf X = X & vbCrLf X = X & "static class " & fName & " {" & vbCrLf - X = X & nlTrim(Globals & vbCrLf & vbCrLf & Functions) + X = X & UserCode X = X & vbCrLf & "}" - X = deWS(X) - WriteOut F, X, basFile End Function -Public Function ConvertClass(ByVal clsFile As String) As Boolean +Public Function ConvertClass(ByVal clsFile As String, Optional ByVal ConverterVersion As String = CONVERTER_VERSION_DEFAULT) As Boolean Dim S As String, J As Long, Code As String, Globals As String, Functions As String Dim F As String, X As String, fName As String Dim cName As String @@ -151,1290 +189,27 @@ Public Function ConvertClass(ByVal clsFile As String) As Boolean F = fName & ".cs" If IsConverted(F, clsFile) Then Debug.Print "Class Already Converted: " & F: Exit Function - Code = Mid(S, CodeSectionLoc(S)) - J = CodeSectionGlobalEndLoc(Code) - Globals = ConvertGlobals(Left(Code, J - 1)) - Functions = ConvertCodeSegment(Mid(Code, J)) + Dim UserCode As String + If ConverterVersion = CONVERTER_VERSION_2 Then + UserCode = QuickConvertFile(clsFile) + Else + Code = Mid(S, CodeSectionLoc(S)) + + J = CodeSectionGlobalEndLoc(Code) + Globals = ConvertGlobals(Left(Code, J - 1)) + Functions = ConvertCodeSegment(Mid(Code, J)) + + UserCode = deWS(Globals & vbCrLf & vbCrLf & Functions) + End If X = "" X = X & UsingEverything(fName) & vbCrLf X = X & vbCrLf X = X & "public class " & fName & " {" & vbCrLf - X = X & Globals & vbCrLf & vbCrLf & Functions + X = X & UserCode X = X & vbCrLf & "}" - X = deWS(X) - F = fName & ".cs" WriteOut F, X, clsFile End Function - -Public Function GetMultiLineSpace(ByVal Prv As String, ByVal Nxt As String) As String - Dim pC As String, nC As String - GetMultiLineSpace = " " - pC = Right(Prv, 1) - nC = Left(Nxt, 1) - If nC = "(" Then GetMultiLineSpace = "" -End Function - -Public Function SanitizeCode(ByVal Str As String) As String - Const NamedParamSrc As String = ":=" - Const NamedParamTok As String = "###NAMED-PARAMETER###" - Dim Sp() As String, L As Variant - Dim F As String - Dim R As String, N As String - Dim Building As String - Dim FinishSplitIf As Boolean - - R = "": N = vbCrLf - Sp = Split(Str, vbCrLf) - Building = "" - - - For Each L In Sp -'If IsInStr(L, "POEDIFolder") Then Stop -'If IsInStr(L, "Set objSourceArNo = New_CDbTypeAhead") Then Stop - If Right(L, 1) = "_" Then - Dim C As String - C = Trim(Left(L, Len(L) - 1)) - Building = Building & GetMultiLineSpace(Building, C) & C - GoTo NextLine - End If - If Building <> "" Then - L = Building & GetMultiLineSpace(Building, Trim(L)) & Trim(L) - Building = "" - End If - -' If IsInStr(L, "'") Then Stop - L = DeComment(L) - L = DeString(L) -'If IsInStr(L, "CustRec <> 0") Then Stop - - FinishSplitIf = False - If tLeft(L, 3) = "If " And Right(RTrim(L), 5) <> " Then" Then - FinishSplitIf = True - F = nextBy(L, " Then ") & " Then" - R = R & N & F - L = Mid(L, Len(F) + 2) - If nextBy(L, " Else ", 2) <> "" Then - R = R & SanitizeCode(nextBy(L, " Else ", 1)) - R = R & N & "Else" - L = nextBy(L, "Else ", 2) - End If - End If - - If nextBy(L, ":") <> L Then - If RegExTest(Trim(L), "^[a-zA-Z_][a-zA-Z_0-9]*:$") Then ' Goto Label - R = R & N & ReComment(L) - Else - Do - L = Replace(L, NamedParamSrc, NamedParamTok) - F = nextBy(L, ":") - F = Replace(F, NamedParamTok, NamedParamSrc) - R = R & N & ReComment(F, True) - L = Replace(L, NamedParamTok, NamedParamSrc) - If F = L Then Exit Do - L = Trim(Mid(L, Len(F) + 2)) - R = R & SanitizeCode(L) - - Loop While False - End If - Else - R = R & N & ReComment(L, True) - End If - - If FinishSplitIf Then R = R & N & "End If" -NextLine: - Next - - SanitizeCode = R -End Function - -Public Function ConvertCodeSegment(ByVal S As String, Optional ByVal asModule As Boolean = False) As String - Dim P As String, N As Long - Dim F As String, T As Long, E As Long, K As String, X As Long - Dim Pre As String, Body As String - Dim R As String - - ClearProperties - - InitDeString -'WriteFile "C:\Users\benja\Desktop\code.txt", S, True - S = SanitizeCode(S) -'WriteFile "C:\Users\benja\Desktop\sani.txt", S, True - Do - P = "(Public |Private |)(Friend |)(Function |Sub |Property Get |Property Let |Property Set )" & patToken & "[ ]*\(" - N = -1 - Do - N = N + 1 - F = RegExNMatch(S, P, N) - T = RegExNPos(S, P, N) - Loop While Not IsInCode(S, T) And F <> "" - If F = "" Then Exit Do - - If IsInStr(F, " Function ") Then - K = "End Function" - ElseIf IsInStr(F, " Sub ") Then - K = "End Sub" - ElseIf IsInStr(F, " Property ") Then - K = "End Property" - End If - N = -1 - Do - N = N + 1 - E = RegExNPos(Mid(S, T), K, N) + Len(K) + T - Loop While Not IsInCode(S, E) And E <> 0 - - If T > 1 Then Pre = nlTrim(Left(S, T - 1)) Else Pre = "" - Do Until Mid(S, E, 1) = vbCr Or Mid(S, E, 1) = vbLf Or Mid(S, E, 1) = "" - E = E + 1 - Loop - Body = nlTrim(Mid(S, T, E - T)) - - S = nlTrim(Mid(S, E + 1)) - - R = R & CommentBlock(Pre) & ConvertSub(Body, asModule) & vbCrLf - Loop While True - - R = ReadOutProperties(asModule) & vbCrLf2 & R - - R = ReString(R, True) - - ConvertCodeSegment = R -End Function - -Public Function CommentBlock(ByVal Str As String) As String - Dim S As String - If nlTrim(Str) = "" Then Exit Function - S = "" - S = S & "/*" & vbCrLf - S = S & Replace(Str, "*/", "* /") & vbCrLf - S = S & "*/" & vbCrLf - CommentBlock = S -End Function - -Public Function ConvertDeclare(ByVal S As String, ByVal Ind As Long, Optional ByVal isGlobal As Boolean = False, Optional ByVal asModule As Boolean = False) As String - Dim Sp() As String, L As Variant, SS As String - Dim asPrivate As Boolean - Dim pName As String, pType As String, pWithEvents As Boolean - Dim Res As String - Dim ArraySpec As String, isArr As Boolean, aMax As Long, aMin As Long, aTodo As String - Res = "" - - SS = S - - If tLeft(S, 7) = "Public " Then S = tMid(S, 8) - If tLeft(S, 4) = "Dim " Then S = Mid(Trim(S), 5): asPrivate = True - If tLeft(S, 8) = "Private " Then S = tMid(S, 9): asPrivate = True - -' If IsInStr(S, "aMin") Then Stop - Sp = Split(S, ",") - For Each L In Sp - L = Trim(L) - If LMatch(L, "WithEvents ") Then L = Trim(tMid(L, 12)): Res = Res & "// TODO: WithEvents not supported on " & RegExNMatch(L, patToken) & vbCrLf - pName = RegExNMatch(L, patToken) - L = Trim(tMid(L, Len(pName) + 1)) - If isGlobal Then Res = Res & IIf(asPrivate, "private ", "public ") - If asModule Then Res = Res & "static " - If tLeft(L, 1) = "(" Then - isArr = True - ArraySpec = nextBy(Mid(L, 2), ")") - If ArraySpec = "" Then - aMin = -1 - aMax = -1 - L = Trim(tMid(L, 3)) - Else - L = Trim(tMid(L, Len(ArraySpec) + 3)) - aMin = 0 - aMax = Val(SplitWord(ArraySpec)) - ArraySpec = Trim(tMid(ArraySpec, Len(aMax) + 1)) - If tLeft(ArraySpec, 3) = "To " Then - aMin = aMax - aMax = Val(tMid(ArraySpec, 4)) - End If - End If - End If - - Dim AsNew As Boolean - AsNew = False - If SplitWord(L, 1) = "As" Then - pType = SplitWord(L, 2) - If pType = "New" Then - pType = SplitWord(L, 3) - AsNew = True - End If - Else - pType = "Variant" - End If - - If Not isArr Then - Res = Res & sSpace(Ind) & ConvertDataType(pType) & " " & pName - Res = Res & " = " - If AsNew Then - Res = Res & "new " - Res = Res & ConvertDataType(pType) - Res = Res & "()" - Else - Res = Res & ConvertDefaultDefault(pType) - End If - Res = Res & ";" & vbCrLf - Else - aTodo = IIf(aMin = 0, "", " // TODO - Specified Minimum Array Boundary Not Supported: " & SS) - If Not IsNumeric(aMax) Then - Res = Res & sSpace(Ind) & "List<" & ConvertDataType(pType) & "> " & pName & " = new List<" & ConvertDataType(pType) & "> (new " & ConvertDataType(pType) & "[(" & aMax & " + 1)]); // TODO: Confirm Array Size By Token" & aTodo & vbCrLf - ElseIf Val(aMax) = -1 Then - Res = Res & sSpace(Ind) & "List<" & ConvertDataType(pType) & "> " & pName & " = new List<" & ConvertDataType(pType) & "> {};" & aTodo & vbCrLf - Else - Res = Res & sSpace(Ind) & "List<" & ConvertDataType(pType) & "> " & pName & " = new List<" & ConvertDataType(pType) & "> (new " & ConvertDataType(pType) & "[" & (Val(aMax) + 1) & "]);" & aTodo & vbCrLf - End If - End If - - SubParamDecl pName, pType, IIf(isArr, "" & aMax, ""), False, False - Next - - ConvertDeclare = Res -End Function - -Public Function ConvertAPIDef(ByVal S As String) As String -'Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long -'[DllImport("User32.dll")] -'public static extern int MessageBox(int h, string m, string c, int type); - Dim isPrivate As Boolean, isSub As Boolean - Dim AName As String - Dim aLib As String - Dim aAlias As String - Dim aArgs As String - Dim aReturn As String - Dim tArg As String, Has As Boolean - If tLeft(S, 8) = "Private " Then S = tMid(S, 9): isPrivate = True - If tLeft(S, 7) = "Public " Then S = tMid(S, 8) - If tLeft(S, 8) = "Declare " Then S = tMid(S, 9) - If tLeft(S, 4) = "Sub " Then S = tMid(S, 5): isSub = True - If tLeft(S, 9) = "Function " Then S = tMid(S, 10) - AName = RegExNMatch(S, patToken) - S = Trim(tMid(S, Len(AName) + 1)) - If tLeft(S, 4) = "Lib " Then - S = Trim(tMid(S, 5)) - aLib = SplitWord(S, 1) - S = Trim(tMid(S, Len(aLib) + 1)) - aLib = ReString(aLib) - If Left(aLib, 1) = """" Then aLib = Mid(aLib, 2) - If Right(aLib, 1) = """" Then aLib = Left(aLib, Len(aLib) - 1) - If LCase(Right(aLib, 4)) <> ".dll" Then aLib = aLib & ".dll" - aLib = LCase(aLib) - End If - If tLeft(S, 6) = "Alias " Then - S = Trim(tMid(S, 7)) - aAlias = SplitWord(S, 1) - S = Trim(tMid(S, Len(aAlias) + 1)) - aAlias = ReString(aAlias) - If Left(aAlias, 1) = """" Then aAlias = Mid(aAlias, 2) - If Right(aAlias, 1) = """" Then aAlias = Left(aAlias, Len(aAlias) - 1) - End If - If tLeft(S, 1) = "(" Then S = tMid(S, 2) - aArgs = nextBy(S, ")") - S = Trim(tMid(S, Len(aArgs) + 2)) - If tLeft(S, 3) = "As " Then - S = Trim(tMid(S, 4)) - aReturn = SplitWord(S, 1) - S = Trim(tMid(S, Len(aReturn) + 1)) - Else - aReturn = "Variant" - End If - - S = "" - S = S & "[DllImport(""" & aLib & """" & IIf(aAlias = "", "", ", EntryPoint = """ & aAlias & """") & ")] " - S = S & IIf(isPrivate, "private ", "public ") - S = S & "static extern " - S = S & IIf(isSub, "void ", ConvertDataType(aReturn)) & " " - S = S & AName - S = S & "(" - Do - If aArgs = "" Then Exit Do - tArg = Trim(nextBy(aArgs, ",")) - aArgs = tMid(aArgs, Len(tArg) + 2) - S = S & IIf(Has, ", ", "") & ConvertParameter(tArg, True) - Has = True - Loop While True - S = S & ");" - - - ConvertAPIDef = S -End Function - -Public Function ConvertConstant(ByVal S As String, Optional ByVal isGlobal As Boolean = True) As String - Dim cName As String, cType As String, cValue As String, isPrivate As Boolean, dataType As String - If tLeft(S, 7) = "Public " Then S = Mid(Trim(S), 8) - If tLeft(S, 7) = "Global " Then S = Mid(Trim(S), 8) - If tLeft(S, 8) = "Private " Then S = Mid(Trim(S), 9): isPrivate = True - If tLeft(S, 6) = "Const " Then S = Mid(Trim(S), 7) - cName = SplitWord(S, 1) - S = Trim(Mid(Trim(S), Len(cName) + 1)) - If tLeft(S, 3) = "As " Then - S = Trim(Mid(Trim(S), 3)) - cType = SplitWord(S, 1) - S = Trim(tMid(S, Len(cType) + 1)) - Else - cType = "Variant" - End If - - If Left(S, 1) = "=" Then - S = Trim(Mid(S, 2)) - cValue = ConvertValue(S) - Else - cValue = ConvertDefaultDefault(cType) - End If - - dataType = ConvertDataType(cType) - If dataType = "dynamic" Then ' c# can't handle constants of type 'dynamic' when type can be inferred. - If LMatch(cValue, DeStringToken_Base) Then - dataType = "string" - ElseIf IsNumeric(cValue) Then - If IsInStr(cValue, ".") Then dataType = "decimal" Else dataType = "int" - End If - End If - - If cType = "Date" Then - ConvertConstant = IIf(isGlobal, IIf(isPrivate, "private ", "public "), "") & "static readonly " & dataType & " " & cName & " = " & cValue & ";" - Else - ConvertConstant = IIf(isGlobal, IIf(isPrivate, "private ", "public "), "") & "const " & dataType & " " & cName & " = " & cValue & ";" - End If -End Function - - -Public Function ConvertEvent(ByVal S As String) As String - Dim cName As String, cArgs As String, tArgs As String, isPrivate As Boolean - Dim R As String, N As Long, M As String, O As String - Dim I As Long, J As Long - Dim A As String - If tLeft(S, 7) = "Public " Then S = Mid(Trim(S), 8) - If tLeft(S, 8) = "Private " Then S = Mid(Trim(S), 9): isPrivate = True - If tLeft(S, 6) = "Event " Then S = Mid(Trim(S), 7) - cName = RegExNMatch(S, patToken) - cArgs = Trim(Mid(Trim(S), Len(cName) + 1)) - If Left(cArgs, 1) = "(" Then cArgs = Mid(cArgs, 2) - If Right(cArgs, 1) = ")" Then cArgs = Left(cArgs, Len(cArgs) - 1) - - N = 0 - Do - N = N + 1 - A = nextBy(cArgs, ",", N) - If A = "" Then Exit Do - tArgs = tArgs & IIf(N = 1, "", ", ") - tArgs = tArgs & ConvertParameter(A, True) - Loop While True - - O = vbCrLf - M = "" - R = "" - R = R & M & "public delegate void " & cName & "Handler(" & tArgs & ");" - R = R & O & "public event " & cName & "Handler event" & cName & ";" - - ConvertEvent = R -End Function - - -Public Function ConvertEnum(ByVal S As String) As String - Dim isPrivate As Boolean, EName As String - Dim Res As String, Has As Boolean - If tLeft(S, 7) = "Public " Then S = tMid(S, 8) - If tLeft(S, 8) = "Private " Then S = tMid(S, 9): isPrivate = True - If tLeft(S, 5) = "Enum " Then S = tMid(S, 6) - EName = RegExNMatch(S, patToken, 0) - S = nlTrim(tMid(S, Len(EName) + 1)) - - Res = "public enum " & EName & " {" - - Do While tLeft(S, 8) <> "End Enum" And S <> "" - EName = RegExNMatch(S, patToken, 0) - Res = Res & IIf(Has, ",", "") & vbCrLf & sSpace(SpIndent) & EName - Has = True - - S = nlTrim(tMid(S, Len(EName) + 1)) - If tLeft(S, 1) = "=" Then - S = nlTrim(Mid(S, 3)) - If Left(S, 1) = "&" Then - EName = ConvertElement(RegExNMatch(S, "&H[0-9A-F]+")) - Else - EName = RegExNMatch(S, "[0-9]*", 0) - End If - Res = Res & " = " & EName - S = nlTrim(tMid(S, Len(EName) + 1)) - End If - Loop - Res = Res & vbCrLf & "}" - - ConvertEnum = Res -End Function - -Public Function ConvertType(ByVal S As String) As String - Dim isPrivate As Boolean, EName As String, eArr As String, eType As String - Dim Res As String - Dim N As String - If tLeft(S, 7) = "Public " Then S = tMid(S, 8) - If tLeft(S, 8) = "Private " Then S = tMid(S, 9): isPrivate = True - If tLeft(S, 5) = "Type " Then S = tMid(S, 6) - EName = RegExNMatch(S, patToken, 0) - S = nlTrim(tMid(S, Len(EName) + 1)) -'If IsInStr(eName, "OSVERSIONINFO") Then Stop - - Res = IIf(isPrivate, "private ", "public ") & "class " & EName & " {" - - Do While tLeft(S, 8) <> "End Type" And S <> "" - EName = RegExNMatch(S, patToken, 0) - S = nlTrim(tMid(S, Len(EName) + 1)) - eArr = "" - If LMatch(S, "(") Then - N = nextBy(Mid(S, 2), ")") - S = nlTrim(Mid(S, Len(N) + 3)) - N = ConvertValue(N) - eArr = "[" & N & "]" - End If - - If tLeft(S, 3) = "As " Then - S = nlTrim(Mid(S, 4)) - eType = RegExNMatch(S, patToken, 0) - S = nlTrim(tMid(S, Len(eType) + 1)) - Else - eType = "Variant" - End If - Res = Res & vbCrLf & " public " & ConvertDataType(eType) & IIf(eArr = "", "", "[]") & " " & EName - If eArr = "" Then - Res = Res & " = " & ConvertDefaultDefault(eType) - Else - Res = Res & " = new " & ConvertDataType(eType) & eArr - End If - Res = Res & ";" - If tLMatch(S, "* ") Then - S = Mid(LTrim(S), 3) - N = RegExNMatch(S, "[0-9]+", 0) - S = nlTrim(Mid(LTrim(S), Len(N) + 1)) - Res = Res & " //TODO: Fixed Length Strings Not Supported: * " & N - End If - - Loop - Res = Res & vbCrLf & "}" - - ConvertType = Res -End Function - -Public Function ConvertParameter(ByVal S As String, Optional ByVal NeverUnused As Boolean = False) As String - Dim IsOptional As Boolean - Dim IsByRef As Boolean, asOut As Boolean - Dim Res As String - Dim pName As String, pType As String, pDef As String - Dim TName As String - - S = Trim(S) - If tLeft(S, 9) = "Optional " Then IsOptional = True: S = Mid(S, 10) - IsByRef = True - If tLeft(S, 6) = "ByVal " Then IsByRef = False: S = Mid(S, 7) - If tLeft(S, 6) = "ByRef " Then IsByRef = True: S = Mid(S, 7) - pName = SplitWord(S, 1) - If IsByRef And SubParam(pName).AssignedBeforeUsed Then asOut = True - S = Trim(Mid(S, Len(pName) + 1)) - If tLeft(S, 2) = "As" Then - S = tMid(S, 4) - pType = SplitWord(S, 1, "=") - S = Trim(Mid(S, Len(pType) + 1)) - Else - pType = "Variant" - End If - If Left(S, 1) = "=" Then - pDef = ConvertValue(Trim(Mid(Trim(S), 2))) - S = "" - Else - pDef = ConvertDefaultDefault(pType) - End If - - Res = "" - If IsByRef Then Res = Res & IIf(asOut, "out ", "ref ") - Res = Res & ConvertDataType(pType) & " " - If IsInStr(pName, "()") Then Res = Res & "[] ": pName = Replace(pName, "()", "") - TName = pName - If Not NeverUnused Then - If Not SubParam(pName).Used And Not (SubParam(pName).Param And SubParam(pName).Assigned) Then - TName = TName & "_UNUSED" - End If - End If - Res = Res & TName - If IsOptional And Not IsByRef Then - Res = Res & "= " & pDef - End If - - SubParamDecl pName, pType, False, True, False - ConvertParameter = Trim(Res) -End Function - -Public Function ConvertPrototype(ByVal SS As String, Optional ByRef returnVariable As String = "", Optional ByVal asModule As Boolean = False, Optional ByRef asName As String = "") As String - Const retToken As String = "#RET#" - Dim Res As String - Dim fName As String, fArgs As String, retType As String, T As String - Dim tArg As String - Dim isSub As Boolean - Dim hArgs As Boolean - Dim S As String - - S = SS - - Res = "" - returnVariable = "" - isSub = False - If LMatch(S, "Public ") Then Res = Res & "public ": S = Mid(S, 8) - If LMatch(S, "Private ") Then Res = Res & "private ": S = Mid(S, 9) - If LMatch(S, "Friend ") Then S = Mid(S, 8) - If asModule Then Res = Res & "static " - If LMatch(S, "Sub ") Then Res = Res & "void ": S = Mid(S, 5): isSub = True - If LMatch(S, "Function ") Then Res = Res & retToken & " ": S = Mid(S, 10) - - fName = Trim(SplitWord(Trim(S), 1, "(")) - asName = fName - - S = Trim(tMid(S, Len(fName) + 2)) - If Left(S, 1) = "(" Then S = Trim(tMid(S, 2)) - fArgs = Trim(nextBy(S, ")")) - S = Mid(S, Len(fArgs) + 2) - Do While Right(fArgs, 1) = "(" - fArgs = fArgs & ") " - Dim tMore As String - tMore = Trim(nextBy(S, ")")) - fArgs = fArgs & tMore - S = Mid(S, Len(tMore) + 2) - Loop - If Left(S, 1) = ")" Then S = Trim(tMid(S, 2)) - - If Not isSub Then - If tLeft(S, 2) = "As" Then - retType = Trim(Mid(Trim(S), 3)) - Else - retType = "Variant" - End If - If Right(retType, 1) = ")" And Right(retType, 2) <> "()" Then retType = Left(retType, Len(retType) - 1) - Res = Replace(Res, retToken, ConvertDataType(retType)) - End If - - Res = Res & fName - Res = Res & "(" - hArgs = False - Do - If Trim(fArgs) = "" Then Exit Do - tArg = nextBy(fArgs, ",") - fArgs = LTrim(Mid(fArgs, Len(tArg) + 2)) - - Res = Res & IIf(hArgs, ", ", "") - If LMatch(tArg, "ParamArray") Then Res = Res & "params ": tArg = "ByVal " & Trim(Mid(tArg, 12)) - Res = Res & ConvertParameter(tArg) - hArgs = True - Loop Until Len(fArgs) = 0 - - Res = Res & ") {" - If retType <> "" Then - returnVariable = fName - Res = Res & vbCrLf & sSpace(SpIndent) & ConvertDataType(retType) & " " & returnVariable & " = " & ConvertDefaultDefault(retType) & ";" - SubParamDecl returnVariable, retType, False, False, True - End If - - If IsEvent(asName) Then Res = EventStub(asName) & Res - ConvertPrototype = Trim(Res) -End Function - -Public Function ConvertCondition(ByVal S As String) As String - ConvertCondition = "(" & S & ")" -End Function - -Public Function ConvertElement(ByVal S As String) As String -'Debug.Print "ConvertElement: " & S -'If IsInStr(S, "frmSetup") Then Stop -'If IsInStr(S, "chkShowBalance.Value") Then Stop -'If IsInStr(S, "optTelephone") Then Stop - Dim FirstToken As String, FirstWord As String - Dim T As String, Complete As Boolean - S = Trim(S) - If S = "" Then Exit Function - -'If IsInStr(S, "Debug.Print") Then Stop - If Left(Trim(S), 2) = "&H" Then - ConvertElement = "0x" & Mid(Trim(S), 3) - Exit Function - End If - - If IsNumeric(Trim(S)) Then - ConvertElement = Val(S) - If IsInStr(S, ".") Then ConvertElement = ConvertElement & "m" - Exit Function - End If - - Dim vMax As Long - Do While RegExTest(S, "#[0-9]+/[0-9]+/[0-9]+#") - Dim dStr As String - dStr = RegExNMatch(S, "#[0-9]+/[0-9]+/[0-9]+#", 0) - S = Replace(S, dStr, "DateValue(""" & Mid(dStr, 2, Len(dStr) - 2) & """)") - vMax = vMax + 1 - If vMax > 10 Then Exit Do - Loop - -'If IsInStr(S, "RS!") Then Stop -'If IsInStr(S, ".SetValueDisplay Row") Then Stop -'If IsInStr(S, "cmdSaleTotals.Move") Then Stop -'If IsInStr(S, "2830") Then Stop -'If IsInStr(S, "True") Then Stop -'If IsInStr(S, ":=") Then Stop -'If IsInStr(S, "GetRecordNotFound") Then Stop -'If IsInStr(S, "Nonretro_14day") Then Stop -'If IsInStr(S, "Git") Then Stop -'If IsInStr(S, "GitFolder") Then Stop -'If IsInStr(S, "Array") Then Stop - - S = RegExReplace(S, patNotToken & patToken & "!" & patToken & patNotToken, "$1$2(""$3"")$4") ' RS!Field -> RS("Field") - S = RegExReplace(S, "^" & patToken & "!" & patToken & patNotToken, "$1(""$2"")$3") ' RS!Field -> RS("Field") - - S = RegExReplace(S, "([^a-zA-Z0-9_.])NullDate([^a-zA-Z0-9_.])", "$1NullDate()$2") - - S = ConvertVb6Specific(S, Complete) - If Complete Then ConvertElement = S: Exit Function - - If RegExTest(Trim(S), "^" & patToken & "$") Then -' If S = "SqFt" Then Stop - If IsFuncRef(Trim(S)) And S <> CurrSub Then - ConvertElement = Trim(S) & "()" - Exit Function - ElseIf IsPrivateFuncRef(CurrentModule, Trim(S)) And S <> CurrSub Then - ConvertElement = Trim(S) & "()" - Exit Function - ElseIf IsEnumRef(Trim(S)) Then - ConvertElement = EnumRefRepl(Trim(S)) - Exit Function - End If - End If - - If RegExTest(Trim(S), "^" & patTokenDot & "$") And StrCnt(S, ".") = 1 Then -' If S = "SqFt" Then Stop - Dim First As String, Second As String - First = SplitWord(S, 1, ".") - Second = SplitWord(S, 2, ".") - If IsModuleRef(First) And IsFuncRef(Second) Then - If IsFuncRef(Trim(Second)) And S <> CurrSub Then - ConvertElement = Trim(S) & "()" - Exit Function - ElseIf IsEnumRef(Trim(S)) Then - ConvertElement = EnumRefRepl(Trim(S)) - Exit Function - End If - End If - End If - -'If IsInStr(S, "Not optTagIncoming") Then Stop - If IsControlRef(Trim(S), FormName) Then -'If IsInStr(S, "optTagIncoming") Then Stop - S = FormControlRepl(S, FormName) - ElseIf LMatch(Trim(S), "Not ") And IsControlRef(Mid(Trim(S), 5), FormName) Then - S = "!(" & FormControlRepl(Mid(Trim(S), 5), FormName) & ")" - End If - - If IsFormRef(Trim(S)) Then - ConvertElement = FormRefRepl(Trim(S)) - Exit Function - End If - - - FirstToken = RegExNMatch(S, patTokenDot, 0) - FirstWord = SplitWord(S, 1) - If FirstWord = "Not" Then - S = "!" & ConvertValue(Mid(S, 5)) - FirstWord = SplitWord(Mid(S, 2)) - End If - If S = FirstWord Then ConvertElement = S: GoTo ManageFunctions - If S = FirstToken Then ConvertElement = S & "()": GoTo ManageFunctions - - If FirstToken = FirstWord And Not isOperator(SplitWord(S, 2)) Then ' Sub without parenthesis - ConvertElement = FirstWord & "(" & SplitWord(S, 2, , , True) & ")" - Else - ConvertElement = S - End If - -ManageFunctions: -'If IsInStr(ConvertElement, "New_CDbTypeAhead") Then Stop - If RegExTest(ConvertElement, "(\!)?[a-zA-Z0-9_.]+[ ]*\(.*\)$") Then - If (Left(ConvertElement, 1) = "!") Then - ConvertElement = "!" & ConvertFunctionCall(Mid(ConvertElement, 2)) - Else - ConvertElement = ConvertFunctionCall(ConvertElement) - End If - End If - -DoReplacements: - If IsInStr(ConvertElement, ":=") Then - Dim Ts As String - Ts = SplitWord(ConvertElement, 1, ":=") - Ts = Ts & ": " - Ts = Ts & ConvertElement(SplitWord(ConvertElement, 2, ":=", True, True)) - ConvertElement = Ts - End If - - ConvertElement = Replace(ConvertElement, " & ", " + ") - ConvertElement = Replace(ConvertElement, " = ", " == ") - ConvertElement = Replace(ConvertElement, "<>", "!=") - ConvertElement = Replace(ConvertElement, " Not ", " !") - ConvertElement = Replace(ConvertElement, "(Not ", "(!") - ConvertElement = Replace(ConvertElement, " Or ", " || ") - ConvertElement = Replace(ConvertElement, " And ", " && ") - ConvertElement = Replace(ConvertElement, " Mod ", " % ") - ConvertElement = Replace(ConvertElement, "Err.", "Err().") - ConvertElement = Replace(ConvertElement, "Debug.Print", "Console.WriteLine") - - ConvertElement = Replace(ConvertElement, "NullDate", "NullDate") - Do While IsInStr(ConvertElement, ", ,") - ConvertElement = Replace(ConvertElement, ", ,", ", _,") - Loop - ConvertElement = Replace(ConvertElement, "(,", "(_,") - -'If IsInStr(ConvertElement, "&H") And Right(ConvertElement, 1) = "&" Then Stop -'If IsInStr(ConvertElement, "1/1/2001") Then Stop - - ConvertElement = RegExReplace(ConvertElement, "([0-9])#", "$1") - - If Left(ConvertElement, 2) = "&H" Then - ConvertElement = "0x" & Mid(ConvertElement, 3) - If Right(ConvertElement, 1) = "&" Then ConvertElement = Left(ConvertElement, Len(ConvertElement) - 1) - End If - - If WithLevel > 0 Then - T = Stack(WithVars, , True) - ConvertElement = Trim(RegExReplace(ConvertElement, "([ (])(\.)" & patToken, "$1" & T & "$2$3")) - If Left(ConvertElement, 1) = "." Then ConvertElement = T & ConvertElement - End If -End Function - -Public Function ConvertFunctionCall(ByVal fCall As String) As String - Dim I As Long, N As Long, TB As String, Ts As String, TName As String - Dim TV As String - Dim vP As Variable -'Debug.Print "ConvertFunctionCall: " & fCall - - TB = "" - TName = RegExNMatch(fCall, "^[a-zA-Z0-9_.]*") - TB = TB & TName - - Ts = Mid(fCall, Len(TName) + 2) - Ts = Left(Ts, Len(Ts) - 1) - - vP = SubParam(TName) - If ConvertDataType(vP.asType) = "Recordset" Then - TB = TB & ".Fields[" - TB = TB & ConvertValue(Ts) - TB = TB & "].Value" - ElseIf vP.asArray <> "" Then - TB = TB & "[" - TB = TB & ConvertValue(Ts) - TB = TB & "]" -' TB = Replace(TB, ", ", "][") - Else - N = nextByPCt(Ts, ",") - TB = TB & "(" - For I = 1 To N - If I <> 1 Then TB = TB & ", " - TV = nextByP(Ts, ",", I) - If IsFuncRef(TName) Then - If Trim(TV) = "" Then - TB = TB & ConvertElement(FuncRefArgDefault(TName, I)) - Else - If FuncRefArgByRef(TName, I) Then TB = TB & "ref " - TB = TB & ConvertValue(TV) - End If - Else - TB = TB & ConvertValue(TV) - End If - Next - TB = TB & ")" - End If - ConvertFunctionCall = TB -End Function - - -Public Function ConvertValue(ByVal S As String) As String - Dim F As String, Op As String, OpN As String - Dim O As String - O = "" - S = Trim(S) - If S = "" Then Exit Function - -'If IsInStr(S, "GetMaxFieldValue") Then Stop -'If IsInStr(S, "DBAccessGeneral") Then Stop -'If IsInStr(S, "tallable") Then Stop -'If Left(S, 3) = "RS(" Then Stop -'If Left(S, 6) = "DBName" Then Stop -'If Left(S, 6) = "fName" Then Stop - - SubParamUsedList TokenList(S) - - If RegExTest(S, "^-[a-zA-Z0-9_]") Then - ConvertValue = "-" & ConvertValue(Mid(S, 2)) - Exit Function - End If - - Do While True - F = NextByOp(S, 1, Op) - If F = "" Then Exit Do - Select Case Trim(Op) - Case "\": OpN = "/" - Case "=": OpN = " == " - Case "<>": OpN = " != " - Case "&": OpN = " + " - Case "Mod": OpN = " % " - Case "Is": OpN = " == " - Case "Like": OpN = " == " - Case "And": OpN = " && " - Case "Or": OpN = " || " - Case Else: OpN = Op - End Select - - - If Left(F, 1) = "(" And Right(F, 1) = ")" Then - O = O & "(" & ConvertValue(Mid(F, 2, Len(F) - 2)) & ")" & OpN - Else - O = O & ConvertElement(F) & OpN - End If - - If Op = "" Then Exit Do - S = Mid(S, Len(F) + Len(Op) + 1) - If S = "" Or Op = "" Then Exit Do - Loop - ConvertValue = O -End Function - -Public Function ConvertGlobals(ByVal Str As String, Optional ByVal asModule As Boolean = False) As String - Dim Res As String - Dim S() As String, L As Variant, O As String - Dim Ind As Long - Dim Building As String - Dim inCase As Long - Dim returnVariable As String - Dim N As Long - - Res = "" - Building = "" - Str = Replace(Str, vbLf, "") - S = Split(Str, vbCr) - Ind = 0 - N = 0 -' Prg 0, UBound(S) - LBound(S) + 1, "Globals..." - InitDeString - For Each L In S - L = DeComment(L) - L = DeString(L) - O = "" - If Building <> "" Then - Building = Building & vbCrLf & L - If tLeft(L, 8) = "End Type" Then - O = ConvertType(Building) - Building = "" - ElseIf tLeft(L, 8) = "End Enum" Then - O = ConvertEnum(Building) - Building = "" - End If - ElseIf L Like "Option *" Then - O = "// " & L - ElseIf RegExTest(L, "^(Public |Private |)Declare ") Then - O = ConvertAPIDef(L) - ElseIf RegExTest(L, "^(Global |Public |Private |)Const ") Then - O = ConvertConstant(L, True) - ElseIf RegExTest(L, "^(Public |Private |)Event ") Then - O = ConvertEvent(L) - ElseIf RegExTest(L, "^(Public |Private |)Enum ") Then - Building = L - ElseIf RegExTest(LTrim(L), "^(Public |Private |)Type ") Then - Building = L - ElseIf tLeft(L, 8) = "Private " Or tLeft(L, 7) = "Public " Or tLeft(L, 4) = "Dim " Then - O = ConvertDeclare(L, 0, True, asModule) - End If - - O = ReComment(O) - Res = Res & ReComment(O) & IIf(O = "" Or Right(O, 2) = vbCrLf, "", vbCrLf) - N = N + 1 -' Prg N -' If N Mod 10000 = 0 Then Stop - Next -' Prg - - Res = ReString(Res, True) - ConvertGlobals = Res -End Function - -Public Function ConvertCodeLine(ByVal S As String) As String - Dim T As Long, A As String, B As String - Dim P As String, V As Variable - Dim FirstWord As String, Rest As String - Dim N As Long - -'If IsInStr(S, "dbClose") Then Stop -'If IsInStr(S, "Nothing") Then Stop -'If IsInStr(S, "Close ") Then Stop -'If IsInStr(S, "& functionType & fieldInfo &") Then Stop -'If IsInStr(S, " & vbCrLf2 & Res)") Then Stop -'If IsInStr(S, "Res = CompareSI(SI1, SI2)") Then Stop -'If IsInStr(S, "frmPrintPreviewDocument") Then Stop -'If IsInStr(S, "NewAudit.Name1") Then Stop -'If IsInStr(S, "optDelivered") Then Stop -'If IsInStr(S, " Is Nothing Then") Then Stop -'If IsInStr(S, "SqFt, SqYd") Then Stop -'If IsInStr(S, "optTagIncoming") Then Stop -'If IsInStr(S, "Kill modAshleyItemAlign") Then Stop -'If IsInStr(S, "PRFolder") Then Stop -'If IsInStr(S, "Array()") Then Stop -'If IsInStr(S, "App.Path") Then Stop - - If Trim(S) = "" Then ConvertCodeLine = "": Exit Function - Dim Complete As Boolean - S = ConvertVb6Specific(S, Complete) - If Complete Then - ConvertCodeLine = S - Exit Function - End If - - If RegExTest(Trim(S), "^[a-zA-Z0-9_.()]+ \= ") Or RegExTest(Trim(S), "^Set [a-zA-Z0-9_.()]+ \= ") Then ' Assignment - T = InStr(S, "=") - A = Trim(Left(S, T - 1)) - If tLeft(A, 4) = "Set " Then A = Trim(Mid(A, 5)) - SubParamAssign RegExNMatch(A, patToken) - If RegExTest(A, "^" & patToken & "\(""[^""]+""\)") Then - P = RegExNMatch(A, "^" & patToken) - V = SubParam(P) - If V.Name = P Then - SubParamAssign P - Select Case V.asType - Case "Recordset", "ADODB.Recordset" - ConvertCodeLine = RegExReplace(A, "^" & patToken & "(\("")([^""]+)(""\))", "$1.Fields[""$3""].Value") - Case Else - If Left(A, 1) = "." Then A = Stack(WithVars, , True) & A - ConvertCodeLine = A - End Select - End If - Else - If Left(A, 1) = "." Then A = Stack(WithVars, , True) & A - ConvertCodeLine = A - End If - - Dim tAWord As String - tAWord = SplitWord(A, 1, ".") - If IsFormRef(tAWord) Then - A = Replace(A, tAWord, tAWord & ".instance", , 1) - End If - - ConvertCodeLine = ConvertValue(ConvertCodeLine) & " = " - - B = ConvertValue(Trim(Mid(S, T + 1))) - ConvertCodeLine = ConvertCodeLine & B - Else -'Debug.Print S -'If IsInStr(S, "Call ") Then Stop - If LMatch(LTrim(S), "Call ") Then S = Mid(LTrim(S), 6) - - FirstWord = SplitWord(Trim(S)) - Rest = SplitWord(Trim(S), 2, , , True) - If Rest = "" Then - ConvertCodeLine = S & IIf(Right(S, 1) <> ")", "()", "") - ConvertCodeLine = ConvertElement(ConvertCodeLine) - ElseIf FirstWord = "RaiseEvent" Then - ConvertCodeLine = ConvertValue(S) - ElseIf FirstWord = "Debug.Print" Then - ConvertCodeLine = "Console.WriteLine(" & ConvertValue(Rest) & ")" - ElseIf StrQCnt(FirstWord, "(") = 0 Then - ConvertCodeLine = "" - ConvertCodeLine = ConvertCodeLine & FirstWord & "(" - N = 0 - Do - N = N + 1 - B = nextByP(Rest, ", ", N) - If B = "" Then Exit Do - ConvertCodeLine = ConvertCodeLine & IIf(N = 1, "", ", ") & ConvertValue(B) - Loop While True - ConvertCodeLine = ConvertCodeLine & ")" -' ConvertCodeLine = ConvertElement(ConvertCodeLine) - Else - ConvertCodeLine = ConvertValue(S) - End If - If WithLevel > 0 And Left(Trim(ConvertCodeLine), 1) = "." Then ConvertCodeLine = Stack(WithVars, , True) & Trim(ConvertCodeLine) - End If - -' If IsInStr(ConvertCodeLine, ",,,,,,,") Then Stop - - ConvertCodeLine = ConvertCodeLine & ";" -'Debug.Print ConvertCodeLine -End Function - -Public Function PostConvertCodeLine(ByVal Str As String) As String - Dim S As String - S = Str - -' If IsInStr(S, "optPoNo") Then Stop - - If IsInStr(S, "0 &") Then S = Replace(S, "0 &", "0") - If IsInStr(S, ".instance.instance") Then S = Replace(S, ".instance.instance", ".instance") - If IsInStr(S, ".IsChecked)") Then S = Replace(S, ".IsChecked)", ".IsChecked == true)", 1) - If IsInStr(S, ".IsChecked &") Then S = Replace(S, ".IsChecked", ".IsChecked == true", 1) - If IsInStr(S, ".IsChecked |") Then S = Replace(S, ".IsChecked", ".IsChecked == true", 1) - If IsInStr(S, ".IsChecked,") Then S = Replace(S, ".IsChecked", ".IsChecked == true", 1) - If IsInStr(S, ".IsChecked == 1,") Then S = Replace(S, ".IsChecked == 1", ".IsChecked == true", 1) - If IsInStr(S, ".IsChecked == 0,") Then S = Replace(S, ".IsChecked == 1", ".IsChecked == false", 1) - - If IsInStr(S, ".Visibility = true") Then S = Replace(S, ".Visibility = true", ".setVisible(true)") - If IsInStr(S, ".Visibility = false") Then S = Replace(S, ".Visibility = false", ".setVisible(false)") - - If IsInStr(S, ".Print(") Then - If IsInStr(S, ";);") Then - S = Replace(S, ";);", ");") - S = Replace(S, "Print(", "PrintNNL(") - End If - S = Replace(S, "; ", ", ") - End If - If IsInStr(S, ".Line((") Then - S = Replace(S, ") - (", ", ") - S = Replace(S, "Line((", "Line(") - S = Replace(S, "));", ");") - End If - - S = Replace(S, "vbRetryCancel +", "vbRetryCancel |") - S = Replace(S, "vbOkOnly +", "vbOkOnly |") - S = Replace(S, "vbOkCancel +", "vbOkCancel |") - S = Replace(S, "vbExclamation +", "vbExclamation |") - S = Replace(S, "vbYesNo +", "vbYesNo |") - S = Replace(S, "vbQuestion +", "vbQuestion |") - S = Replace(S, "vbOKCancel +", "vbOKCancel |") - S = Replace(S, "+ vbExclamation", "| vbExclamation") - - PostConvertCodeLine = S -End Function - -Public Function ConvertSub(ByVal Str As String, Optional ByVal asModule As Boolean = False, Optional ByVal ScanFirst As VbTriState = vbUseDefault) As String - Dim oStr As String - Dim Res As String - Dim S() As String, L As Variant, O As String, T As String, U As String, V As String - Dim CM As Long, cN As Long - Dim K As Long - Dim Ind As Long - Dim inCase As Long - Dim returnVariable As String - -' If IsInStr(Str, "Dim oFTP As New FTP") Then Stop -' If IsInStr(Str, "cHolding") Then Stop -'If IsInStr(Str, "IsIDE") Then Stop - - - Select Case ScanFirst - Case vbUseDefault: - oStr = Str - ConvertSub oStr, asModule, vbTrue -' If IsInStr(Str, "StoreStockToolTipText") Then Stop - ConvertSub = ConvertSub(oStr, asModule, vbFalse) - Exit Function - Case vbTrue: SubBegin - Case vbFalse: SubBegin True - End Select - - - - Res = "" - Str = Replace(Str, vbLf, "") - S = Split(Str, vbCr) - Ind = 0 - -'If IsInStr(Str, " WinCDSDataPath(") Then Stop -'If IsInStr(Str, " RunShellExecute(") Then Stop -'If IsInStr(Str, " ValidateSI(") Then Stop - For Each L In S -'If IsInStr(L, "OrdVoid") Then Stop -'If IsInStr(L, "MsgBox") Then Stop -'If IsInStr(L, "And Not IsDoddsLtd Then") Then Stop - L = DeComment(L) - L = DeString(L) - O = "" - -'If IsInStr(L, "1/1/2001") Then Stop -'If ScanFirst = vbFalse Then Stop -'If IsInStr(L, "Public Function GetFileAutonumber") Then Stop -'If IsInStr(L, "GetCustomerBalance") Then Stop -'If IsInStr(L, "IsIDE") Then Stop - - - Dim PP As String, PQ As String - PP = "^(Public |Private |)(Friend |)(Function |Sub )" & patToken & "[ ]*\(" - PQ = "^(Public |Private )(Property )(Get |Let |Set )" & patToken & "[ ]*\(" - If RegExNMatch(L, PP) <> "" Then - Dim nK As Long -' CurrSub = nextBy(L, "(", 1) -' If (LMatch(CurrSub, "Public ")) Then CurrSub = Mid(CurrSub, 8) -' If (LMatch(CurrSub, "Private ")) Then CurrSub = Mid(CurrSub, 9) -' If (LMatch(CurrSub, "Friend ")) Then CurrSub = Mid(CurrSub, 8) -' If (LMatch(CurrSub, "Function ")) Then CurrSub = Mid(CurrSub, 10) -' If (LMatch(CurrSub, "Sub ")) Then CurrSub = Mid(CurrSub, 5) -'If IsInStr(L, "Public Function IsIn") Then Stop - O = O & sSpace(Ind) & ConvertPrototype(L, returnVariable, asModule, CurrSub) - Ind = Ind + SpIndent - ElseIf RegExNMatch(L, PQ) <> "" Then -' If IsInStr(L, "edi888_Admin888_Src") Then Stop - AddProperty Str - Exit Function ' repacked later... not added here. - ElseIf tLMatch(L, "End Sub") Or tLMatch(L, "End Function") Then - If returnVariable <> "" Then - O = O & sSpace(Ind) & "return " & returnVariable & ";" & vbCrLf - End If - Ind = Ind - SpIndent - O = O & sSpace(Ind) & "}" - ElseIf tLMatch(L, "Exit Function") Or tLMatch(L, "Exit Sub") Then - If returnVariable <> "" Then - O = O & sSpace(Ind) & "return " & returnVariable & ";" & vbCrLf - Else - O = O & "return;" & vbCrLf - End If - ElseIf tLMatch(L, "GoTo ") Then - O = O & "goto " & SplitWord(Trim(L), 2) & ";" - ElseIf RegExTest(Trim(L), "^[a-zA-Z_][a-zA-Z_0-9]*:$") Then ' Goto Label - O = O & L & ";" ' c# requires a trailing ; on goto labels without trailing statements. Likely a C# bug/oversight, but it's there. - ElseIf tLeft(L, 3) = "Dim" Then - O = ConvertDeclare(L, Ind) - ElseIf tLeft(L, 5) = "Const" Then - O = sSpace(Ind) & ConvertConstant(L, False) - ElseIf tLeft(L, 3) = "If " Then ' Code sanitization prevents all single-line ifs. -'If IsInStr(L, "optDelivered") Then Stop -'If IsInStr(L, "PRFolder") Then Stop - T = Mid(Trim(L), 4, Len(Trim(L)) - 8) - O = sSpace(Ind) & "if (" & ConvertValue(T) & ") {" - Ind = Ind + SpIndent - ElseIf tLeft(L, 7) = "ElseIf " Then - T = tMid(L, 8) - If Right(Trim(L), 5) = " Then" Then T = Left(T, Len(T) - 5) - O = sSpace(Ind - SpIndent) & "} else if (" & ConvertValue(T) & ") {" - ElseIf tLeft(L, 5) = "Else" Then - O = sSpace(Ind - SpIndent) & "} else {" - ElseIf tLeft(L, 6) = "End If" Then - Ind = Ind - SpIndent - O = sSpace(Ind) & "}" - ElseIf tLeft(L, 12) = "Select Case " Then - O = O & sSpace(Ind) & "switch(" & ConvertValue(tMid(L, 13)) & ") {" - Ind = Ind + SpIndent - ElseIf tLeft(L, 10) = "End Select" Then - If inCase > 0 Then Ind = Ind - SpIndent: inCase = inCase - 1 - Ind = Ind - SpIndent - O = O & "break;" & vbCrLf - O = O & "}" - ElseIf tLeft(L, 9) = "Case Else" Then - If inCase > 0 Then O = O & sSpace(Ind) & "break;" & vbCrLf: Ind = Ind - SpIndent: inCase = inCase - 1 - O = O & sSpace(Ind) & "default:" - inCase = inCase + 1 - Ind = Ind + SpIndent - ElseIf tLeft(L, 5) = "Case " Then - T = Mid(Res, InStrRev(Res, "switch(")) - If RegExTest(T, "case [^:]+:") Then O = O & sSpace(Ind) & "break;" & vbCrLf: Ind = Ind - SpIndent: inCase = inCase - 1 - T = tMid(L, 6) - If tLeft(T, 5) = "Like " Or tLeft(T, 3) = "Is " Or T Like "* = *" Then - O = O & "// TODO: Cannot convert case: " & T & vbCrLf - O = O & sSpace(Ind) & "case 0: " - ElseIf nextBy(T, ",", 2) <> "" Then - O = O & sSpace(Ind) - Do - U = nextBy(T, ", ") - If U = "" Then Exit Do - T = Trim(Mid(T, Len(U) + 1)) - O = O & "case " & ConvertValue(U) & ": " - Loop While True - ElseIf T Like "* To *" Then - O = O & "// CONVERSION: Case was " & T & vbCrLf - O = O & sSpace(Ind) - cN = Val(SplitWord(T, 1, " To ")) - CM = Val(SplitWord(T, 2, " To ")) - For K = cN To CM - O = O & "case " & K & ": " - Next - Else - Dim TT As Variant, LL As Variant -' O = O & sSpace(Ind) & "case " & ConvertValue(T) & ":" - O = O & Space(Ind) - For Each LL In Split(T, ",") - O = O & "case " & ConvertValue(T) & ": " - Next - End If - inCase = inCase + 1 - Ind = Ind + SpIndent - ElseIf Trim(L) = "Do" Then - O = O & sSpace(Ind) & "do {" - Ind = Ind + SpIndent - ElseIf tLeft(L, 9) = "Do While " Then - O = O & sSpace(Ind) & "while(" & ConvertValue(tMid(L, 10)) & ") {" - Ind = Ind + SpIndent - ElseIf tLeft(L, 9) = "Do Until " Then - O = O & sSpace(Ind) & "while(!(" & ConvertValue(tMid(L, 10)) & ")) {" - Ind = Ind + SpIndent - ElseIf tLeft(L, 9) = "For Each " Then - L = tMid(L, 10) - Dim iterVar As String - iterVar = SplitWord(L, 1, " In ") - O = O & sSpace(Ind) & "foreach(var iter" & iterVar & " in " & SplitWord(L, 2, " In ") & ") {" & vbCrLf & iterVar & " = iter" & iterVar & ";" - Ind = Ind + SpIndent - ElseIf tLeft(L, 4) = "For " Then - Dim forKey As String, forStr As String, forEnd As String - L = tMid(L, 5) - forKey = SplitWord(L, 1, "=") - L = SplitWord(L, 2, "=") - forStr = SplitWord(L, 1, " To ") - forEnd = SplitWord(L, 2, " To ") - O = O & sSpace(Ind) & "for(" & ConvertElement(forKey) & "=" & ConvertElement(forStr) & "; " & ConvertElement(forKey) & "<" & ConvertElement(forEnd) & "; " & ConvertElement(forKey) & "++) {" - Ind = Ind + SpIndent - ElseIf tLeft(L, 11) = "Loop While " Then - Ind = Ind - SpIndent - O = O & sSpace(Ind) & "} while(!(" & ConvertValue(tMid(L, 12)) & "));" - ElseIf tLeft(L, 11) = "Loop Until " Then - Ind = Ind - SpIndent - O = O & sSpace(Ind) & "} while(!(" & ConvertValue(tMid(L, 12)) & "));" - ElseIf tLeft(L, 5) = "Loop" Then - Ind = Ind - SpIndent - O = O & sSpace(Ind) & "}" - ElseIf tLeft(L, 8) = "Exit For" Or tLeft(L, 7) = "Exit Do" Or tLeft(L, 10) = "Exit While" Then - O = O & sSpace(Ind) & "break;" - ElseIf tLeft(L, 5) = "Next" Then - Ind = Ind - SpIndent - O = sSpace(Ind) & "}" - ElseIf tLeft(L, 5) = "With " Then - WithLevel = WithLevel + 1 - - T = ConvertValue(tMid(L, 6)) - U = ConvertDataType(SubParam(T).asType) - V = WithMark & IIf(SubParam(T).Name <> "", T, Random) - If U = "" Then U = DefaultDataType - - Stack WithAssign, T - Stack WithTypes, U - Stack WithVars, V - - O = O & sSpace(Ind) & U & " " & V & ";" & vbCrLf - MaxWithLevel = MaxWithLevel + 1 - O = O & sSpace(Ind) & V & " = " & T & ";" - Ind = Ind + SpIndent - ElseIf tLeft(L, 8) = "End With" Then - WithLevel = WithLevel - 1 - T = Stack(WithAssign) - U = Stack(WithTypes) - V = Stack(WithVars) - If SubParam(T).Name <> "" Then - O = O & sSpace(Ind) & T & " = " & V & ";" - End If - Ind = Ind - SpIndent - ElseIf IsInStr(L, "On Error ") Or IsInStr(L, "Resume ") Then - O = sSpace(Ind) & "// TODO (not supported): " & L - Else -'If IsInStr(L, "ComputeAgeing dtpArrearControlDate") Then Stop -'If IsInStr(L, "RaiseEvent") Then Stop -'If IsInStr(L, "Debug.Print") Then Stop -'If IsInStr(L, "HasGit") Then Stop - O = sSpace(Ind) & ConvertCodeLine(L) - End If - - O = modConvert.PostConvertCodeLine(O) - O = modProjectSpecific.ProjectSpecificPostCodeLineConvert(O) - - O = ReComment(O) - Res = Res & ReComment(O) & IIf(O = "", "", vbCrLf) - Next - - ConvertSub = Res -End Function diff --git a/modConvertForm.bas b/modConvertForm.bas index 803b444..c2dffd6 100644 --- a/modConvertForm.bas +++ b/modConvertForm.bas @@ -2,6 +2,7 @@ Attribute VB_Name = "modConvertForm" Option Explicit Private EventStubs As String +Public FormControlArrays As String Public Function Frm2Xml(ByVal F As String) As String Dim Sp() As String, L As Variant, I As Long @@ -60,6 +61,7 @@ Public Function ConvertFormUi(ByVal F As String, ByVal CodeSection As String) As Sp = Split(F, vbCrLf) EventStubs = "" + FormControlArrays = "" For K = LBound(Sp) To UBound(Sp) L = Trim(Sp(K)) @@ -115,7 +117,7 @@ Private Function ConvertProperty(ByVal S As String) As String End Function Private Function StartControl(ByVal L As String, ByVal Props As Collection, ByVal DoEmpty As Boolean, ByVal Code As String, ByRef TagType As String) As String - Dim cType As String, cName As String, cIndex As String + Dim cType As String, oName As String, cName As String, cIndex As String Dim tType As String, tCont As Boolean, tDef As String, Features As String Dim S As String, N As String, M As String Dim V As String @@ -123,11 +125,16 @@ Private Function StartControl(ByVal L As String, ByVal Props As Collection, ByVa TagType = "" cType = SplitWord(L, 2) - cName = SplitWord(L, 3) + oName = SplitWord(L, 3) cIndex = cValP(Props, "Index") - If cIndex <> "" Then cName = cName & "_" & cIndex - ControlData cType, tType, tCont, tDef, Features + If cIndex <> "" Then + If InStr(FormControlArrays, "[" & oName & ",") = 0 Then FormControlArrays = FormControlArrays & "[" & oName & "," & tType & "]" + cName = oName & "_" & cIndex + Else + cName = oName + End If + S = "" On Error Resume Next diff --git a/modOrigConvert.bas b/modOrigConvert.bas new file mode 100644 index 0000000..ab02217 --- /dev/null +++ b/modOrigConvert.bas @@ -0,0 +1,1283 @@ +Attribute VB_Name = "modOrigConvert" +Option Explicit + +Const WithMark As String = "_WithVar_" + +Dim WithLevel As Long, MaxWithLevel As Long +Dim WithVars As String, WithTypes As String, WithAssign As String +Dim FormName As String + +Dim CurrentModule As String + + +Dim CurrSub As String + +Public Function GetMultiLineSpace(ByVal Prv As String, ByVal Nxt As String) As String + Dim pC As String, nC As String + GetMultiLineSpace = " " + pC = Right(Prv, 1) + nC = Left(Nxt, 1) + If nC = "(" Then GetMultiLineSpace = "" +End Function + +Public Function SanitizeCode(ByVal Str As String) As String + Const NamedParamSrc As String = ":=" + Const NamedParamTok As String = "###NAMED-PARAMETER###" + Dim Sp() As String, L As Variant + Dim F As String + Dim R As String, N As String + Dim Building As String + Dim FinishSplitIf As Boolean + + R = "": N = vbCrLf + Sp = Split(Str, vbCrLf) + Building = "" + + + For Each L In Sp +'If IsInStr(L, "POEDIFolder") Then Stop +'If IsInStr(L, "Set objSourceArNo = New_CDbTypeAhead") Then Stop + If Right(L, 1) = "_" Then + Dim C As String + C = Trim(Left(L, Len(L) - 1)) + Building = Building & GetMultiLineSpace(Building, C) & C + GoTo NextLine + End If + If Building <> "" Then + L = Building & GetMultiLineSpace(Building, Trim(L)) & Trim(L) + Building = "" + End If + +' If IsInStr(L, "'") Then Stop + L = DeComment(L) + L = DeString(L) +'If IsInStr(L, "CustRec <> 0") Then Stop + + FinishSplitIf = False + If tLeft(L, 3) = "If " And Right(RTrim(L), 5) <> " Then" Then + FinishSplitIf = True + F = nextBy(L, " Then ") & " Then" + R = R & N & F + L = Mid(L, Len(F) + 2) + If nextBy(L, " Else ", 2) <> "" Then + R = R & SanitizeCode(nextBy(L, " Else ", 1)) + R = R & N & "Else" + L = nextBy(L, "Else ", 2) + End If + End If + + If nextBy(L, ":") <> L Then + If RegExTest(Trim(L), "^[a-zA-Z_][a-zA-Z_0-9]*:$") Then ' Goto Label + R = R & N & ReComment(L) + Else + Do + L = Replace(L, NamedParamSrc, NamedParamTok) + F = nextBy(L, ":") + F = Replace(F, NamedParamTok, NamedParamSrc) + R = R & N & ReComment(F, True) + L = Replace(L, NamedParamTok, NamedParamSrc) + If F = L Then Exit Do + L = Trim(Mid(L, Len(F) + 2)) + R = R & SanitizeCode(L) + + Loop While False + End If + Else + R = R & N & ReComment(L, True) + End If + + If FinishSplitIf Then R = R & N & "End If" +NextLine: + Next + + SanitizeCode = R +End Function + +Public Function ConvertCodeSegment(ByVal S As String, Optional ByVal AsModule As Boolean = False) As String + Dim P As String, N As Long + Dim F As String, T As Long, E As Long, K As String, X As Long + Dim Pre As String, Body As String + Dim R As String + + ClearProperties + + InitDeString +'WriteFile "C:\Users\benja\Desktop\code.txt", S, True + S = SanitizeCode(S) +'WriteFile "C:\Users\benja\Desktop\sani.txt", S, True + Do + P = "(Public |Private |)(Friend |)(Function |Sub |Property Get |Property Let |Property Set )" & patToken & "[ ]*\(" + N = -1 + Do + N = N + 1 + F = RegExNMatch(S, P, N) + T = RegExNPos(S, P, N) + Loop While Not IsInCode(S, T) And F <> "" + If F = "" Then Exit Do + + If IsInStr(F, " Function ") Then + K = "End Function" + ElseIf IsInStr(F, " Sub ") Then + K = "End Sub" + ElseIf IsInStr(F, " Property ") Then + K = "End Property" + End If + N = -1 + Do + N = N + 1 + E = RegExNPos(Mid(S, T), K, N) + Len(K) + T + Loop While Not IsInCode(S, E) And E <> 0 + + If T > 1 Then Pre = nlTrim(Left(S, T - 1)) Else Pre = "" + Do Until Mid(S, E, 1) = vbCr Or Mid(S, E, 1) = vbLf Or Mid(S, E, 1) = "" + E = E + 1 + Loop + Body = nlTrim(Mid(S, T, E - T)) + + S = nlTrim(Mid(S, E + 1)) + + R = R & CommentBlock(Pre) & ConvertSub(Body, AsModule) & vbCrLf + Loop While True + + R = ReadOutProperties(AsModule) & vbCrLf2 & R + + R = ReString(R, True) + + ConvertCodeSegment = R +End Function + +Public Function CommentBlock(ByVal Str As String) As String + Dim S As String + If nlTrim(Str) = "" Then Exit Function + S = "" + S = S & "/*" & vbCrLf + S = S & Replace(Str, "*/", "* /") & vbCrLf + S = S & "*/" & vbCrLf + CommentBlock = S +End Function + +Public Function ConvertDeclare(ByVal S As String, ByVal Ind As Long, Optional ByVal isGlobal As Boolean = False, Optional ByVal AsModule As Boolean = False) As String + Dim Sp() As String, L As Variant, SS As String + Dim asPrivate As Boolean + Dim pName As String, pType As String, pWithEvents As Boolean + Dim Res As String + Dim ArraySpec As String, isArr As Boolean, aMax As Long, aMin As Long, aTodo As String + Res = "" + + SS = S + + If tLeft(S, 7) = "Public " Then S = tMid(S, 8) + If tLeft(S, 4) = "Dim " Then S = Mid(Trim(S), 5): asPrivate = True + If tLeft(S, 8) = "Private " Then S = tMid(S, 9): asPrivate = True + +' If IsInStr(S, "aMin") Then Stop + Sp = Split(S, ",") + For Each L In Sp + L = Trim(L) + If LMatch(L, "WithEvents ") Then L = Trim(tMid(L, 12)): Res = Res & "// TODO: WithEvents not supported on " & RegExNMatch(L, patToken) & vbCrLf + pName = RegExNMatch(L, patToken) + L = Trim(tMid(L, Len(pName) + 1)) + If isGlobal Then Res = Res & IIf(asPrivate, "private ", "public ") + If AsModule Then Res = Res & "static " + If tLeft(L, 1) = "(" Then + isArr = True + ArraySpec = nextBy(Mid(L, 2), ")") + If ArraySpec = "" Then + aMin = -1 + aMax = -1 + L = Trim(tMid(L, 3)) + Else + L = Trim(tMid(L, Len(ArraySpec) + 3)) + aMin = 0 + aMax = Val(SplitWord(ArraySpec)) + ArraySpec = Trim(tMid(ArraySpec, Len(aMax) + 1)) + If tLeft(ArraySpec, 3) = "To " Then + aMin = aMax + aMax = Val(tMid(ArraySpec, 4)) + End If + End If + End If + + Dim AsNew As Boolean + AsNew = False + If SplitWord(L, 1) = "As" Then + pType = SplitWord(L, 2) + If pType = "New" Then + pType = SplitWord(L, 3) + AsNew = True + End If + Else + pType = "Variant" + End If + + If Not isArr Then + Res = Res & sSpace(Ind) & ConvertDataType(pType) & " " & pName + Res = Res & " = " + If AsNew Then + Res = Res & "new " + Res = Res & ConvertDataType(pType) + Res = Res & "()" + Else + Res = Res & ConvertDefaultDefault(pType) + End If + Res = Res & ";" & vbCrLf + Else + aTodo = IIf(aMin = 0, "", " // TODO - Specified Minimum Array Boundary Not Supported: " & SS) + If Not IsNumeric(aMax) Then + Res = Res & sSpace(Ind) & "List<" & ConvertDataType(pType) & "> " & pName & " = new List<" & ConvertDataType(pType) & "> (new " & ConvertDataType(pType) & "[(" & aMax & " + 1)]); // TODO: Confirm Array Size By Token" & aTodo & vbCrLf + ElseIf Val(aMax) = -1 Then + Res = Res & sSpace(Ind) & "List<" & ConvertDataType(pType) & "> " & pName & " = new List<" & ConvertDataType(pType) & "> {};" & aTodo & vbCrLf + Else + Res = Res & sSpace(Ind) & "List<" & ConvertDataType(pType) & "> " & pName & " = new List<" & ConvertDataType(pType) & "> (new " & ConvertDataType(pType) & "[" & (Val(aMax) + 1) & "]);" & aTodo & vbCrLf + End If + End If + + SubParamDecl pName, pType, IIf(isArr, "" & aMax, ""), False, False + Next + + ConvertDeclare = Res +End Function + +Public Function ConvertAPIDef(ByVal S As String) As String +'Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long +'[DllImport("User32.dll")] +'public static extern int MessageBox(int h, string m, string c, int type); + Dim isPrivate As Boolean, IsSub As Boolean + Dim AName As String + Dim aLib As String + Dim aAlias As String + Dim aArgs As String + Dim aReturn As String + Dim tArg As String, Has As Boolean + If tLeft(S, 8) = "Private " Then S = tMid(S, 9): isPrivate = True + If tLeft(S, 7) = "Public " Then S = tMid(S, 8) + If tLeft(S, 8) = "Declare " Then S = tMid(S, 9) + If tLeft(S, 4) = "Sub " Then S = tMid(S, 5): IsSub = True + If tLeft(S, 9) = "Function " Then S = tMid(S, 10) + AName = RegExNMatch(S, patToken) + S = Trim(tMid(S, Len(AName) + 1)) + If tLeft(S, 4) = "Lib " Then + S = Trim(tMid(S, 5)) + aLib = SplitWord(S, 1) + S = Trim(tMid(S, Len(aLib) + 1)) + aLib = ReString(aLib) + If Left(aLib, 1) = """" Then aLib = Mid(aLib, 2) + If Right(aLib, 1) = """" Then aLib = Left(aLib, Len(aLib) - 1) + If LCase(Right(aLib, 4)) <> ".dll" Then aLib = aLib & ".dll" + aLib = LCase(aLib) + End If + If tLeft(S, 6) = "Alias " Then + S = Trim(tMid(S, 7)) + aAlias = SplitWord(S, 1) + S = Trim(tMid(S, Len(aAlias) + 1)) + aAlias = ReString(aAlias) + If Left(aAlias, 1) = """" Then aAlias = Mid(aAlias, 2) + If Right(aAlias, 1) = """" Then aAlias = Left(aAlias, Len(aAlias) - 1) + End If + If tLeft(S, 1) = "(" Then S = tMid(S, 2) + aArgs = nextBy(S, ")") + S = Trim(tMid(S, Len(aArgs) + 2)) + If tLeft(S, 3) = "As " Then + S = Trim(tMid(S, 4)) + aReturn = SplitWord(S, 1) + S = Trim(tMid(S, Len(aReturn) + 1)) + Else + aReturn = "Variant" + End If + + S = "" + S = S & "[DllImport(""" & aLib & """" & IIf(aAlias = "", "", ", EntryPoint = """ & aAlias & """") & ")] " + S = S & IIf(isPrivate, "private ", "public ") + S = S & "static extern " + S = S & IIf(IsSub, "void ", ConvertDataType(aReturn)) & " " + S = S & AName + S = S & "(" + Do + If aArgs = "" Then Exit Do + tArg = Trim(nextBy(aArgs, ",")) + aArgs = tMid(aArgs, Len(tArg) + 2) + S = S & IIf(Has, ", ", "") & ConvertParameter(tArg, True) + Has = True + Loop While True + S = S & ");" + + + ConvertAPIDef = S +End Function + +Public Function ConvertConstant(ByVal S As String, Optional ByVal isGlobal As Boolean = True) As String + Dim cName As String, cType As String, cValue As String, isPrivate As Boolean, dataType As String + If tLeft(S, 7) = "Public " Then S = Mid(Trim(S), 8) + If tLeft(S, 7) = "Global " Then S = Mid(Trim(S), 8) + If tLeft(S, 8) = "Private " Then S = Mid(Trim(S), 9): isPrivate = True + If tLeft(S, 6) = "Const " Then S = Mid(Trim(S), 7) + cName = SplitWord(S, 1) + S = Trim(Mid(Trim(S), Len(cName) + 1)) + If tLeft(S, 3) = "As " Then + S = Trim(Mid(Trim(S), 3)) + cType = SplitWord(S, 1) + S = Trim(tMid(S, Len(cType) + 1)) + Else + cType = "Variant" + End If + + If Left(S, 1) = "=" Then + S = Trim(Mid(S, 2)) + cValue = ConvertValue(S) + Else + cValue = ConvertDefaultDefault(cType) + End If + + dataType = ConvertDataType(cType) + If dataType = "dynamic" Then ' c# can't handle constants of type 'dynamic' when type can be inferred. + If LMatch(cValue, DeStringToken_Base) Then + dataType = "string" + ElseIf IsNumeric(cValue) Then + If IsInStr(cValue, ".") Then dataType = "decimal" Else dataType = "int" + End If + End If + + If cType = "Date" Then + ConvertConstant = IIf(isGlobal, IIf(isPrivate, "private ", "public "), "") & "static readonly " & dataType & " " & cName & " = " & cValue & ";" + Else + ConvertConstant = IIf(isGlobal, IIf(isPrivate, "private ", "public "), "") & "const " & dataType & " " & cName & " = " & cValue & ";" + End If +End Function + + +Public Function ConvertEvent(ByVal S As String) As String + Dim cName As String, cArgs As String, tArgs As String, isPrivate As Boolean + Dim R As String, N As Long, M As String, O As String + Dim I As Long, J As Long + Dim A As String + If tLeft(S, 7) = "Public " Then S = Mid(Trim(S), 8) + If tLeft(S, 8) = "Private " Then S = Mid(Trim(S), 9): isPrivate = True + If tLeft(S, 6) = "Event " Then S = Mid(Trim(S), 7) + cName = RegExNMatch(S, patToken) + cArgs = Trim(Mid(Trim(S), Len(cName) + 1)) + If Left(cArgs, 1) = "(" Then cArgs = Mid(cArgs, 2) + If Right(cArgs, 1) = ")" Then cArgs = Left(cArgs, Len(cArgs) - 1) + + N = 0 + Do + N = N + 1 + A = nextBy(cArgs, ",", N) + If A = "" Then Exit Do + tArgs = tArgs & IIf(N = 1, "", ", ") + tArgs = tArgs & ConvertParameter(A, True) + Loop While True + + O = vbCrLf + M = "" + R = "" + R = R & M & "public delegate void " & cName & "Handler(" & tArgs & ");" + R = R & O & "public event " & cName & "Handler event" & cName & ";" + + ConvertEvent = R +End Function + + +Public Function ConvertEnum(ByVal S As String) As String + Dim isPrivate As Boolean, EName As String + Dim Res As String, Has As Boolean + If tLeft(S, 7) = "Public " Then S = tMid(S, 8) + If tLeft(S, 8) = "Private " Then S = tMid(S, 9): isPrivate = True + If tLeft(S, 5) = "Enum " Then S = tMid(S, 6) + EName = RegExNMatch(S, patToken, 0) + S = nlTrim(tMid(S, Len(EName) + 1)) + + Res = "public enum " & EName & " {" + + Do While tLeft(S, 8) <> "End Enum" And S <> "" + EName = RegExNMatch(S, patToken, 0) + Res = Res & IIf(Has, ",", "") & vbCrLf & sSpace(SpIndent) & EName + Has = True + + S = nlTrim(tMid(S, Len(EName) + 1)) + If tLeft(S, 1) = "=" Then + S = nlTrim(Mid(S, 3)) + If Left(S, 1) = "&" Then + EName = ConvertElement(RegExNMatch(S, "&H[0-9A-F]+")) + Else + EName = RegExNMatch(S, "[0-9]*", 0) + End If + Res = Res & " = " & EName + S = nlTrim(tMid(S, Len(EName) + 1)) + End If + Loop + Res = Res & vbCrLf & "}" + + ConvertEnum = Res +End Function + +Public Function ConvertType(ByVal S As String) As String + Dim isPrivate As Boolean, EName As String, eArr As String, eType As String + Dim Res As String + Dim N As String + If tLeft(S, 7) = "Public " Then S = tMid(S, 8) + If tLeft(S, 8) = "Private " Then S = tMid(S, 9): isPrivate = True + If tLeft(S, 5) = "Type " Then S = tMid(S, 6) + EName = RegExNMatch(S, patToken, 0) + S = nlTrim(tMid(S, Len(EName) + 1)) +'If IsInStr(eName, "OSVERSIONINFO") Then Stop + + Res = IIf(isPrivate, "private ", "public ") & "class " & EName & " {" + + Do While tLeft(S, 8) <> "End Type" And S <> "" + EName = RegExNMatch(S, patToken, 0) + S = nlTrim(tMid(S, Len(EName) + 1)) + eArr = "" + If LMatch(S, "(") Then + N = nextBy(Mid(S, 2), ")") + S = nlTrim(Mid(S, Len(N) + 3)) + N = ConvertValue(N) + eArr = "[" & N & "]" + End If + + If tLeft(S, 3) = "As " Then + S = nlTrim(Mid(S, 4)) + eType = RegExNMatch(S, patToken, 0) + S = nlTrim(tMid(S, Len(eType) + 1)) + Else + eType = "Variant" + End If + Res = Res & vbCrLf & " public " & ConvertDataType(eType) & IIf(eArr = "", "", "[]") & " " & EName + If eArr = "" Then + Res = Res & " = " & ConvertDefaultDefault(eType) + Else + Res = Res & " = new " & ConvertDataType(eType) & eArr + End If + Res = Res & ";" + If tLMatch(S, "* ") Then + S = Mid(LTrim(S), 3) + N = RegExNMatch(S, "[0-9]+", 0) + S = nlTrim(Mid(LTrim(S), Len(N) + 1)) + Res = Res & " //TODO: Fixed Length Strings Not Supported: * " & N + End If + + Loop + Res = Res & vbCrLf & "}" + + ConvertType = Res +End Function + +Public Function ConvertParameter(ByVal S As String, Optional ByVal NeverUnused As Boolean = False) As String + Dim IsOptional As Boolean + Dim IsByRef As Boolean, asOut As Boolean + Dim Res As String + Dim pName As String, pType As String, pDef As String + Dim TName As String + + S = Trim(S) + If tLeft(S, 9) = "Optional " Then IsOptional = True: S = Mid(S, 10) + IsByRef = True + If tLeft(S, 6) = "ByVal " Then IsByRef = False: S = Mid(S, 7) + If tLeft(S, 6) = "ByRef " Then IsByRef = True: S = Mid(S, 7) + pName = SplitWord(S, 1) + If IsByRef And SubParam(pName).AssignedBeforeUsed Then asOut = True + S = Trim(Mid(S, Len(pName) + 1)) + If tLeft(S, 2) = "As" Then + S = tMid(S, 4) + pType = SplitWord(S, 1, "=") + S = Trim(Mid(S, Len(pType) + 1)) + Else + pType = "Variant" + End If + If Left(S, 1) = "=" Then + pDef = ConvertValue(Trim(Mid(Trim(S), 2))) + S = "" + Else + pDef = ConvertDefaultDefault(pType) + End If + + Res = "" + If IsByRef Then Res = Res & IIf(asOut, "out ", "ref ") + Res = Res & ConvertDataType(pType) & " " + If IsInStr(pName, "()") Then Res = Res & "[] ": pName = Replace(pName, "()", "") + TName = pName + If Not NeverUnused Then + If Not SubParam(pName).Used And Not (SubParam(pName).Param And SubParam(pName).Assigned) Then + TName = TName & "_UNUSED" + End If + End If + Res = Res & TName + If IsOptional And Not IsByRef Then + Res = Res & "= " & pDef + End If + + SubParamDecl pName, pType, False, True, False + ConvertParameter = Trim(Res) +End Function + +Public Function ConvertPrototype(ByVal SS As String, Optional ByRef returnVariable As String = "", Optional ByVal AsModule As Boolean = False, Optional ByRef asName As String = "") As String + Const retToken As String = "#RET#" + Dim Res As String + Dim fName As String, fArgs As String, retType As String, T As String + Dim tArg As String + Dim IsSub As Boolean + Dim hArgs As Boolean + Dim S As String + + S = SS + + Res = "" + returnVariable = "" + IsSub = False + If LMatch(S, "Public ") Then Res = Res & "public ": S = Mid(S, 8) + If LMatch(S, "Private ") Then Res = Res & "private ": S = Mid(S, 9) + If LMatch(S, "Friend ") Then S = Mid(S, 8) + If AsModule Then Res = Res & "static " + If LMatch(S, "Sub ") Then Res = Res & "void ": S = Mid(S, 5): IsSub = True + If LMatch(S, "Function ") Then Res = Res & retToken & " ": S = Mid(S, 10) + + fName = Trim(SplitWord(Trim(S), 1, "(")) + asName = fName + + S = Trim(tMid(S, Len(fName) + 2)) + If Left(S, 1) = "(" Then S = Trim(tMid(S, 2)) + fArgs = Trim(nextBy(S, ")")) + S = Mid(S, Len(fArgs) + 2) + Do While Right(fArgs, 1) = "(" + fArgs = fArgs & ") " + Dim tMore As String + tMore = Trim(nextBy(S, ")")) + fArgs = fArgs & tMore + S = Mid(S, Len(tMore) + 2) + Loop + If Left(S, 1) = ")" Then S = Trim(tMid(S, 2)) + + If Not IsSub Then + If tLeft(S, 2) = "As" Then + retType = Trim(Mid(Trim(S), 3)) + Else + retType = "Variant" + End If + If Right(retType, 1) = ")" And Right(retType, 2) <> "()" Then retType = Left(retType, Len(retType) - 1) + Res = Replace(Res, retToken, ConvertDataType(retType)) + End If + + Res = Res & fName + Res = Res & "(" + hArgs = False + Do + If Trim(fArgs) = "" Then Exit Do + tArg = nextBy(fArgs, ",") + fArgs = LTrim(Mid(fArgs, Len(tArg) + 2)) + + Res = Res & IIf(hArgs, ", ", "") + If LMatch(tArg, "ParamArray") Then Res = Res & "params ": tArg = "ByVal " & Trim(Mid(tArg, 12)) + Res = Res & ConvertParameter(tArg) + hArgs = True + Loop Until Len(fArgs) = 0 + + Res = Res & ") {" + If retType <> "" Then + returnVariable = fName + Res = Res & vbCrLf & sSpace(SpIndent) & ConvertDataType(retType) & " " & returnVariable & " = " & ConvertDefaultDefault(retType) & ";" + SubParamDecl returnVariable, retType, False, False, True + End If + + If IsEvent(asName) Then Res = EventStub(asName) & Res + ConvertPrototype = Trim(Res) +End Function + +Public Function ConvertCondition(ByVal S As String) As String + ConvertCondition = "(" & S & ")" +End Function + +Public Function ConvertElement(ByVal S As String) As String +'Debug.Print "ConvertElement: " & S +'If IsInStr(S, "frmSetup") Then Stop +'If IsInStr(S, "chkShowBalance.Value") Then Stop +'If IsInStr(S, "optTelephone") Then Stop + Dim FirstToken As String, FirstWord As String + Dim T As String, Complete As Boolean + S = Trim(S) + If S = "" Then Exit Function + +'If IsInStr(S, "Debug.Print") Then Stop + If Left(Trim(S), 2) = "&H" Then + ConvertElement = "0x" & Mid(Trim(S), 3) + Exit Function + End If + + If IsNumeric(Trim(S)) Then + ConvertElement = Val(S) + If IsInStr(S, ".") Then ConvertElement = ConvertElement & "m" + Exit Function + End If + + Dim vMax As Long + Do While RegExTest(S, "#[0-9]+/[0-9]+/[0-9]+#") + Dim dStr As String + dStr = RegExNMatch(S, "#[0-9]+/[0-9]+/[0-9]+#", 0) + S = Replace(S, dStr, "DateValue(""" & Mid(dStr, 2, Len(dStr) - 2) & """)") + vMax = vMax + 1 + If vMax > 10 Then Exit Do + Loop + +'If IsInStr(S, "RS!") Then Stop +'If IsInStr(S, ".SetValueDisplay Row") Then Stop +'If IsInStr(S, "cmdSaleTotals.Move") Then Stop +'If IsInStr(S, "2830") Then Stop +'If IsInStr(S, "True") Then Stop +'If IsInStr(S, ":=") Then Stop +'If IsInStr(S, "GetRecordNotFound") Then Stop +'If IsInStr(S, "Nonretro_14day") Then Stop +'If IsInStr(S, "Git") Then Stop +'If IsInStr(S, "GitFolder") Then Stop +'If IsInStr(S, "Array") Then Stop + + S = RegExReplace(S, patNotToken & patToken & "!" & patToken & patNotToken, "$1$2(""$3"")$4") ' RS!Field -> RS("Field") + S = RegExReplace(S, "^" & patToken & "!" & patToken & patNotToken, "$1(""$2"")$3") ' RS!Field -> RS("Field") + + S = RegExReplace(S, "([^a-zA-Z0-9_.])NullDate([^a-zA-Z0-9_.])", "$1NullDate()$2") + + S = ConvertVb6Specific(S, Complete) + If Complete Then ConvertElement = S: Exit Function + + If RegExTest(Trim(S), "^" & patToken & "$") Then +' If S = "SqFt" Then Stop + If IsFuncRef(Trim(S)) And S <> CurrSub Then + ConvertElement = Trim(S) & "()" + Exit Function + ElseIf IsPrivateFuncRef(CurrentModule, Trim(S)) And S <> CurrSub Then + ConvertElement = Trim(S) & "()" + Exit Function + ElseIf IsEnumRef(Trim(S)) Then + ConvertElement = EnumRefRepl(Trim(S)) + Exit Function + End If + End If + + If RegExTest(Trim(S), "^" & patTokenDot & "$") And StrCnt(S, ".") = 1 Then +' If S = "SqFt" Then Stop + Dim First As String, Second As String + First = SplitWord(S, 1, ".") + Second = SplitWord(S, 2, ".") + If IsModuleRef(First) And IsFuncRef(Second) Then + If IsFuncRef(Trim(Second)) And S <> CurrSub Then + ConvertElement = Trim(S) & "()" + Exit Function + ElseIf IsEnumRef(Trim(S)) Then + ConvertElement = EnumRefRepl(Trim(S)) + Exit Function + End If + End If + End If + +'If IsInStr(S, "Not optTagIncoming") Then Stop + If IsControlRef(Trim(S), FormName) Then +'If IsInStr(S, "optTagIncoming") Then Stop + S = FormControlRepl(S, FormName) + ElseIf LMatch(Trim(S), "Not ") And IsControlRef(Mid(Trim(S), 5), FormName) Then + S = "!(" & FormControlRepl(Mid(Trim(S), 5), FormName) & ")" + End If + + If IsFormRef(Trim(S)) Then + ConvertElement = FormRefRepl(Trim(S)) + Exit Function + End If + + + FirstToken = RegExNMatch(S, patTokenDot, 0) + FirstWord = SplitWord(S, 1) + If FirstWord = "Not" Then + S = "!" & ConvertValue(Mid(S, 5)) + FirstWord = SplitWord(Mid(S, 2)) + End If + If S = FirstWord Then ConvertElement = S: GoTo ManageFunctions + If S = FirstToken Then ConvertElement = S & "()": GoTo ManageFunctions + + If FirstToken = FirstWord And Not isOperator(SplitWord(S, 2)) Then ' Sub without parenthesis + ConvertElement = FirstWord & "(" & SplitWord(S, 2, , , True) & ")" + Else + ConvertElement = S + End If + +ManageFunctions: +'If IsInStr(ConvertElement, "New_CDbTypeAhead") Then Stop + If RegExTest(ConvertElement, "(\!)?[a-zA-Z0-9_.]+[ ]*\(.*\)$") Then + If (Left(ConvertElement, 1) = "!") Then + ConvertElement = "!" & ConvertFunctionCall(Mid(ConvertElement, 2)) + Else + ConvertElement = ConvertFunctionCall(ConvertElement) + End If + End If + +DoReplacements: + If IsInStr(ConvertElement, ":=") Then + Dim Ts As String + Ts = SplitWord(ConvertElement, 1, ":=") + Ts = Ts & ": " + Ts = Ts & ConvertElement(SplitWord(ConvertElement, 2, ":=", True, True)) + ConvertElement = Ts + End If + + ConvertElement = Replace(ConvertElement, " & ", " + ") + ConvertElement = Replace(ConvertElement, " = ", " == ") + ConvertElement = Replace(ConvertElement, "<>", " != ") + ConvertElement = Replace(ConvertElement, " Not ", " !") + ConvertElement = Replace(ConvertElement, "(Not ", "(!") + ConvertElement = Replace(ConvertElement, " Or ", " || ") + ConvertElement = Replace(ConvertElement, " And ", " && ") + ConvertElement = Replace(ConvertElement, " Mod ", " % ") + ConvertElement = Replace(ConvertElement, "Err.", "Err().") + ConvertElement = Replace(ConvertElement, "Debug.Print", "Console.WriteLine") + + ConvertElement = Replace(ConvertElement, "NullDate", "NullDate") + Do While IsInStr(ConvertElement, ", ,") + ConvertElement = Replace(ConvertElement, ", ,", ", _,") + Loop + ConvertElement = Replace(ConvertElement, "(,", "(_,") + +'If IsInStr(ConvertElement, "&H") And Right(ConvertElement, 1) = "&" Then Stop +'If IsInStr(ConvertElement, "1/1/2001") Then Stop + + ConvertElement = RegExReplace(ConvertElement, "([0-9])#", "$1") + + If Left(ConvertElement, 2) = "&H" Then + ConvertElement = "0x" & Mid(ConvertElement, 3) + If Right(ConvertElement, 1) = "&" Then ConvertElement = Left(ConvertElement, Len(ConvertElement) - 1) + End If + + If WithLevel > 0 Then + T = Stack(WithVars, , True) + ConvertElement = Trim(RegExReplace(ConvertElement, "([ (])(\.)" & patToken, "$1" & T & "$2$3")) + If Left(ConvertElement, 1) = "." Then ConvertElement = T & ConvertElement + End If +End Function + +Public Function ConvertFunctionCall(ByVal fCall As String) As String + Dim I As Long, N As Long, TB As String, Ts As String, TName As String + Dim TV As String + Dim vP As Variable +'Debug.Print "ConvertFunctionCall: " & fCall + + TB = "" + TName = RegExNMatch(fCall, "^[a-zA-Z0-9_.]*") + TB = TB & TName + + Ts = Mid(fCall, Len(TName) + 2) + Ts = Left(Ts, Len(Ts) - 1) + + vP = SubParam(TName) + If ConvertDataType(vP.asType) = "Recordset" Then + TB = TB & ".Fields[" + TB = TB & ConvertValue(Ts) + TB = TB & "].Value" + ElseIf vP.AsArray <> "" Then + TB = TB & "[" + TB = TB & ConvertValue(Ts) + TB = TB & "]" +' TB = Replace(TB, ", ", "][") + Else + N = nextByPCt(Ts, ",") + TB = TB & "(" + For I = 1 To N + If I <> 1 Then TB = TB & ", " + TV = nextByP(Ts, ",", I) + If IsFuncRef(TName) Then + If Trim(TV) = "" Then + TB = TB & ConvertElement(FuncRefArgDefault(TName, I)) + Else + If FuncRefArgByRef(TName, I) Then TB = TB & "ref " + TB = TB & ConvertValue(TV) + End If + Else + TB = TB & ConvertValue(TV) + End If + Next + TB = TB & ")" + End If + ConvertFunctionCall = TB +End Function + + +Public Function ConvertValue(ByVal S As String) As String + Dim F As String, Op As String, OpN As String + Dim O As String + O = "" + S = Trim(S) + If S = "" Then Exit Function + +'If IsInStr(S, "GetMaxFieldValue") Then Stop +'If IsInStr(S, "DBAccessGeneral") Then Stop +'If IsInStr(S, "tallable") Then Stop +'If Left(S, 3) = "RS(" Then Stop +'If Left(S, 6) = "DBName" Then Stop +'If Left(S, 6) = "fName" Then Stop + + SubParamUsedList TokenList(S) + + If RegExTest(S, "^-[a-zA-Z0-9_]") Then + ConvertValue = "-" & ConvertValue(Mid(S, 2)) + Exit Function + End If + + Do While True + F = NextByOp(S, 1, Op) + If F = "" Then Exit Do + Select Case Trim(Op) + Case "\": OpN = "/" + Case "=": OpN = " == " + Case "<>": OpN = " != " + Case "&": OpN = " + " + Case "Mod": OpN = " % " + Case "Is": OpN = " == " + Case "Like": OpN = " == " + Case "And": OpN = " && " + Case "Or": OpN = " || " + Case Else: OpN = Op + End Select + + + If Left(F, 1) = "(" And Right(F, 1) = ")" Then + O = O & "(" & ConvertValue(Mid(F, 2, Len(F) - 2)) & ")" & OpN + Else + O = O & ConvertElement(F) & OpN + End If + + If Op = "" Then Exit Do + S = Mid(S, Len(F) + Len(Op) + 1) + If S = "" Or Op = "" Then Exit Do + Loop + ConvertValue = O +End Function + +Public Function ConvertGlobals(ByVal Str As String, Optional ByVal AsModule As Boolean = False) As String + Dim Res As String + Dim S() As String, L As Variant, O As String + Dim Ind As Long + Dim Building As String + Dim inCase As Long + Dim returnVariable As String + Dim N As Long + + Res = "" + Building = "" + Str = Replace(Str, vbLf, "") + S = Split(Str, vbCr) + Ind = 0 + N = 0 +' Prg 0, UBound(S) - LBound(S) + 1, "Globals..." + InitDeString + For Each L In S + L = DeComment(L) + L = DeString(L) + O = "" + If Building <> "" Then + Building = Building & vbCrLf & L + If tLeft(L, 8) = "End Type" Then + O = ConvertType(Building) + Building = "" + ElseIf tLeft(L, 8) = "End Enum" Then + O = ConvertEnum(Building) + Building = "" + End If + ElseIf L Like "Option *" Then + O = "// " & L + ElseIf RegExTest(L, "^(Public |Private |)Declare ") Then + O = ConvertAPIDef(L) + ElseIf RegExTest(L, "^(Global |Public |Private |)Const ") Then + O = ConvertConstant(L, True) + ElseIf RegExTest(L, "^(Public |Private |)Event ") Then + O = ConvertEvent(L) + ElseIf RegExTest(L, "^(Public |Private |)Enum ") Then + Building = L + ElseIf RegExTest(LTrim(L), "^(Public |Private |)Type ") Then + Building = L + ElseIf tLeft(L, 8) = "Private " Or tLeft(L, 7) = "Public " Or tLeft(L, 4) = "Dim " Then + O = ConvertDeclare(L, 0, True, AsModule) + End If + + O = ReComment(O) + Res = Res & ReComment(O) & IIf(O = "" Or Right(O, 2) = vbCrLf, "", vbCrLf) + N = N + 1 +' Prg N +' If N Mod 10000 = 0 Then Stop + Next +' Prg + + Res = ReString(Res, True) + ConvertGlobals = Res +End Function + +Public Function ConvertCodeLine(ByVal S As String) As String + Dim T As Long, A As String, B As String + Dim P As String, V As Variable + Dim FirstWord As String, Rest As String + Dim N As Long + +'If IsInStr(S, "dbClose") Then Stop +'If IsInStr(S, "Nothing") Then Stop +'If IsInStr(S, "Close ") Then Stop +'If IsInStr(S, "& functionType & fieldInfo &") Then Stop +'If IsInStr(S, " & vbCrLf2 & Res)") Then Stop +'If IsInStr(S, "Res = CompareSI(SI1, SI2)") Then Stop +'If IsInStr(S, "frmPrintPreviewDocument") Then Stop +'If IsInStr(S, "NewAudit.Name1") Then Stop +'If IsInStr(S, "optDelivered") Then Stop +'If IsInStr(S, " Is Nothing Then") Then Stop +'If IsInStr(S, "SqFt, SqYd") Then Stop +'If IsInStr(S, "optTagIncoming") Then Stop +'If IsInStr(S, "Kill modAshleyItemAlign") Then Stop +'If IsInStr(S, "PRFolder") Then Stop +'If IsInStr(S, "Array()") Then Stop +'If IsInStr(S, "App.Path") Then Stop + + If Trim(S) = "" Then ConvertCodeLine = "": Exit Function + Dim Complete As Boolean + S = ConvertVb6Specific(S, Complete) + If Complete Then + ConvertCodeLine = S + Exit Function + End If + + If RegExTest(Trim(S), "^[a-zA-Z0-9_.()]+ \= ") Or RegExTest(Trim(S), "^Set [a-zA-Z0-9_.()]+ \= ") Then ' Assignment + T = InStr(S, "=") + A = Trim(Left(S, T - 1)) + If tLeft(A, 4) = "Set " Then A = Trim(Mid(A, 5)) + SubParamAssign RegExNMatch(A, patToken) + If RegExTest(A, "^" & patToken & "\(""[^""]+""\)") Then + P = RegExNMatch(A, "^" & patToken) + V = SubParam(P) + If V.Name = P Then + SubParamAssign P + Select Case V.asType + Case "Recordset", "ADODB.Recordset" + ConvertCodeLine = RegExReplace(A, "^" & patToken & "(\("")([^""]+)(""\))", "$1.Fields[""$3""].Value") + Case Else + If Left(A, 1) = "." Then A = Stack(WithVars, , True) & A + ConvertCodeLine = A + End Select + End If + Else + If Left(A, 1) = "." Then A = Stack(WithVars, , True) & A + ConvertCodeLine = A + End If + + Dim tAWord As String + tAWord = SplitWord(A, 1, ".") + If IsFormRef(tAWord) Then + A = Replace(A, tAWord, tAWord & ".instance", , 1) + End If + + ConvertCodeLine = ConvertValue(ConvertCodeLine) & " = " + + B = ConvertValue(Trim(Mid(S, T + 1))) + ConvertCodeLine = ConvertCodeLine & B + Else +'Debug.Print S +'If IsInStr(S, "Call ") Then Stop + If LMatch(LTrim(S), "Call ") Then S = Mid(LTrim(S), 6) + + FirstWord = SplitWord(Trim(S)) + Rest = SplitWord(Trim(S), 2, , , True) + If Rest = "" Then + ConvertCodeLine = S & IIf(Right(S, 1) <> ")", "()", "") + ConvertCodeLine = ConvertElement(ConvertCodeLine) + ElseIf FirstWord = "RaiseEvent" Then + ConvertCodeLine = ConvertValue(S) + ElseIf FirstWord = "Debug.Print" Then + ConvertCodeLine = "Console.WriteLine(" & ConvertValue(Rest) & ")" + ElseIf StrQCnt(FirstWord, "(") = 0 Then + ConvertCodeLine = "" + ConvertCodeLine = ConvertCodeLine & FirstWord & "(" + N = 0 + Do + N = N + 1 + B = nextByP(Rest, ", ", N) + If B = "" Then Exit Do + ConvertCodeLine = ConvertCodeLine & IIf(N = 1, "", ", ") & ConvertValue(B) + Loop While True + ConvertCodeLine = ConvertCodeLine & ")" +' ConvertCodeLine = ConvertElement(ConvertCodeLine) + Else + ConvertCodeLine = ConvertValue(S) + End If + If WithLevel > 0 And Left(Trim(ConvertCodeLine), 1) = "." Then ConvertCodeLine = Stack(WithVars, , True) & Trim(ConvertCodeLine) + End If + +' If IsInStr(ConvertCodeLine, ",,,,,,,") Then Stop + + ConvertCodeLine = ConvertCodeLine & ";" +'Debug.Print ConvertCodeLine +End Function + +Public Function PostConvertCodeLine(ByVal Str As String) As String + Dim S As String + S = Str + +' If IsInStr(S, "optPoNo") Then Stop + + If IsInStr(S, "0 &") Then S = Replace(S, "0 &", "0") + If IsInStr(S, ".instance.instance") Then S = Replace(S, ".instance.instance", ".instance") + If IsInStr(S, ".IsChecked)") Then S = Replace(S, ".IsChecked)", ".IsChecked == true)", 1) + If IsInStr(S, ".IsChecked &") Then S = Replace(S, ".IsChecked", ".IsChecked == true", 1) + If IsInStr(S, ".IsChecked |") Then S = Replace(S, ".IsChecked", ".IsChecked == true", 1) + If IsInStr(S, ".IsChecked,") Then S = Replace(S, ".IsChecked", ".IsChecked == true", 1) + If IsInStr(S, ".IsChecked == 1,") Then S = Replace(S, ".IsChecked == 1", ".IsChecked == true", 1) + If IsInStr(S, ".IsChecked == 0,") Then S = Replace(S, ".IsChecked == 1", ".IsChecked == false", 1) + + If IsInStr(S, ".Visibility = true") Then S = Replace(S, ".Visibility = true", ".setVisible(true)") + If IsInStr(S, ".Visibility = false") Then S = Replace(S, ".Visibility = false", ".setVisible(false)") + + If IsInStr(S, ".Print(") Then + If IsInStr(S, ";);") Then + S = Replace(S, ";);", ");") + S = Replace(S, "Print(", "PrintNNL(") + End If + S = Replace(S, "; ", ", ") + End If + If IsInStr(S, ".Line((") Then + S = Replace(S, ") - (", ", ") + S = Replace(S, "Line((", "Line(") + S = Replace(S, "));", ");") + End If + + S = Replace(S, "vbRetryCancel +", "vbRetryCancel |") + S = Replace(S, "vbOkOnly +", "vbOkOnly |") + S = Replace(S, "vbOkCancel +", "vbOkCancel |") + S = Replace(S, "vbExclamation +", "vbExclamation |") + S = Replace(S, "vbYesNo +", "vbYesNo |") + S = Replace(S, "vbQuestion +", "vbQuestion |") + S = Replace(S, "vbOKCancel +", "vbOKCancel |") + S = Replace(S, "+ vbExclamation", "| vbExclamation") + + PostConvertCodeLine = S +End Function + +Public Function ConvertSub(ByVal Str As String, Optional ByVal AsModule As Boolean = False, Optional ByVal ScanFirst As VbTriState = vbUseDefault) As String + Dim oStr As String + Dim Res As String + Dim S() As String, L As Variant, O As String, T As String, U As String, V As String + Dim CM As Long, cN As Long + Dim K As Long + Dim Ind As Long + Dim inCase As Long + Dim returnVariable As String + +' If IsInStr(Str, "Dim oFTP As New FTP") Then Stop +' If IsInStr(Str, "cHolding") Then Stop +'If IsInStr(Str, "IsIDE") Then Stop + + + Select Case ScanFirst + Case vbUseDefault: + oStr = Str + ConvertSub oStr, AsModule, vbTrue +' If IsInStr(Str, "StoreStockToolTipText") Then Stop + ConvertSub = ConvertSub(oStr, AsModule, vbFalse) + Exit Function + Case vbTrue: SubBegin + Case vbFalse: SubBegin True + End Select + + + + Res = "" + Str = Replace(Str, vbLf, "") + S = Split(Str, vbCr) + Ind = 0 + +'If IsInStr(Str, " WinCDSDataPath(") Then Stop +'If IsInStr(Str, " RunShellExecute(") Then Stop +'If IsInStr(Str, " ValidateSI(") Then Stop + For Each L In S +'If IsInStr(L, "OrdVoid") Then Stop +'If IsInStr(L, "MsgBox") Then Stop +'If IsInStr(L, "And Not IsDoddsLtd Then") Then Stop + L = DeComment(L) + L = DeString(L) + O = "" + +'If IsInStr(L, "1/1/2001") Then Stop +'If ScanFirst = vbFalse Then Stop +'If IsInStr(L, "Public Function GetFileAutonumber") Then Stop +'If IsInStr(L, "GetCustomerBalance") Then Stop +'If IsInStr(L, "IsIDE") Then Stop + + + Dim PP As String, PQ As String + PP = "^(Public |Private |)(Friend |)(Function |Sub )" & patToken & "[ ]*\(" + PQ = "^(Public |Private )(Property )(Get |Let |Set )" & patToken & "[ ]*\(" + If RegExNMatch(L, PP) <> "" Then + Dim nK As Long +' CurrSub = nextBy(L, "(", 1) +' If (LMatch(CurrSub, "Public ")) Then CurrSub = Mid(CurrSub, 8) +' If (LMatch(CurrSub, "Private ")) Then CurrSub = Mid(CurrSub, 9) +' If (LMatch(CurrSub, "Friend ")) Then CurrSub = Mid(CurrSub, 8) +' If (LMatch(CurrSub, "Function ")) Then CurrSub = Mid(CurrSub, 10) +' If (LMatch(CurrSub, "Sub ")) Then CurrSub = Mid(CurrSub, 5) +'If IsInStr(L, "Public Function IsIn") Then Stop + O = O & sSpace(Ind) & ConvertPrototype(L, returnVariable, AsModule, CurrSub) + Ind = Ind + SpIndent + ElseIf RegExNMatch(L, PQ) <> "" Then +' If IsInStr(L, "edi888_Admin888_Src") Then Stop + AddProperty Str + Exit Function ' repacked later... not added here. + ElseIf tLMatch(L, "End Sub") Or tLMatch(L, "End Function") Then + If returnVariable <> "" Then + O = O & sSpace(Ind) & "return " & returnVariable & ";" & vbCrLf + End If + Ind = Ind - SpIndent + O = O & sSpace(Ind) & "}" + ElseIf tLMatch(L, "Exit Function") Or tLMatch(L, "Exit Sub") Then + If returnVariable <> "" Then + O = O & sSpace(Ind) & "return " & returnVariable & ";" & vbCrLf + Else + O = O & "return;" & vbCrLf + End If + ElseIf tLMatch(L, "GoTo ") Then + O = O & "goto " & SplitWord(Trim(L), 2) & ";" + ElseIf RegExTest(Trim(L), "^[a-zA-Z_][a-zA-Z_0-9]*:$") Then ' Goto Label + O = O & L & ";" ' c# requires a trailing ; on goto labels without trailing statements. Likely a C# bug/oversight, but it's there. + ElseIf tLeft(L, 3) = "Dim" Then + O = ConvertDeclare(L, Ind) + ElseIf tLeft(L, 5) = "Const" Then + O = sSpace(Ind) & ConvertConstant(L, False) + ElseIf tLeft(L, 3) = "If " Then ' Code sanitization prevents all single-line ifs. +'If IsInStr(L, "optDelivered") Then Stop +'If IsInStr(L, "PRFolder") Then Stop + T = Mid(Trim(L), 4, Len(Trim(L)) - 8) + O = sSpace(Ind) & "if (" & ConvertValue(T) & ") {" + Ind = Ind + SpIndent + ElseIf tLeft(L, 7) = "ElseIf " Then + T = tMid(L, 8) + If Right(Trim(L), 5) = " Then" Then T = Left(T, Len(T) - 5) + O = sSpace(Ind - SpIndent) & "} else if (" & ConvertValue(T) & ") {" + ElseIf tLeft(L, 5) = "Else" Then + O = sSpace(Ind - SpIndent) & "} else {" + ElseIf tLeft(L, 6) = "End If" Then + Ind = Ind - SpIndent + O = sSpace(Ind) & "}" + ElseIf tLeft(L, 12) = "Select Case " Then + O = O & sSpace(Ind) & "switch(" & ConvertValue(tMid(L, 13)) & ") {" + Ind = Ind + SpIndent + ElseIf tLeft(L, 10) = "End Select" Then + If inCase > 0 Then Ind = Ind - SpIndent: inCase = inCase - 1 + Ind = Ind - SpIndent + O = O & "break;" & vbCrLf + O = O & "}" + ElseIf tLeft(L, 9) = "Case Else" Then + If inCase > 0 Then O = O & sSpace(Ind) & "break;" & vbCrLf: Ind = Ind - SpIndent: inCase = inCase - 1 + O = O & sSpace(Ind) & "default:" + inCase = inCase + 1 + Ind = Ind + SpIndent + ElseIf tLeft(L, 5) = "Case " Then + T = Mid(Res, InStrRev(Res, "switch(")) + If RegExTest(T, "case [^:]+:") Then O = O & sSpace(Ind) & "break;" & vbCrLf: Ind = Ind - SpIndent: inCase = inCase - 1 + T = tMid(L, 6) + If tLeft(T, 5) = "Like " Or tLeft(T, 3) = "Is " Or T Like "* = *" Then + O = O & "// TODO: Cannot convert case: " & T & vbCrLf + O = O & sSpace(Ind) & "case 0: " + ElseIf nextBy(T, ",", 2) <> "" Then + O = O & sSpace(Ind) + Do + U = nextBy(T, ", ") + If U = "" Then Exit Do + T = Trim(Mid(T, Len(U) + 1)) + O = O & "case " & ConvertValue(U) & ": " + Loop While True + ElseIf T Like "* To *" Then + O = O & "// CONVERSION: Case was " & T & vbCrLf + O = O & sSpace(Ind) + cN = Val(SplitWord(T, 1, " To ")) + CM = Val(SplitWord(T, 2, " To ")) + For K = cN To CM + O = O & "case " & K & ": " + Next + Else + Dim TT As Variant, LL As Variant +' O = O & sSpace(Ind) & "case " & ConvertValue(T) & ":" + O = O & Space(Ind) + For Each LL In Split(T, ",") + O = O & "case " & ConvertValue(T) & ": " + Next + End If + inCase = inCase + 1 + Ind = Ind + SpIndent + ElseIf Trim(L) = "Do" Then + O = O & sSpace(Ind) & "do {" + Ind = Ind + SpIndent + ElseIf tLeft(L, 9) = "Do While " Then + O = O & sSpace(Ind) & "while(" & ConvertValue(tMid(L, 10)) & ") {" + Ind = Ind + SpIndent + ElseIf tLeft(L, 9) = "Do Until " Then + O = O & sSpace(Ind) & "while(!(" & ConvertValue(tMid(L, 10)) & ")) {" + Ind = Ind + SpIndent + ElseIf tLeft(L, 9) = "For Each " Then + L = tMid(L, 10) + Dim iterVar As String + iterVar = SplitWord(L, 1, " In ") + O = O & sSpace(Ind) & "foreach(var iter" & iterVar & " in " & SplitWord(L, 2, " In ") & ") {" & vbCrLf & iterVar & " = iter" & iterVar & ";" + Ind = Ind + SpIndent + ElseIf tLeft(L, 4) = "For " Then + Dim forKey As String, forStr As String, forEnd As String + L = tMid(L, 5) + forKey = SplitWord(L, 1, "=") + L = SplitWord(L, 2, "=") + forStr = SplitWord(L, 1, " To ") + forEnd = SplitWord(L, 2, " To ") + O = O & sSpace(Ind) & "for(" & ConvertElement(forKey) & "=" & ConvertElement(forStr) & "; " & ConvertElement(forKey) & "<" & ConvertElement(forEnd) & "; " & ConvertElement(forKey) & "++) {" + Ind = Ind + SpIndent + ElseIf tLeft(L, 11) = "Loop While " Then + Ind = Ind - SpIndent + O = O & sSpace(Ind) & "} while(!(" & ConvertValue(tMid(L, 12)) & "));" + ElseIf tLeft(L, 11) = "Loop Until " Then + Ind = Ind - SpIndent + O = O & sSpace(Ind) & "} while(!(" & ConvertValue(tMid(L, 12)) & "));" + ElseIf tLeft(L, 5) = "Loop" Then + Ind = Ind - SpIndent + O = O & sSpace(Ind) & "}" + ElseIf tLeft(L, 8) = "Exit For" Or tLeft(L, 7) = "Exit Do" Or tLeft(L, 10) = "Exit While" Then + O = O & sSpace(Ind) & "break;" + ElseIf tLeft(L, 5) = "Next" Then + Ind = Ind - SpIndent + O = sSpace(Ind) & "}" + ElseIf tLeft(L, 5) = "With " Then + WithLevel = WithLevel + 1 + + T = ConvertValue(tMid(L, 6)) + U = ConvertDataType(SubParam(T).asType) + V = WithMark & IIf(SubParam(T).Name <> "", T, Random) + If U = "" Then U = DefaultDataType + + Stack WithAssign, T + Stack WithTypes, U + Stack WithVars, V + + O = O & sSpace(Ind) & U & " " & V & ";" & vbCrLf + MaxWithLevel = MaxWithLevel + 1 + O = O & sSpace(Ind) & V & " = " & T & ";" + Ind = Ind + SpIndent + ElseIf tLeft(L, 8) = "End With" Then + WithLevel = WithLevel - 1 + T = Stack(WithAssign) + U = Stack(WithTypes) + V = Stack(WithVars) + If SubParam(T).Name <> "" Then + O = O & sSpace(Ind) & T & " = " & V & ";" + End If + Ind = Ind - SpIndent + ElseIf IsInStr(L, "On Error ") Or IsInStr(L, "Resume ") Then + O = sSpace(Ind) & "// TODO (not supported): " & L + Else +'If IsInStr(L, "ComputeAgeing dtpArrearControlDate") Then Stop +'If IsInStr(L, "RaiseEvent") Then Stop +'If IsInStr(L, "Debug.Print") Then Stop +'If IsInStr(L, "HasGit") Then Stop + O = sSpace(Ind) & ConvertCodeLine(L) + End If + + O = modOrigConvert.PostConvertCodeLine(O) + O = modProjectSpecific.ProjectSpecificPostCodeLineConvert(O) + + O = ReComment(O) + Res = Res & ReComment(O) & IIf(O = "", "", vbCrLf) + Next + + ConvertSub = Res +End Function + diff --git a/modQuickConvert.bas b/modQuickConvert.bas new file mode 100644 index 0000000..e11db25 --- /dev/null +++ b/modQuickConvert.bas @@ -0,0 +1,1357 @@ +Attribute VB_Name = "modQuickConvert" +Option Explicit + +Private Const Idnt As Long = 2 +Private Const Attr As String = "Attribute" +Private Const Q As String = """" +Private Const A As String = "'" +Private Const S As String = " " + +Private Const STRING_TOKEN_PREFIX As String = "__S" +Private Const EXPRESSION_TOKEN_PREFIX As String = "__E_" + +Private LineStrings() As String, LineStringsCount As Long +Private LineComment As String +Private InProperty As Boolean +Private CurrentTypeName As String +Private CurrentEnumName As String +Private CurrentFunctionName As String +Private CurrentFunctionReturnValue As String +Private CurrentFunctionArgs As String +Private CurrentFunctionArrays As String +Private ModuleName As String +Private ModuleFunctions As String +Private ModuleArrays As String +Private ModuleProperties As String + +Public Enum DeclarationType + DECL_GLOBAL = 99 + DECL_SIGNATURE = 98 + DECL_LOCAL = 1 + DECL_TYPE + DECL_ENUM + DECL_EXTERN = 101 +End Enum + +Public Enum CodeType + CODE_MODULE + CODE_CLASS + CODE_FORM + CODE_CONTROL +End Enum + +Public Type RandomType + J As Long + W As String + X As String * 5 +End Type + +Private Function ResolveSources(ByVal FileName As String) As String + If FileName = "" Then FileName = "prj.vbp" + If FileName = "forms" Then + ResolveSources = VBPForms(True) + ElseIf FileName = "modules" Then + ResolveSources = VBPModules + ElseIf FileName = "classes" Then + ResolveSources = VBPClasses + ElseIf FileName = "usercontrols" Then + ResolveSources = VBPUserControls + Else + If InStr(FileName, "\") = 0 Then FileName = App.Path & "\" & FileName + ResolveSources = IIf(Right(FileName, 4) = ".vbp", VBPCode(FileName), FileName) + End If +End Function + +Public Function Convert(Optional ByVal FileName As String = "") As String + Dim FileList As String + FileList = ResolveSources(FileName) + Convert = QuickConvertFiles(FileList) +End Function + +Public Function QuickConvertFiles(ByVal List As String) As String + Const lintDotsPerRow As Long = 50 + Dim L As Variant + Dim X As Long + Dim StartTime As Date + StartTime = Now + + For Each L In Split(List, vbCrLf) + Dim Result As String + Result = QuickConvertFile(L) + If Result <> "" Then + Dim S As String + Debug.Print vbCrLf & "Done (" & DateDiff("s", StartTime, Now) & "s). To re-run for failing file, hit enter on the line below:" + S = "LINT FAILED: " & L & vbCrLf & Result & vbCrLf & "?Lint(""" & L & """)" + QuickConvertFiles = S + Exit Function + Else + Debug.Print Switch(Right(L, 3) = "frm", "o", Right(L, 3) = "cls", "x", True, "."); + End If + X = X + 1 + If X >= lintDotsPerRow Then X = 0: Debug.Print + DoEvents + Next + Debug.Print vbCrLf & "Done (" & DateDiff("s", StartTime, Now) & "s)." + QuickConvertFiles = "" +End Function + +Public Function CodeFileType(ByVal File As String) As CodeType + Select Case Right(LCase(File), 4) + Case ".bas": CodeFileType = CODE_MODULE + Case ".frm": CodeFileType = CODE_FORM + Case ".cls": CodeFileType = CODE_CLASS + Case ".ctl": CodeFileType = CODE_CONTROL + Case Else: CodeFileType = CODE_MODULE + End Select +End Function + +Public Function QuickConvertFile(ByVal File As String) As String + ModuleArrays = "" + + If InStr(File, "\") = 0 Then File = App.Path & "\" & File + Dim fName As String, Contents As String, GivenName As String, CheckName As String + fName = Mid(File, InStrRev(File, "\") + 1) + CheckName = Replace(Replace(Replace(fName, ".bas", ""), ".cls", ""), ".frm", "") + ErrorPrefix = Right(Space(18) & fName, 18) & " " + Contents = ReadEntireFile(File) + GivenName = GetModuleName(Contents) + If LCase(CheckName) <> LCase(GivenName) Then + QuickConvertFile = "Module name [" & GivenName & "] must match file name [" & fName & "]. Rename module or class to match the other" + Exit Function + End If + QuickConvertFile = ConvertContents(Contents, CodeFileType(File)) +End Function + +Public Function GetModuleName(ByVal Contents As String) As String + GetModuleName = RegExNMatch(Contents, "Attribute VB_Name = ""([^""]+)""", 0) + GetModuleName = Replace(Replace(GetModuleName, "Attribute VB_Name = ", ""), """", "") +End Function + +Public Function I(ByVal N As Long) As String + If N <= 0 Then I = "" Else I = Space(N) +End Function + +Public Function ConvertContents(ByVal Contents As String, ByVal vCodeType As CodeType, Optional ByVal SubSegment As Boolean = False) As String + Dim Lines() As String, ActualLine As Variant, LL As String, L As String +'On Error GoTo LintError + If Not SubSegment Then + ModuleName = GetModuleName(Contents) + ModuleFunctions = GetModuleFunctions(Contents) + End If + + Lines = Split(Replace(Contents, vbCr, ""), vbLf) + + Dim InAttributes As Boolean, InBody As Boolean + InBody = SubSegment + + Dim MultiLineOrig As String, MultiLine As String, IsMultiLine As Boolean + Dim LineN As Long, Indent As Long + Dim NewContents As String + Dim SelectHasCase As Boolean + + Indent = 0 + NewContents = "" +' NewContents = UsingEverything & vbCrLf2 +' NewContents = NewContents & "static class " & ModuleName & " {" & vbCrLf + + For Each ActualLine In Lines + LL = ActualLine +' If MaxErrors > 0 And ErrorCount >= MaxErrors Then Exit For + + IsMultiLine = False + If Right(LL, 2) = " _" Then + Dim Portion As String + Portion = Left(LL, Len(LL) - 2) + MultiLineOrig = MultiLineOrig & LL & vbCrLf + If MultiLine <> "" Then Portion = " " & Trim(Portion) + MultiLine = MultiLine + Portion + LineN = LineN + 1 + GoTo NextLineWithoutRecord + ElseIf MultiLine <> "" Then + MultiLineOrig = MultiLineOrig & LL + LL = MultiLine & " " & Trim(LL) + MultiLine = "" + IsMultiLine = True + Else + MultiLineOrig = "" + End If + + L = CleanLine(LL) + + If Not InBody Then + Dim IsAttribute As Boolean + IsAttribute = StartsWith(LTrim(L), "Attribute ") + If Not InAttributes And IsAttribute Then + InAttributes = True + GoTo NextLineWithoutRecord + ElseIf InAttributes And Not IsAttribute Then + InAttributes = False + InBody = True + LineN = 0 + Else + GoTo NextLineWithoutRecord + End If + End If + + LineN = LineN + 1 +' If LineN >= 8 Then Stop + + Dim UnindentedAlready As Boolean + + If RegExTest(L, "^[ ]*(Else|ElseIf .* Then)$") Then + Indent = Indent - Idnt + UnindentedAlready = True + ElseIf RegExTest(L, "^[ ]*End Select$") Then + Indent = Indent - Idnt - Idnt + ElseIf RegExTest(L, "^[ ]*(End (If|Function|Sub|Property|Enum|Type)|Next( .*)?|Wend|Loop|Loop (While .*|Until .*)|ElseIf .*)$") Then + Indent = Indent - Idnt + UnindentedAlready = True + CurrentEnumName = "" + CurrentTypeName = "" + Else + UnindentedAlready = False + End If + + Dim NewLine As String + NewLine = "" + + If InProperty Then ' we process properties out of band to keep getters and setters together + If InStr(L, "End Property") > 0 Then InProperty = False + GoTo NextLineWithoutRecord + End If + + If CurrentTypeName <> "" Then ' if we are in a type or an enum, the entire line is parsed as such + NewLine = NewLine & ConvertTypeLine(L, vCodeType) + ElseIf CurrentEnumName <> "" Then + NewLine = NewLine & ConvertEnumLine(L) + ElseIf RegExTest(L, "^[ ]*If ") Then ' The "If" control structure, when single-line, lacks the "End If" to signal a close. + NewLine = NewLine & ConvertIf(L) + If InStr(L, " Then ") = 0 Then Indent = Indent + Idnt + ElseIf RegExTest(L, "^[ ]*ElseIf .*$") Then + NewLine = NewLine & ConvertIf(L) + If InStr(L, " Then ") = 0 Then Indent = Indent + Idnt + Else + Dim Statements() As String, SS As Variant, St As String + Statements = Split(Trim(L), ": ") + For Each SS In Statements + St = SS + + If RegExTest(St, "^[ ]*ElseIf .*$") Then + NewLine = NewLine & ConvertIf(St) + Indent = Indent + Idnt + ElseIf RegExTest(St, "^[ ]*Else$") Then + NewLine = NewLine & "} else {" + Indent = Indent + Idnt + ElseIf RegExTest(St, "^[ ]*End Function") Then + NewLine = NewLine & "return " & CurrentFunctionReturnValue & ";" & vbCrLf & "}" + CurrentFunctionName = "" + CurrentFunctionReturnValue = "" + CurrentFunctionArrays = "" + If Not UnindentedAlready Then Indent = Indent - Idnt + ElseIf RegExTest(St, "^[ ]*End Select$") Then + NewLine = NewLine & "break;" & vbCrLf + NewLine = NewLine & "}" + If Not UnindentedAlready Then Indent = Indent - Idnt + ElseIf RegExTest(St, "^[ ]*End (If|Sub|Enum|Type)$") Then + CurrentTypeName = "" + CurrentEnumName = "" + NewLine = NewLine & "}" + If Not UnindentedAlready Then Indent = Indent - Idnt + ElseIf RegExTest(St, "^[ ]*For Each") Then + Indent = Indent + Idnt + NewLine = ConvertForEach(St) + ElseIf RegExTest(St, "^[ ]*For ") Then + Indent = Indent + Idnt + NewLine = ConvertFor(St) + ElseIf RegExTest(St, "^[ ]*Next\b") Then + NewLine = NewLine & "}" + If Not UnindentedAlready Then Indent = Indent - Idnt + ElseIf RegExTest(St, "^[ ]*While ") Then + NewLine = NewLine & ConvertWhile(St) + Indent = Indent + Idnt + ElseIf RegExTest(St, "^[ ]*Wend") Then + NewLine = NewLine & "}" + If Not UnindentedAlready Then Indent = Indent - Idnt + ElseIf RegExTest(St, "^[ ]*Do (While|Until)") Then + NewLine = NewLine & ConvertWhile(St) + Indent = Indent + Idnt + ElseIf RegExTest(St, "^[ ]*Loop$") Then + NewLine = NewLine & "}" + ElseIf RegExTest(St, "^[ ]*Do$") Then + NewLine = NewLine & "do {" + Indent = Indent + Idnt + ElseIf RegExTest(St, "^[ ]*(Loop While |Loop Until )") Then + NewLine = NewLine & ConvertWhile(St) + ElseIf RegExTest(St, "^[ ]*Select Case ") Then + NewLine = NewLine & ConvertSwitch(St) + Indent = Indent + Idnt + Idnt + SelectHasCase = False + ElseIf RegExTest(St, "^[ ]*Case ") Then + NewLine = NewLine & ConvertSwitchCase(St, SelectHasCase) + SelectHasCase = True + ElseIf RegExTest(St, "^[ ]*(Private |Public )?Declare (Function |Sub )") Then + NewLine = NewLine & ConvertDeclare(St) ' External Api + ElseIf RegExTest(St, "^((Private|Public|Friend) )?Function ") Then + CurrentFunctionArgs = "" + Indent = Indent + Idnt + NewLine = NewLine & ConvertSignature(St, vCodeType) + ElseIf RegExTest(St, "^((Private|Public|Friend) )?Sub ") Then + CurrentFunctionArgs = "" + Indent = Indent + Idnt + NewLine = NewLine & ConvertSignature(St, vCodeType) + ElseIf RegExTest(St, "^((Private|Public|Friend) )?Property (Get|Let|Set) ") Then + CurrentFunctionArgs = "" + NewLine = NewLine & ConvertProperty(St, Contents, vCodeType) + InProperty = True + Indent = Indent + Idnt + ElseIf RegExTest(St, "^[ ]*(Public |Private )?Enum ") Then + NewLine = NewLine & ConvertEnum(St) + Indent = Indent + Idnt + ElseIf RegExTest(St, "^[ ]*(Public |Private )?Type ") Then + NewLine = NewLine & ConvertType(St) + Indent = Indent + Idnt + ElseIf RegExTest(St, "^[ ]*(Dim|Private|Public|Const|Global|Static) ") Then + NewLine = NewLine & ConvertDeclaration(St, IIf(CurrentFunctionName = "", DECL_GLOBAL, DECL_LOCAL), vCodeType) + Else + NewLine = NewLine & ConvertStatement(St) + End If +NextStatement: + Next + End If +NextLine: +' If IsMultiLine Then Stop +' If InStr(LL, "Function") > 0 Then Stop +' If InStr(LL, "Private Function") > 0 Then Stop +' If Indent < 0 Then Stop + NewLine = Decorate(NewLine) + If Trim(NewLine) <> "" Then + NewContents = NewContents & I(Indent) & NewLine & vbCrLf + End If +NextLineWithoutRecord: + Next +' If AutoFix <> "" Then WriteFile AutoFix, Left(NewContents, Len(NewContents) - 2), True + +' NewContents = NewContents & "}" & vbCrLf + ConvertContents = NewContents + Exit Function +LintError: + Debug.Print "Error in quick convert [" & Err.Number & "]: " & Err.Description + ConvertContents = "Error in quick convert [" & Err.Number & "]: " & Err.Description +End Function + +Private Function ReadEntireFile(ByVal tFileName As String) As String +On Error Resume Next + Dim mFSO As Object + Set mFSO = CreateObject("Scripting.FileSystemObject") + ReadEntireFile = mFSO.OpenTextFile(tFileName, 1).ReadAll + + If FileLen(tFileName) / 10 <> Len(ReadEntireFile) / 10 Then + MsgBox "ReadEntireFile was short: " & FileLen(tFileName) & " vs " & Len(ReadEntireFile) + End If +End Function + +Public Function CleanLine(ByVal Line As String) As String + Dim X As Long, Y As Long, Token As String, Value As String + + Erase LineStrings + LineStringsCount = 0 + LineComment = "" + + Do While True + X = InStr(Line, Q) + If X = 0 Then Exit Do + + Y = InStr(X + 1, Line, Q) + Do While Mid(Line, Y + 1, 1) = Q + Y = InStr(Y + 2, Line, Q) + Loop + + If Y = 0 Then Exit Do + + LineStringsCount = LineStringsCount + 1 + ReDim Preserve LineStrings(1 To LineStringsCount) + Value = ConvertStringLiteral(Mid(Line, X, Y - X + 1)) + LineStrings(LineStringsCount) = Value + Token = STRING_TOKEN_PREFIX & LineStringsCount + Line = Left(Line, X - 1) & Token & Mid(Line, Y + 1) + Loop + + X = InStr(Line, A) + If X > 0 Then + LineComment = Trim(Mid(Line, X + 1)) + Line = RTrim(Left(Line, X - 1)) + End If + + CleanLine = Line +End Function + +Public Function Decorate(ByVal Line As String) As String + Dim I As Long + For I = LineStringsCount To 1 Step -1 + Line = Replace(Line, "__S" & I, LineStrings(I)) + Next + + If LineComment <> "" Then Line = Line & " // " & LineComment + Decorate = Line +End Function + +Public Function ConvertStringLiteral(ByVal L As String) As String + L = Replace(L, "\", "\\") + L = """" & Replace(Mid(L, 2, Len(L) - 2), """""", "\""") & """" + ConvertStringLiteral = L +End Function + +Public Function StartsWith(ByVal L As String, ByVal Find As String) As Boolean + StartsWith = Left(L, Len(Find)) = Find +End Function + +Public Function StripLeft(ByVal L As String, ByVal Find As String) As String + If StartsWith(L, Find) Then StripLeft = Mid(L, Len(Find) + 1) Else StripLeft = L +End Function + +Public Function RecordLeft(ByRef L As String, ByVal Find As String) As Boolean + RecordLeft = StartsWith(L, Find) + If RecordLeft Then L = Mid(L, Len(Find) + 1) +End Function + +Public Function RemoveUntil(ByRef L As String, ByVal Find As String, Optional ByVal RemoveFind As Boolean = False) As String + Dim IX As Long + IX = InStr(L, Find) + If IX <= 0 Then Exit Function + RemoveUntil = Left(L, IX - 1) + L = Mid(L, IIf(RemoveFind, IX + Len(Find), IX)) +End Function + +Private Function GetModuleFunctions(ByVal Contents As String) As String + Const Pattern As String = "(Private (Function|Sub) [^(]+\()" + Dim N As Long, I As Long + Dim S As String + N = RegExCount(Contents, Pattern) + GetModuleFunctions = "" + For I = 0 To N - 1 + S = RegExNMatch(Contents, Pattern, I) + S = Replace(S, "Private ", "") + S = Replace(S, "Sub ", "") + S = Replace(S, "Function ", "") + S = Replace(S, "(", "") + GetModuleFunctions = GetModuleFunctions & "[" & S & "]" + Next +End Function + +Private Function IsLocalFuncRef(ByVal F As String) As Boolean + IsLocalFuncRef = InStr(ModuleFunctions, "[" & Trim(F) & "]") <> 0 +End Function + +Private Function SearchLeft(ByVal Start As Long, ByVal Src As String, ByVal Find As String, Optional ByVal NotIn As Boolean = False, Optional ByVal Reverse As Boolean = False) As Long + Dim Bg As Long, Ed As Long, St As Long + Dim I As Long, C As String, Found As Boolean + If Not Reverse Then + Bg = IIf(Start = 0, 1, Start) + Ed = Len(Src) + St = 1 + Else + Bg = IIf(Start = 0, Len(Src), Start) + Ed = 1 + St = -1 + End If + + For I = Bg To Ed Step St + C = Mid(Src, I, 1) + Found = InStr(Find, C) > 0 + If Not NotIn And Found Or NotIn And Not Found Then + SearchLeft = I + Exit Function + End If + Next + + SearchLeft = 0 +End Function + +'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +Public Function ConvertIf(ByVal L As String) As String + Dim ixThen As Long, Expression As String + Dim WithThen As Boolean, WithElse As Boolean + Dim MultiStatement As Boolean + L = Trim(L) + ixThen = InStr(L, " Then") + WithThen = InStr(L, " Then ") > 0 + WithElse = InStr(L, " Else ") > 0 + Expression = Trim(Left(L, ixThen - 1)) + Expression = StripLeft(Expression, "If ") + Expression = StripLeft(Expression, "ElseIf ") + + ConvertIf = IIf(IsInStr(L, "ElseIf") = 0, "if", "} else if") + ConvertIf = ConvertIf & "(" & ConvertExpression(Expression) & ")" + + If Not WithThen Then + ConvertIf = ConvertIf & " {" + Else + Dim cThen As String, cElse As String + cThen = Trim(Mid(L, ixThen + 5)) + Dim ixElse As Long + ixElse = InStr(cThen, " Else ") + If ixElse > 0 Then + cElse = Mid(cThen, ixElse + 6) + cThen = Left(cThen, ixElse - 1) + Else + cElse = "" + End If + + ' Inline Then + Dim St As Variant + MultiStatement = InStr(cThen, ": ") > 0 + If MultiStatement Then + ConvertIf = ConvertIf & " { " + For Each St In Split(cThen, ": ") + ConvertIf = ConvertIf & ConvertStatement(St) & " " + Next + ConvertIf = ConvertIf & "}" + Else + ConvertIf = ConvertIf & ConvertStatement(cThen) + End If + + ' Inline Then ... Else + If ixElse > 0 Then + MultiStatement = InStr(cElse, ":") > 0 + If MultiStatement Then + ConvertIf = ConvertIf & " { " + For Each St In Split(cElse, ":") + ConvertIf = ConvertIf & ConvertStatement(Trim(St)) + Next + ConvertIf = ConvertIf & " }" + Else + ConvertIf = ConvertIf & ConvertStatement(cElse) + End If + End If + End If + +End Function + +Public Function ConvertSwitch(ByVal L As String) As String + ConvertSwitch = "switch(" & ConvertExpression(Trim(Replace(L, "Select Case ", ""))) & ") {" +End Function + +Public Function ConvertSwitchCase(ByVal L As String, ByVal SelectHasCase As Boolean) As String + Dim V As Variant + ConvertSwitchCase = "" + If SelectHasCase Then ConvertSwitchCase = ConvertSwitchCase & "break;" & vbCrLf + If Trim(L) = "Case Else" Then + ConvertSwitchCase = ConvertSwitchCase & "default: " + Else + RecordLeft L, "Case " + If Right(L, 1) = ":" Then L = Left(L, Len(L) - 1) + For Each V In Split(L, ", ") + V = Trim(V) + If InStr(V, " To ") > 0 Then + ConvertSwitchCase = ConvertSwitchCase & "default: /* TODO: Cannot Convert Ranged Case: " & L & " */" + ElseIf StartsWith(V, "Is ") Then + ConvertSwitchCase = ConvertSwitchCase & "default: /* TODO: Cannot Convert Expression Case: " & L & " */" + Else + ConvertSwitchCase = ConvertSwitchCase & "case " & ConvertExpression(V) & ": " + End If + Next + End If +End Function + +Public Function ConvertWhile(ByVal L As String) As String + Dim Exp As String, Closing As Boolean, Invert As Boolean + L = LTrim(L) + If RecordLeft(L, "Do While ") Then + Exp = L + ElseIf RecordLeft(L, "Do Until ") Then + Exp = L + Invert = True + ElseIf RecordLeft(L, "While ") Then + Exp = L + ElseIf RecordLeft(L, "Loop While ") Then + Exp = L + Closing = True + ElseIf RecordLeft(L, "Loop Until ") Then + Exp = L + Closing = True + Invert = True + End If + + ConvertWhile = "" + If Closing Then ConvertWhile = ConvertWhile & "} " + ConvertWhile = ConvertWhile & "while(" + If Invert Then ConvertWhile = ConvertWhile & "!(" + ConvertWhile = ConvertWhile & ConvertExpression(Exp) + If Invert Then ConvertWhile = ConvertWhile & ")" + ConvertWhile = ConvertWhile & ")" + If Not Closing Then ConvertWhile = ConvertWhile & " {" Else ConvertWhile = ConvertWhile & ";" +End Function + +Public Function ConvertFor(ByVal L As String) As String + Dim Var As String, ForFrom As String, ForTo As String, ForStep As String + Dim ForReverse As Boolean, ForCheck As String + L = Trim(L) + RecordLeft L, "For " + + Var = RemoveUntil(L, " = ", True) + ForFrom = RemoveUntil(L, " To ", True) + ForTo = L + + ForStep = RemoveUntil(ForTo, " Step ", True) + If ForStep = "" Then ForStep = "1" + + ForStep = ConvertExpression(ForStep) + ForReverse = InStr(ForStep, "-") > 0 + If ForReverse Then ForCheck = " >= " Else ForCheck = " <= " + + ConvertFor = "" + ConvertFor = ConvertFor & "for (" + ConvertFor = ConvertFor & ExpandToken(Var) & " = " & ConvertExpression(ForFrom) & "; " + ConvertFor = ConvertFor & ExpandToken(Var) & ForCheck & ConvertExpression(ForTo) & "; " + ConvertFor = ConvertFor & ExpandToken(Var) & " += " & ForStep + ConvertFor = ConvertFor & ") {" +End Function + +Public Function ConvertForEach(ByVal L As String) As String + Dim Var As String, ForSource As String + L = Trim(L) + RecordLeft L, "For " + RecordLeft L, "Each " + + Var = RemoveUntil(L, " In ", True) + ForSource = L + + ConvertForEach = ConvertForEach & "foreach (var iter" & Var & " in " & ConvertExpression(ForSource) & ") {" & vbCrLf & Var & " = iter" & Var & ";" +End Function + +Public Function ConvertType(ByVal L As String) As String + Dim isPrivate As Boolean, isPublic As Boolean + isPublic = RecordLeft(L, "Public ") + isPrivate = RecordLeft(L, "Private ") + RecordLeft L, "Type " + CurrentTypeName = L + + ConvertType = "" + If Not isPrivate Then ConvertType = ConvertType & "public " + ConvertType = ConvertType & "class " ' `struct ` is available, but leads to non-conforming behavior when indexing in lists... + ConvertType = ConvertType & L + ConvertType = ConvertType & "{ " +End Function + +Public Function ConvertTypeLine(ByVal L As String, ByVal vCodeType As CodeType) As String + ConvertTypeLine = ConvertDeclaration(L, DECL_TYPE, vCodeType) +End Function + +Public Function ConvertEnum(ByVal L As String) As String + Dim isPrivate As Boolean, isPublic As Boolean + isPublic = RecordLeft(L, "Public ") + isPrivate = RecordLeft(L, "Private ") + RecordLeft L, "Enum " + CurrentEnumName = L + + ConvertEnum = "" + If Not isPrivate Then ConvertEnum = ConvertEnum & "public " + ConvertEnum = ConvertEnum & "enum " + ConvertEnum = ConvertEnum & L + ConvertEnum = ConvertEnum & "{ " +End Function + +Public Function ConvertEnumLine(ByVal L As String) As String + Dim Name As String, Value As String + Dim Parts() As String + Parts = Split(L, " = ") + Name = Trim(Parts(0)) + If UBound(Parts) >= 1 Then Value = Trim(Parts(1)) Else Value = "" + + ConvertEnumLine = "" + If Right(CurrentEnumName, 1) = "+" Then ConvertEnumLine = ConvertEnumLine & ", " + ConvertEnumLine = ConvertEnumLine & Name + If Value <> "" Then ConvertEnumLine = ConvertEnumLine & " = " & ConvertExpression(Value) + CurrentEnumName = CurrentEnumName & "+" ' convenience +End Function + +Public Function ConvertProperty(ByVal L As String, ByVal FullContents As String, ByVal vCodeType As CodeType) As String + Dim Name As String, IX As Long, isPrivate As Boolean, ReturnType As String, Discard As String + Dim PropertyType As String + Dim GetContents As String, SetContents As String + IX = InStr(L, "(") + Name = Left(L, IX - 1) + RecordLeft L, "Public " + isPrivate = RecordLeft(L, "Private ") + RecordLeft L, "Property " + RecordLeft L, "Get " + RecordLeft L, "Let " + RecordLeft L, "Set " + + IX = InStr(L, "(") + Name = Left(L, IX - 1) + If InStr(ModuleProperties, Name) > 0 Then Exit Function + CurrentFunctionName = Name + CurrentFunctionReturnValue = "_" & Name + ModuleProperties = ModuleProperties & "[" & Name & "]" + + GetContents = FindPropertyBody(FullContents, "Get", Name, ReturnType) + If GetContents <> "" Then GetContents = ConvertContents(GetContents, vCodeType, True) + If ReturnType = "" Then ReturnType = "Variant" + SetContents = FindPropertyBody(FullContents, "Let", Name, Discard) + If SetContents = "" Then SetContents = FindPropertyBody(FullContents, "Set", Name, Discard) + If SetContents <> "" Then SetContents = ConvertContents(SetContents, vCodeType, True) + + PropertyType = ConvertArgType(Name, ReturnType) + + ConvertProperty = "" + ConvertProperty = ConvertProperty & IIf(isPrivate, "private ", "public ") + ConvertProperty = ConvertProperty & IIf(vCodeType = CODE_MODULE, "static ", "") + ConvertProperty = ConvertProperty & PropertyType & " " & Name & "{ " & vbCrLf + If GetContents <> "" Then + ConvertProperty = ConvertProperty & "get {" & vbCrLf + ConvertProperty = ConvertProperty & PropertyType & " " & CurrentFunctionReturnValue & ";" & vbCrLf + ConvertProperty = ConvertProperty & GetContents + ConvertProperty = ConvertProperty & "return " & CurrentFunctionReturnValue & ";" & vbCrLf + ConvertProperty = ConvertProperty & "}" & vbCrLf + End If + If SetContents <> "" Then + ConvertProperty = ConvertProperty & "set {" & vbCrLf + ConvertProperty = ConvertProperty & SetContents + ConvertProperty = ConvertProperty & "}" & vbCrLf + End If + ConvertProperty = ConvertProperty & "}" & vbCrLf +End Function + +Public Function FindPropertyBody(ByVal FullContents As String, ByVal Typ As String, ByVal Name As String, ByRef ReturnType As String) As String + Dim X As Long + X = InStr(FullContents, "Property " & Typ & " " & Name) + If X = 0 Then Exit Function + FindPropertyBody = Mid(FullContents, X) + X = RegExNPos(FindPropertyBody, "\bEnd Property\b", 0) + FindPropertyBody = Trim(Left(FindPropertyBody, X - 1)) + + RecordLeft FindPropertyBody, "Property " & Typ & " " & Name + RecordLeft FindPropertyBody, "(" + X = 1 + Do While X > 0 + If Left(FindPropertyBody, 1) = "(" Then X = X + 1 + If Left(FindPropertyBody, 1) = ")" Then X = X - 1 + FindPropertyBody = Mid(FindPropertyBody, 2) + Loop + FindPropertyBody = Trim(FindPropertyBody) + If StartsWith(FindPropertyBody, "As ") Then + FindPropertyBody = Mid(FindPropertyBody, 4) + X = SearchLeft(1, FindPropertyBody, ": " & vbCrLf, False, False) + ReturnType = Left(FindPropertyBody, X - 1) + FindPropertyBody = Mid(FindPropertyBody, X) + End If + Do While StartsWith(FindPropertyBody, vbCrLf): FindPropertyBody = Mid(FindPropertyBody, 3): Loop + Do While Right(FindPropertyBody, 2) = vbCrLf: FindPropertyBody = Left(FindPropertyBody, Len(FindPropertyBody) - 2): Loop +End Function + +Public Function ConvertDeclaration(ByVal L As String, ByVal declType As DeclarationType, ByVal vCodeType As CodeType) As String + Dim IsDim As Boolean, isPrivate As Boolean, isPublic As Boolean, IsConst As Boolean, isGlobal As Boolean, isStatic As Boolean + Dim IsOptional As Boolean, IsByVal As Boolean, IsByRef As Boolean, IsParamArray As Boolean + Dim IsWithEvents As Boolean, IsEvent As Boolean + Dim FixedLength As Long, IsNewable As Boolean + L = Trim(L) + If L = "" Then Exit Function + + IsDim = RecordLeft(L, "Dim ") + isPrivate = RecordLeft(L, "Private ") + isPublic = RecordLeft(L, "Public ") + isGlobal = RecordLeft(L, "Global ") + IsConst = RecordLeft(L, "Const ") + isStatic = RecordLeft(L, "Static ") +' If IsInStr(L, "LineStrings") Then Stop + + If isStatic And declType = DECL_LOCAL Then LineComment = LineComment & " TODO: (NOT SUPPORTED) C# Does not support static local variables." + + Dim Item As Variant, LL As String + For Each Item In Split(L, ", ") + Dim IX As Long, ArgName As String, ArgType As String, ArgDefault As String, IsArray As Boolean + Dim ArgTargetType As String + Dim StandardEvent As Boolean + If ConvertDeclaration <> "" And declType <> DECL_SIGNATURE And declType <> DECL_EXTERN Then ConvertDeclaration = ConvertDeclaration & vbCrLf + LL = Item + + IsEvent = RecordLeft(LL, "Event ") + IsWithEvents = RecordLeft(LL, "WithEvents ") + IsOptional = RecordLeft(LL, "Optional ") + IsByVal = RecordLeft(LL, "ByVal ") + IsByRef = RecordLeft(LL, "ByRef ") + IsParamArray = RecordLeft(LL, "ParamArray ") + + IX = InStr(LL, " = ") + If IX > 0 Then + ArgDefault = Trim(Mid(LL, IX + 3)) + LL = Left(LL, IX - 1) + Else + ArgDefault = "" + End If + + IX = InStr(LL, " As ") + If IX > 0 Then + ArgType = Trim(Mid(LL, IX + 4)) + LL = Left(LL, IX - 1) + Else + ArgType = "" + End If + + If StartsWith(ArgType, "New ") Then + IsNewable = True + RecordLeft ArgType, "New " + LineComment = LineComment & "TODO: (NOT SUPPORTED) Dimmable 'New' not supported on variable declaration. Instantiated only on declaration. Please ensure usages" + End If + + If InStr(ArgType, " * ") > 0 Then + FixedLength = Val(Trim(Mid(ArgType, InStr(ArgType, " * ") + 3))) + ArgType = RemoveUntil(ArgType, " * ") + LineComment = LineComment & "TODO: (NOT SUPPORTED) Fixed Length String not supported: " & ArgName & "(" & FixedLength & ")" + End If + + ArgName = LL + If Right(ArgName, 2) = "()" Then + IsArray = True + ArgName = Left(ArgName, Len(ArgName) - 2) + ElseIf RegExTest(ArgName, "^[a-zA-Z_][a-zA-Z_0-9]*\(.* To .*\)$") Then + IsArray = True + LineComment = LineComment & " TODO: (NOT SUPPORTED) Array ranges not supported: " & ArgName + ArgName = RemoveUntil(ArgName, "(") + Else + IsArray = False + End If + + ArgTargetType = ConvertArgType(ArgName, ArgType) + + StandardEvent = IsStandardEvent(ArgName, ArgType) + + Select Case (declType) + Case DECL_GLOBAL ' global + If isPublic Or IsDim Then + ConvertDeclaration = ConvertDeclaration & "public " + If vCodeType = CODE_MODULE And Not IsConst Then ConvertDeclaration = ConvertDeclaration & "static " + Else + ConvertDeclaration = ConvertDeclaration & "public " & IIf(Not IsConst, "static ", "") + End If + If IsConst Then ConvertDeclaration = ConvertDeclaration & "const " + ConvertDeclaration = ConvertDeclaration & IIf(IsArray, "List<" & ArgTargetType & ">", ArgTargetType) & " " + ConvertDeclaration = ConvertDeclaration & ArgName + If ArgDefault <> "" Then + ConvertDeclaration = ConvertDeclaration & " = " & ConvertExpression(ArgDefault) + Else + ConvertDeclaration = ConvertDeclaration & " = " & ArgTypeDefault(ArgTargetType, IsArray, IsNewable) ' VB6 always initializes variables on declaration + End If + ConvertDeclaration = ConvertDeclaration & ";" + If IsArray Then ModuleArrays = ModuleArrays & "[" & ArgName & "]" + Case DECL_LOCAL ' function contents + ConvertDeclaration = ConvertDeclaration & IIf(IsArray, "List<" & ArgTargetType & ">", ArgTargetType) & " " + ConvertDeclaration = ConvertDeclaration & ArgName + If ArgDefault <> "" Then + ConvertDeclaration = ConvertDeclaration & " = " & ConvertExpression(ArgDefault) + Else + ConvertDeclaration = ConvertDeclaration & " = " & ArgTypeDefault(ArgTargetType, IsArray, IsNewable) ' VB6 always initializes variables on declaration + End If + ConvertDeclaration = ConvertDeclaration & ";" + If IsArray Then CurrentFunctionArrays = CurrentFunctionArrays & "[" & ArgName & "]" + CurrentFunctionArgs = CurrentFunctionArgs & "[" & ArgName & "]" + Case DECL_SIGNATURE ' sig def + If ConvertDeclaration <> "" Then ConvertDeclaration = ConvertDeclaration & ", " + If IsByRef Or Not IsByVal Then ConvertDeclaration = ConvertDeclaration & "ref " + ConvertDeclaration = ConvertDeclaration & IIf(IsArray, "List<" & ArgTargetType & ">", ArgTargetType) & " " + ConvertDeclaration = ConvertDeclaration & ArgName + If ArgDefault <> "" Then ConvertDeclaration = ConvertDeclaration & " = " & ConvertExpression(ArgDefault) ' default on method sig means optional param + If IsArray Then CurrentFunctionArrays = CurrentFunctionArrays & "[" & ArgName & "]" + CurrentFunctionArgs = CurrentFunctionArgs & "[" & ArgName & "]" + Case DECL_TYPE + ConvertDeclaration = ConvertDeclaration & "public " & ArgTargetType & " " & ArgName & ";" + Case DECL_ENUM + Case DECL_EXTERN + If ConvertDeclaration <> "" Then ConvertDeclaration = ConvertDeclaration & ", " + If IsByRef Or Not IsByVal Then ConvertDeclaration = ConvertDeclaration & "ref " + ConvertDeclaration = ConvertDeclaration & IIf(IsArray, "List<" & ArgTargetType & ">", ArgTargetType) & " " + ConvertDeclaration = ConvertDeclaration & ArgName + End Select + +' If IsParamArray Then Stop + If ArgType = "" And Not IsEvent And Not StandardEvent Then + End If + If declType = DECL_SIGNATURE Then + If IsParamArray Then + Else + If Not IsByVal And Not IsByRef And Not StandardEvent Then + End If + End If + If IsOptional And IsByRef Then + End If + If IsOptional And ArgDefault = "" Then + End If + End If + Next +End Function + +'Function IsStandardEvent(ByVal ArgName As String, ByVal ArgType As String) As Boolean +' If ArgName = "Cancel" Then IsStandardEvent = True: Exit Function +' If ArgName = "LastRow" Then IsStandardEvent = True: Exit Function +' If ArgName = "LastCol" Then IsStandardEvent = True: Exit Function +' If ArgName = "newCol" Then IsStandardEvent = True: Exit Function +' If ArgName = "newCol" Then IsStandardEvent = True: Exit Function +' If ArgName = "newRow" Then IsStandardEvent = True: Exit Function +' If ArgName = "OldValue" Then IsStandardEvent = True: Exit Function +' If ArgName = "Index" And ArgType = "Integer" Then IsStandardEvent = True: Exit Function +' If ArgName = "Offset" And ArgType = "Integer" Then IsStandardEvent = True: Exit Function +' If ArgName = "UnloadMode" And ArgType = "Integer" Then IsStandardEvent = True: Exit Function +' If ArgName = "KeyCode" And ArgType = "Integer" Then IsStandardEvent = True: Exit Function +' If ArgName = "KeyAscii" And ArgType = "Integer" Then IsStandardEvent = True: Exit Function +' If ArgName = "Button" And ArgType = "Integer" Then IsStandardEvent = True: Exit Function +' If ArgName = "Shift" And ArgType = "Integer" Then IsStandardEvent = True: Exit Function +' If ArgName = "X" And ArgType = "Single" Then IsStandardEvent = True: Exit Function +' If ArgName = "Y" And ArgType = "Single" Then IsStandardEvent = True: Exit Function +' If ArgName = "Source" And ArgType = "Control" Then IsStandardEvent = True: Exit Function +' If ArgName = "Item" And ArgType = "Integer" Then IsStandardEvent = True: Exit Function +' IsStandardEvent = False +'End Function +' +Public Function ConvertArgType(ByVal Name As String, ByVal Typ As String) As String + Select Case Typ + Case "Long", "Integer", "Int32", "Short": + ConvertArgType = "int" + Case "Currency" + ConvertArgType = "decimal" + Case "Date" + ConvertArgType = "DateTime" + Case "Double", "Float", "Single" + ConvertArgType = "double" + Case "String": + ConvertArgType = "string" + Case "Boolean" + ConvertArgType = "bool" + Case "Variant", "Object" + ConvertArgType = "dynamic" + Case Else + ConvertArgType = Typ + End Select +End Function + +Public Function ArgTypeDefault(ByVal ArgType As String, Optional ByVal AsArray As Boolean = False, Optional ByVal IsNewable As Boolean = False) As String + If Not AsArray Then + Select Case LCase(ArgType) + Case "string" + ArgTypeDefault = """""" + Case "long", "int", "integer", "short", "byte", "decimal", "float", "double", "currency" + ArgTypeDefault = "0" + Case "boolean", "bool" + ArgTypeDefault = "false" + Case "vbtristate" + ArgTypeDefault = "vbUseDefault" + Case "datetime", "date" + ArgTypeDefault = "DateTime.MinValue" + Case Else + ArgTypeDefault = IIf(IsNewable, "new " & ArgType & "()", "null") + End Select + Else + ArgTypeDefault = "new List<" & ArgType & ">()" + End If +End Function + +Public Function ConvertSignature(ByVal LL As String, Optional ByVal vCodeType As CodeType = CODE_FORM) As String + Dim L As String, WithReturn As Boolean + Dim isPublic As Boolean, isPrivate As Boolean, IsFriend As Boolean + Dim IsPropertyGet As Boolean, IsPropertyLet As Boolean, IsPropertySet As Boolean + Dim IsFunction As Boolean, IsSub As Boolean + L = LL + isPrivate = RecordLeft(L, "Private ") + isPublic = RecordLeft(L, "Public ") + IsFriend = RecordLeft(L, "Friend ") + IsSub = RecordLeft(L, "Sub ") + IsFunction = RecordLeft(L, "Function ") + IsPropertyGet = RecordLeft(L, "Property Get ") + IsPropertyLet = RecordLeft(L, "Property let ") + IsPropertySet = RecordLeft(L, "Property set ") + WithReturn = IsFunction Or IsPropertyGet + + Dim IX As Long, Ix2 As Long, Name As String, Args As String, Ret As String, RetTargetType As String, IsArray As Boolean + IX = InStr(L, "(") + If IX = 0 Then Exit Function + Name = Left(L, IX - 1) + If RegExTest(L, "\) As .*\(\)$") Then + Ix2 = InStrRev(L, ")", Len(L) - 2) + Else + Ix2 = InStrRev(L, ")") + End If + Args = Mid(L, IX + 1, Ix2 - IX - 1) + Ret = Mid(L, Ix2 + 1) + Ret = Replace(Ret, " As ", "") + IsArray = Right(Ret, 2) = "()" + If IsArray Then Ret = Left(Ret, Len(Ret) - 2) + RetTargetType = ConvertArgType(Name, Ret) + If IsArray Then RetTargetType = "List<" & RetTargetType & ">" + + CurrentFunctionName = Name + CurrentFunctionReturnValue = IIf(WithReturn, "_" & CurrentFunctionName, "") + + ConvertSignature = "" + If isPublic Then ConvertSignature = ConvertSignature & "public " + If isPrivate Then ConvertSignature = ConvertSignature & "private " + If vCodeType = CODE_MODULE Then ConvertSignature = ConvertSignature & "static " + ConvertSignature = ConvertSignature & IIf(Ret = "", "void ", RetTargetType & " ") + ConvertSignature = ConvertSignature & Name & "(" & ConvertDeclaration(Args, DECL_SIGNATURE, vCodeType) & ") {" + If WithReturn Then + ConvertSignature = ConvertSignature & vbCrLf & RetTargetType & " " & CurrentFunctionReturnValue & " = " & ArgTypeDefault(RetTargetType) & ";" + End If +End Function + +Public Function ConvertDeclare(ByVal L As String) As String +'Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long +'[DllImport("User32.dll")] +'public static extern int MessageBox(int h, string m, string c, int type); + Dim isPrivate As Boolean, isPublic As Boolean, IsFunction As Boolean, IsSub As Boolean + Dim X As Long + Dim Name As String, cLib As String, cAlias As String + Dim Args As String, Ret As String + L = Trim(L) + + isPrivate = RecordLeft(L, "Private ") + isPublic = RecordLeft(L, "Public ") + L = StripLeft(L, "Declare ") + IsFunction = RecordLeft(L, "Function ") + IsSub = RecordLeft(L, "Sub ") + + X = InStr(L, " ") + Name = Left(L, X - 1) + L = Mid(L, X + 1) + + If RecordLeft(L, "Lib ") Then + X = InStr(L, " ") + cLib = Left(L, X - 1) +' If Left(cLib, 1) = """" Then cLib = Mid(cLib, 2, Len(cLib) - 2) + L = Mid(L, X + 1) + End If + + If RecordLeft(L, "Alias ") Then + X = InStr(L, " ") + cAlias = Left(L, X - 1) +' If Left(cAlias, 1) = """" Then cAlias = Mid(cAlias, 2, Len(cAlias) - 2) + L = Mid(L, X + 1) + End If + + X = InStrRev(L, ")") + Ret = Trim(Mid(L, X + 1)) + Ret = Replace(Ret, "As ", "") + Args = Mid(L, 2, X - 2) + + ConvertDeclare = "" + ConvertDeclare = ConvertDeclare & "[DllImport(" & cLib & ")]" & vbCrLf + ConvertDeclare = ConvertDeclare & IIf(isPrivate, "private ", "public ") & "static extern " + ConvertDeclare = ConvertDeclare & IIf(Ret = "", "void", ConvertArgType("return", Ret)) & " " + ConvertDeclare = ConvertDeclare & Name & "(" + ConvertDeclare = ConvertDeclare & ConvertDeclaration(Args, DECL_EXTERN, True) + ConvertDeclare = ConvertDeclare & ");" +End Function + +Public Function SplitByComma(ByVal L As String) As String() + Dim Results() As String, ResultCount As Long + Dim N As Long, I As Long, C As String, Depth As Long, Part As String + N = Len(L) + For I = 1 To N + C = Mid(L, I, 1) + If C = "(" Then + Depth = Depth + 1 + Part = Part & C + ElseIf Depth > 0 And C = ")" Then + Depth = Depth - 1 + Part = Part & C + ElseIf Depth = 0 And (C = "," Or C = ")") Then + ResultCount = ResultCount + 1 + ReDim Preserve Results(1 To ResultCount) + Results(ResultCount) = Trim(Part) + Part = "" + Else + Part = Part & C + End If + Next + + ResultCount = ResultCount + 1 + ReDim Preserve Results(1 To ResultCount) + Results(ResultCount) = Trim(Part) + + SplitByComma = Results +End Function + +Public Function FindNextOperator(ByVal L As String) As Long + Dim N As Long + N = Len(L) + For FindNextOperator = 1 To N + If StartsWith(Mid(L, FindNextOperator), " && ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " || ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " ^^ ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " - ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " + ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " * ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " / ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " < ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " > ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " >= ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " <= ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " != ") Then Exit Function + If StartsWith(Mid(L, FindNextOperator), " == ") Then Exit Function + Next + FindNextOperator = 0 +End Function + +Public Function ConvertIIf(ByVal L As String) As String + Dim Parts() As String + Dim Condition As String, TruePart As String, FalsePart As String + + Parts = SplitByComma(Mid(Trim(L), 5, Len(L) - 5)) + Condition = Parts(1) + TruePart = Parts(2) + FalsePart = Parts(3) + + ConvertIIf = "(" & ConvertExpression(Condition) & " ? " & ConvertExpression(TruePart) & " : " & ConvertExpression(FalsePart) & ")" +End Function + +Public Function ConvertStatement(ByVal L As String) As String + Dim NonCodeLine As Boolean + L = Trim(L) + + If StartsWith(L, "Set ") Then L = Mid(L, 5) + + If StartsWith(L, "Option ") Then + ' ignore "Option" directives + NonCodeLine = True + ElseIf RegExTest(L, "^[ ]*Exit (Function|Sub|Property)$") Then + ConvertStatement = ConvertStatement & "return" + If CurrentFunctionReturnValue <> "" Then ConvertStatement = ConvertStatement & " " & CurrentFunctionReturnValue + ElseIf RegExTest(L, "^[ ]*Exit (Do|Loop|For|While)$") Then + ConvertStatement = ConvertStatement & "break" + ElseIf InStr(L, " = ") > 0 Then + Dim IX As Long, AssignmentTarget As String, AssignmentValue As String + IX = InStr(L, " = ") + AssignmentTarget = Trim(Left(L, IX - 1)) + If InStr(AssignmentTarget, "(") > 0 Then AssignmentTarget = ConvertExpression(AssignmentTarget) + If IsControlRef(AssignmentTarget, ModuleName) Then +' If InStr(AssignmentTarget, "lblPrg") > 0 Then Stop + AssignmentTarget = modRefScan.FormControlRepl(AssignmentTarget, ModuleName) + End If + If AssignmentTarget = CurrentFunctionName Then AssignmentTarget = CurrentFunctionReturnValue + AssignmentValue = Mid(L, IX + 3) + ConvertStatement = AssignmentTarget & " = " & ConvertExpression(AssignmentValue) + ElseIf RegExTest(L, "^[ ]*Unload ") Then + L = Trim(L) + RecordLeft L, "Unload " + ConvertStatement = IIf(L = "Me", "Unload()", L & ".instance.Unload()") + ElseIf RegExTest(L, "^[ ]*With") Or RegExTest(L, "^[ ]*End With") Then + ConvertStatement = "// TODO: (NOT SUPPORTED): " & L + NonCodeLine = True + ElseIf RegExTest(L, "^[ ]*(On Error|Resume) ") Then + ConvertStatement = "// TODO: (NOT SUPPORTED): " & L + NonCodeLine = True + ElseIf RegExTest(L, "^[ ]*ReDim ") Then + ConvertStatement = "// TODO: (NOT SUPPORTED): " & L + NonCodeLine = True + ElseIf RegExTest(L, "^[ ]*Err.Clear") Then + ConvertStatement = "// TODO: (NOT SUPPORTED): " & L + NonCodeLine = True + ElseIf RegExTest(L, "^[ ]*(([a-zA-Z_()0-9.]\.)*)?[a-zA-Z_0-9.]+$") Then ' Method call without parens or args (statement, not expression) + ConvertStatement = ConvertStatement & L & "()" + ElseIf RegExTest(L, "^[ ]*(([a-zA-Z_()0-9.]\.)*)?[a-zA-Z_0-9.]+ .*") Then ' Method call without parens but with args (statement, not expression) + Dim FunctionCall As String, ArgList As String, ArgPart As Variant, ArgN As Long + FunctionCall = RegExNMatch(L, "^[ ]*((([a-zA-Z_()0-9.]\.)*)?[a-zA-Z_0-9.]+)", 0) + ArgList = Trim(Mid(L, Len(FunctionCall) + 1)) + ConvertStatement = ExpandFunctionCall(FunctionCall, ArgList) + Else + ConvertStatement = L + End If + + If Not NonCodeLine Then ConvertStatement = ConvertStatement & ";" +End Function + +Public Function ConvertExpression(ByVal L As String) As String + L = Replace(L, " \ ", " / ") + L = Replace(L, " = ", " == ") + L = Replace(L, " Mod ", " % ") + L = Replace(L, " & ", " + ") + L = Replace(L, " And ", " && ") + L = Replace(L, " Or ", " || ") + L = Replace(L, " Xor ", " ^^ ") + L = Replace(L, " Is ", " == ") + If InStr(L, " Like ") > 0 Then LineComment = LineComment & "TODO: (NOT SUPPORTED) LIKE statement changed to ==: " & L + L = Replace(L, " Like ", " == ") + L = Replace(L, " <> ", " != ") + L = RegExReplace(L, "\bNot\b", "!") + + L = RegExReplace(L, "\bFalse\b", "false") + L = RegExReplace(L, "\bTrue\b", "true") + + If LMatch(LTrim(L), "New ") Then L = "new " & Mid(LTrim(L), 5) & "()" + + If StartsWith(L, "IIf(") Then + L = ConvertIIf(L) + Else + L = ParseAndExpandExpression(L) + End If + + If CurrentFunctionName <> "" Then L = RegExReplace(L, "\b" & CurrentFunctionName & "([^(a-zA-Z_])", CurrentFunctionReturnValue & "$1") + + ConvertExpression = L +End Function + +Public Function ParseAndExpandExpression(ByVal Src As String) As String + Dim S As String, Token As String, T As String + Dim I As Long, J As Long + Dim X As Long, Y As Long, C As String + Dim FunctionName As String, FunctionArgs As String + + Token = EXPRESSION_TOKEN_PREFIX & CLng(Rnd * 1000000) + + + S = RegExNMatch(Src, "\([^()]+\)", 0) + If S <> "" Then + X = InStr(Src, S) + Src = Replace(Src, S, Token, 1, 1) + If X > 1 Then C = Mid(Src, X - 1, 1) Else C = "" + If X > 1 And C <> "(" And C <> ")" And C <> " " Then + Y = SearchLeft(X - 1, Src, "() ", False, True) + FunctionName = Mid(Src, Y + 1, X - Y - 1) + Src = Replace(Src, FunctionName & Token, Token, 1, 1) + FunctionArgs = Mid(S, 2, Len(S) - 2) + If modRefScan.IsControlRef(FunctionName, ModuleName) Then + ParseAndExpandExpression = FunctionName & "[" & FunctionArgs & "]" & "." & ConvertControlProperty("", "", FormControlRefDeclType(FunctionName, ModuleName)) + Exit Function + End If + FunctionName = ExpandToken(FunctionName, True) + S = ExpandFunctionCall(FunctionName, FunctionArgs) + + ParseAndExpandExpression = ParseAndExpandExpression(Src) + ParseAndExpandExpression = Replace(ParseAndExpandExpression, Token, S) +' Debug.Print "FUNCTION: " & S + Exit Function + Else ' not a function, but sub expression maybe math + T = Mid(S, 2, Len(S) - 2) + X = FindNextOperator(T) + If X = 0 Then + ParseAndExpandExpression = ExpandToken(T) + Else + Y = InStr(X + 2, T, " ") + S = ExpandToken(Left(T, X - 1)) & Mid(T, X, Y - X + 1) & ParseAndExpandExpression(Mid(T, Y + 1)) + End If + + ParseAndExpandExpression = ParseAndExpandExpression(Src) + ParseAndExpandExpression = Replace(ParseAndExpandExpression, Token, "(" & S & ")") + +' Debug.Print "PLAIN EXP: " & S + Exit Function + End If + End If + + ' no subexpression. Check for math + X = FindNextOperator(Src) + If X = 0 Then + ParseAndExpandExpression = ExpandToken(Src) +' Debug.Print "SIMPLE TOKEN: " & S + Exit Function + Else + Y = InStr(X + 2, Src, " ") + ParseAndExpandExpression = ParseAndExpandExpression(Left(Src, X - 1)) & Mid(Src, X, Y - X + 1) & ParseAndExpandExpression(Mid(Src, Y + 1)) +' Debug.Print "PARSED ARITHMATIC: " & S + Exit Function + End If +End Function + +Public Function ExpandToken(ByVal T As String, Optional ByVal WillAddParens As Boolean = False, Optional ByVal AsLast As Boolean = False) As String + Dim WithNot As Boolean + WithNot = Left(T, 1) = "!" + If WithNot Then T = Mid(T, 2) +' If InStr(T, "modConfig") > 0 Then Stop +' If InStr(T, "ConfigValid") > 0 Then Stop +' If InStr(T, "txtSrc") > 0 Then Stop + +' Debug.Print "ExpandToken: " & T + If T = CurrentFunctionName Then + T = CurrentFunctionReturnValue + ElseIf T = "Rnd" Then + T = T & "()" + ElseIf T = "Me" Then + T = "this" + ElseIf T = "App.Path" Then + T = "AppContext.BaseDirectory" + ElseIf T = "Now" Then + T = "DateTime.Now" + ElseIf T = "Nothing" Then + T = "null" + ElseIf T = "Err.Number" Then + T = "Err().Number" + ElseIf T = "Err.Description" Then + T = "Err().Description" + ElseIf InStr(CurrentFunctionArgs, T) = 0 And Not WillAddParens And (IsFuncRef(T) Or IsLocalFuncRef(T)) Then +' Debug.Print "Autofunction: " & T + T = T & "()" + ElseIf modRefScan.IsFormRef(T) Then + T = FormRefRepl(T) + ElseIf modRefScan.IsControlRef(T, ModuleName) Then + T = FormControlRepl(T, ModuleName) + ElseIf modRefScan.IsEnumRef(T) Then + T = modRefScan.EnumRefRepl(T) + ElseIf Left(T, 2) = "&H" Then + T = "0x" & Mid(T, 3) + If Right(T, 1) = "&" Then T = Left(T, Len(T) - 1) + ElseIf RegExTest(T, "^[0-9.-]+&$") Then + T = Left(T, Len(T) - 1) + ElseIf InStr(T, ".") Then + Dim Parts() As String, I As Long, Part As String, IsLast As Boolean + Dim TOut As String +' Debug.Print "Reference: " & T + TOut = "" + Parts = Split(T, ".") + For I = LBound(Parts) To UBound(Parts) + Part = Parts(I) + IsLast = I = UBound(Parts) + If TOut <> "" Then TOut = TOut & "." + TOut = TOut & ExpandToken(Part, WillAddParens, IsLast) + Next + T = TOut + End If + ExpandToken = IIf(WithNot, "!", "") & T +End Function + +Public Function ExpandFunctionCall(ByVal FunctionName As String, ByVal Args As String) As String + If InStr(ModuleArrays & CurrentFunctionArrays & FormControlArrays, "[" & FunctionName & "]") > 0 Then + ExpandFunctionCall = FunctionName & "[" & ProcessFunctionArgs(Args) & "]" + ElseIf FunctionName = "LBound" Then + ExpandFunctionCall = "0" + ElseIf FunctionName = "UBound" Then + ExpandFunctionCall = Args & ".Count" + ElseIf FunctionName = "Split" Then + ExpandFunctionCall = "new List(" & FunctionName & "(" & ProcessFunctionArgs(Args) & ")" & ")" + ElseIf FunctionName = "Debug.Print" Then + ExpandFunctionCall = "Console.WriteLine(" & ProcessFunctionArgs(Args) & ")" + ElseIf FunctionName = "Erase" Then + ExpandFunctionCall = Args & ".Clear()" + ElseIf FunctionName = "GoTo" Then + ExpandFunctionCall = "goto " & Args + ElseIf FunctionName = "Array" Then + ExpandFunctionCall = "new List() {" & ProcessFunctionArgs(Args) & "}" + ElseIf FunctionName = "Show" Then + ExpandFunctionCall = IIf(Args = "", "Show()", "ShowDialog()") + ElseIf modRefScan.IsFormRef(FunctionName) Then + ExpandFunctionCall = modRefScan.FormRefRepl(FunctionName) & "(" & ProcessFunctionArgs(Args, FunctionName) & ")" + Else + ExpandFunctionCall = FunctionName & "(" & ProcessFunctionArgs(Args, FunctionName) & ")" + End If + + ExpandFunctionCall = RegExReplace(ExpandFunctionCall, "\.Show\(.+\)", ".ShowDialog()") +End Function + +Public Function ProcessFunctionArgs(ByVal Args As String, Optional ByVal FunctionName As String = "") As String + Dim Arg As Variant, I As Long + For Each Arg In SplitByComma(Args) + I = I + 1 + If ProcessFunctionArgs <> "" Then ProcessFunctionArgs = ProcessFunctionArgs & ", " + If FunctionName <> "" Then + If modRefScan.IsFuncRef(FunctionName) Then + If I <= FuncRefDeclArgCnt(FunctionName) And modRefScan.FuncRefArgByRef(FunctionName, I) Then +' If IsInStr(Arg, STRING_TOKEN_PREFIX) Then Stop + ProcessFunctionArgs = ProcessFunctionArgs & "ref " + End If + End If + End If + cValP Nothing, "", "" + ProcessFunctionArgs = ProcessFunctionArgs & ConvertExpression(Arg) + Next +End Function + diff --git a/modQuickLint.bas b/modQuickLint.bas index 674cc7d..fa736ad 100644 --- a/modQuickLint.bas +++ b/modQuickLint.bas @@ -188,7 +188,7 @@ On Error GoTo LintError End If LineN = LineN + 1 -' If LineN = 41 Then Stop +' If LineN = 487 Then Stop Dim UnindentedAlready As Boolean If RegExTest(L, " ^Option ") Then Options.Add "true", Replace(L, "Options ", "") @@ -219,7 +219,7 @@ On Error GoTo LintError ElseIf RegExTest(St, "^[ ]*(End (If|Function|Sub|Property)|Loop|Loop .*|Enum|Type|Select)$") Then If Not UnindentedAlready Then Indent = Indent - Idnt ElseIf RegExTest(St, "^[ ]*If ") Then - If Not RegExTest(St, "Then ") Then Indent = Indent + Idnt + If Not RegExTest(St, "\bThen ") Then Indent = Indent + Idnt ElseIf RegExTest(St, "^[ ]*For ") Then Indent = Indent + Idnt ElseIf RegExTest(St, "^[ ]*Next$") Then @@ -350,6 +350,11 @@ Public Function StripLeft(ByVal L As String, ByVal Find As String) As String If StartsWith(L, Find) Then StripLeft = Mid(L, Len(Find) + 1) Else StripLeft = L End Function +Public Function RecordLeft(ByRef L As String, ByVal Find As String) As Boolean + RecordLeft = StartsWith(L, Find) + If RecordLeft Then L = Mid(L, Len(Find) + 1) +End Function + Public Sub TestIndent(ByRef Errors As String, ByRef ErrorCount As Long, ByVal LineN As Long, ByVal L As String, ByVal LineIndent As Long, ByVal ExpectedIndent As Long) If RTrim(L) = "" Then Exit Sub If RegExTest(L, "^On Error ") Then Exit Sub @@ -470,39 +475,28 @@ Public Sub TestDeclaration(ByRef Errors As String, ByRef ErrorCount As Long, ByV Dim Item As Variant, LL As String For Each Item In Split(L, ", ") - Dim Ix As Long, ArgName As String, ArgType As String, ArgDefault As String, StandardEvent As Boolean + Dim IX As Long, ArgName As String, ArgType As String, ArgDefault As String, StandardEvent As Boolean LL = Item - IsEvent = StartsWith(LL, "Event ") - LL = StripLeft(LL, "Event ") - - IsWithEvents = StartsWith(LL, "WithEvents ") - LL = StripLeft(LL, "WithEvents ") - - IsOptional = StartsWith(LL, "Optional ") - LL = StripLeft(LL, "Optional ") - - IsByVal = StartsWith(LL, "ByVal ") - LL = StripLeft(LL, "ByVal ") - - IsByRef = StartsWith(LL, "ByRef ") - LL = StripLeft(LL, "ByRef ") - - IsParamArray = StartsWith(LL, "ParamArray ") - LL = StripLeft(LL, "ParamArray ") + IsEvent = RecordLeft(LL, "Event ") + IsWithEvents = RecordLeft(LL, "WithEvents ") + IsOptional = RecordLeft(LL, "Optional ") + IsByVal = RecordLeft(LL, "ByVal ") + IsByRef = RecordLeft(LL, "ByRef ") + IsParamArray = RecordLeft(LL, "ParamArray ") - Ix = InStr(LL, " = ") - If Ix > 0 Then - ArgDefault = Trim(Mid(LL, Ix + 3)) - LL = Left(LL, Ix - 1) + IX = InStr(LL, " = ") + If IX > 0 Then + ArgDefault = Trim(Mid(LL, IX + 3)) + LL = Left(LL, IX - 1) Else ArgDefault = "" End If - Ix = InStr(LL, " As ") - If Ix > 0 Then - ArgType = Trim(Mid(LL, Ix + 4)) - LL = Left(LL, Ix - 1) + IX = InStr(LL, " As ") + If IX > 0 Then + ArgType = Trim(Mid(LL, IX + 4)) + LL = Left(LL, IX - 1) Else ArgType = "" End If @@ -595,22 +589,24 @@ Public Sub TestSignature(ByRef Errors As String, ByRef ErrorCount As Long, ByVal L = StripLeft(L, "Sub ") If StartsWith(L, "Function ") Or StartsWith(L, "Property Get ") Then WithReturn = True L = StripLeft(L, "Function ") - L = StripLeft(L, "Property ") + L = StripLeft(L, "Property Get ") + L = StripLeft(L, "Property Let ") + L = StripLeft(L, "Property Set ") - Dim Ix As Long, Ix2 As Long, Name As String, Args As String, RET As String - Ix = InStr(L, "(") - If Ix = 0 Then Exit Sub - Name = Left(L, Ix - 1) + Dim IX As Long, Ix2 As Long, Name As String, Args As String, Ret As String + IX = InStr(L, "(") + If IX = 0 Then Exit Sub + Name = Left(L, IX - 1) If RegExTest(L, "\) As .*\(\)$") Then Ix2 = InStrRev(L, ")", Len(L) - 2) Else Ix2 = InStrRev(L, ")") End If - Args = Mid(L, Ix + 1, Ix2 - Ix - 1) - RET = Mid(L, Ix2 + 1) + Args = Mid(L, IX + 1, Ix2 - IX - 1) + Ret = Mid(L, Ix2 + 1) TestSignatureName Errors, ErrorCount, LineN, Name - If WithReturn And RET = "" Then RecordError Errors, ErrorCount, TY_FNCRE, LineN, "Function Return Type Not Specified -- Specify Return Type or Variant" + If WithReturn And Ret = "" Then RecordError Errors, ErrorCount, TY_FNCRE, LineN, "Function Return Type Not Specified -- Specify Return Type or Variant" TestDeclaration Errors, ErrorCount, LineN, Args, True End Sub @@ -630,16 +626,16 @@ Public Sub TestDefaultControlNames(ByRef Errors As String, ByRef ErrorCount As L End Sub Public Sub TestCodeLine(ByRef Errors As String, ByRef ErrorCount As Long, ByVal LineN As Long, ByVal L As String) - If RegExTest(L, "+ """) Or RegExTest(L, """ +") Then RecordError Error, ErrorCount, TY_CORRE, LineN, "Possible use of + instead of & on String concatenation" - If RegExTest(L, " Me[.]") Then RecordError Error, ErrorCount, TY_CORRE, LineN, "Use of 'Me.*' is not required." + If RegExTest(L, "+ """) Or RegExTest(L, """ +") Then RecordError Errors, ErrorCount, TY_CORRE, LineN, "Possible use of + instead of & on String concatenation" + If RegExTest(L, " Me[.]") Then RecordError Errors, ErrorCount, TY_CORRE, LineN, "Use of 'Me.*' is not required." - If RegExTest(L, "\.Enabled = [-0-9]") Then RecordError Error, ErrorCount, TY_CORRE, LineN, "Property [Enabled] Should Be Boolean. Numeric found." - If RegExTest(L, "\.Visible = [-0-9]") Then RecordError Error, ErrorCount, TY_CORRE, LineN, "Property [Visible] Should Be Boolean. Numeric found." + If RegExTest(L, "\.Enabled = [-0-9]") Then RecordError Errors, ErrorCount, TY_CORRE, LineN, "Property [Enabled] Should Be Boolean. Numeric found." + If RegExTest(L, "\.Visible = [-0-9]") Then RecordError Errors, ErrorCount, TY_CORRE, LineN, "Property [Visible] Should Be Boolean. Numeric found." - If RegExTest(L, " Call ") Then RecordError Error, ErrorCount, TY_CORRE, LineN, "Remove keyword 'Call'." - If RegExTest(L, " GoSub ") Or RegExTest(L, " Return$") Then RecordError Error, ErrorCount, TY_GOSUB, LineN, "Remove uses of 'GoSub' and 'Return'." + If RegExTest(L, " Call ") Then RecordError Errors, ErrorCount, TY_CORRE, LineN, "Remove keyword 'Call'." + If RegExTest(L, " GoSub ") Or RegExTest(L, " Return$") Then RecordError Errors, ErrorCount, TY_GOSUB, LineN, "Remove uses of 'GoSub' and 'Return'." - If RegExTest(L, " Stop$") Or RegExTest(L, " Return$") Then RecordError Error, ErrorCount, TY_CSTOP, LineN, "Code contains STOP statement." + If RegExTest(L, " Stop$") Or RegExTest(L, " Return$") Then RecordError Errors, ErrorCount, TY_CSTOP, LineN, "Code contains STOP statement." End Sub Public Sub AddFix(ByVal Typ As String, ByVal Find As String, ByVal Repl As String, Optional ByVal RestOfFile As Boolean = False) diff --git a/modRefScan.bas b/modRefScan.bas index f257484..8402d42 100644 --- a/modRefScan.bas +++ b/modRefScan.bas @@ -240,6 +240,21 @@ Public Function IsControlRef(ByVal Src As String, Optional ByVal FormName As Str End If End Function +Public Function FormControlRefDeclType(ByVal Src As String, Optional ByVal FormName As String = "") As String + Dim Tok As String, Tok2 As String + Dim FTok As String, TTok As String + Tok = RegExNMatch(Src, patToken) + Tok2 = RegExNMatch(Src, patToken, 1) + TTok = Tok & "." & Tok2 + FTok = FormName & "." & Tok +'If IsInStr(Src, "SetFocus") Then Stop + If FuncRef(TTok) <> "" And FuncRefEntity(TTok) = "Control" Then + FormControlRefDeclType = FuncRefDecl(TTok) + ElseIf FuncRef(FTok) <> "" And FuncRefEntity(FTok) = "Control" Then + FormControlRefDeclType = FuncRefDecl(FTok) + End If +End Function + Public Function FuncRefDeclTyp(ByVal fName As String) As String FuncRefDeclTyp = SplitWord(FuncRefDecl(fName), 1) diff --git a/modRegEx.bas b/modRegEx.bas index 5ba792b..42d6e8e 100644 --- a/modRegEx.bas +++ b/modRegEx.bas @@ -53,7 +53,7 @@ On Error Resume Next oRe.Global = True Set oAl = CreateObject("System.Collections.ArrayList") - Do + Do While True Set oMatches = oRe.Execute(szStr) If oMatches.Count > 0 Then oAl.Add oMatches(0).SubMatches(2) diff --git a/modShell.bas b/modShell.bas index 4445407..f26975b 100644 --- a/modShell.bas +++ b/modShell.bas @@ -9,13 +9,13 @@ Public Const SW_SHOW As Long = 5 Public Const SW_SHOWDEFAULT As Long = 10 Public Const CREATE_NO_WINDOW As Long = &H8000000 -Global Const INFINITE As Long = -1& +Global Const INFINITE As Long = -1 Private LastProcessID As Long Private Const DIRSEP As String = "\" -Global Const NORMAL_PRIORITY_CLASS As Long = &H20& +Global Const NORMAL_PRIORITY_CLASS As Long = &H20 Enum enSW enSW_HIDE = 0 @@ -113,7 +113,7 @@ On Error GoTo ErrorRoutineErr ErrorRoutineResume: Exit Sub ErrorRoutineErr: - MsgBox "AppShell.Form1.ShellAndWait: " & Err & Error + MsgBox "AppShell.Form1.ShellAndWait [" & Err.Number & "]: " & Err.Description Resume Next End Sub diff --git a/modSupportFiles.bas b/modSupportFiles.bas index a8794cb..093a818 100644 --- a/modSupportFiles.bas +++ b/modSupportFiles.bas @@ -201,7 +201,7 @@ SkipClass: CreateProjectFile = S - WriteOut ChgExt(tFileName(vbpFile), ".csproj"), S + WriteOut ChgExt(ProjFileName(vbpFile), ".csproj"), S End Function Public Function VBExtensionClass() As String diff --git a/modUsingEverything.bas b/modUsingEverything.bas index aff5af2..6186d24 100644 --- a/modUsingEverything.bas +++ b/modUsingEverything.bas @@ -29,6 +29,7 @@ Public Function UsingEverything(Optional ByVal PackageName As String = "") As St E = E & N & "using System.Windows.Controls;" E = E & N & "using static System.DateTime;" E = E & N & "using static System.Math;" + E = E & N & "using System.Linq;" E = E & N & "using static Microsoft.VisualBasic.Globals;" E = E & N & "using static Microsoft.VisualBasic.Collection;" diff --git a/modUtils.bas b/modUtils.bas index f054b41..eaa91c4 100644 --- a/modUtils.bas +++ b/modUtils.bas @@ -11,19 +11,25 @@ Public Const vbCrLf4 As String = vbCrLf & vbCrLf & vbCrLf & vbCrLf Public Const STR_CHR_UCASE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Public Const STR_CHR_LCASE As String = "abcdefghijklmnopqrstuvwxyz" -Public Const STR_CHR_DIGIT As String = "1234567890" +Public Const STR_CHR_DIGIT As String = "1234567890" ' eol comment + + +' block comment +' again Public Function IsInStr(ByVal Src As String, ByVal Find As String) As Boolean: IsInStr = InStr(Src, Find) > 0: End Function +'after + Public Function IsNotInStr(ByVal S As String, ByVal Fnd As String) As Boolean: IsNotInStr = Not IsInStr(S, Fnd): End Function Public Function FileExists(ByVal FN As String) As Boolean: FileExists = FN <> "" And Dir(FN) <> "": End Function Public Function DirExists(ByVal FN As String) As Boolean: DirExists = FN <> "" And Dir(FN, vbDirectory) <> "": End Function -Public Function tFileName(ByVal FN As String) As String: tFileName = Mid(FN, InStrRev(FN, "\") + 1): End Function -Public Function FileBaseName(ByVal FN As String) As String: FileBaseName = Left(tFileName(FN), InStrRev(tFileName(FN), ".") - 1): End Function +Public Function ProjFileName(ByVal FN As String) As String: ProjFileName = Mid(FN, InStrRev(FN, "\") + 1): End Function +Public Function FileBaseName(ByVal FN As String) As String: FileBaseName = Left(ProjFileName(FN), InStrRev(ProjFileName(FN), ".") - 1): End Function Public Function FilePath(ByVal FN As String) As String: FilePath = Left(FN, InStrRev(FN, "\")): End Function Public Function ChgExt(ByVal FN As String, ByVal NewExt As String) As String: ChgExt = Left(FN, InStrRev(FN, ".") - 1) & NewExt: End Function Public Function tLeft(ByVal Str As String, ByVal N As Long) As String: tLeft = Left(Trim(Str), N): End Function Public Function tMid(ByVal Str As String, ByVal N As Long, Optional ByVal M As Long = 0) As String: tMid = IIf(M = 0, Mid(Trim(Str), N), Mid(Trim(Str), N, M)): End Function -Public Function StrCnt(ByVal Src As String, ByVal Str As String) As Long: StrCnt = (Len(Src) - Len(Replace(Src, Str, ""))) / Len(Str): End Function +Public Function StrCnt(ByVal Src As String, ByVal Str As String) As Long: StrCnt = (Len(Src) - Len(Replace(Src, Str, ""))) / IIf(Len(Str) = 0, 1, Len(Str)): End Function Public Function LMatch(ByVal Src As String, ByVal tMatch As String) As Boolean: LMatch = Left(Src, Len(tMatch)) = tMatch: End Function Public Function tLMatch(ByVal Src As String, ByVal tMatch As String) As Boolean: tLMatch = Left(LTrim(Src), Len(tMatch)) = tMatch: End Function Public Function Px(ByVal Twips As Long) As Long: Px = Twips / 14: End Function @@ -389,6 +395,12 @@ Public Function isOperator(ByVal S As String) As Boolean End Function Public Sub Prg(Optional ByVal Val As Long = -1, Optional ByVal Max As Long = -1, Optional ByVal Cap As String = "#") + Dim L As Variant, Found As Boolean + For Each L In Forms + If L.Name = "frm" Then Found = True: Exit For + Next + If Not Found Then Exit Sub + frm.Prg Val, Max, Cap End Sub diff --git a/modVB6ToCS.bas b/modVB6ToCS.bas index 54349c2..fb182a0 100644 --- a/modVB6ToCS.bas +++ b/modVB6ToCS.bas @@ -13,7 +13,7 @@ End Function Public Function ConvertDataType(ByVal S As String) As String Select Case S - Case "Object", "Any", "Variant", "Variant()": ConvertDataType = DefaultDataType + Case "Object", "Any", "Variant()": ConvertDataType = DefaultDataType Case "Form", "Control": ConvertDataType = "Window" Case "String": ConvertDataType = "string" Case "String()": ConvertDataType = "List" diff --git a/prj.vbp b/prj.vbp index e5a7a4a..2d9812b 100644 --- a/prj.vbp +++ b/prj.vbp @@ -34,6 +34,8 @@ Module=modConvert; modConvert.bas Module=modVB6ToCS; modVB6ToCS.bas Module=modRefScan; modRefScan.bas Module=modUtils; modUtils.bas +Module=modQuickConvert; modQuickConvert.bas +Module=modOrigConvert; modOrigConvert.bas IconForm="frm" Startup="frm" HelpFile="" diff --git a/prj.vbw b/prj.vbw index e114935..1d29049 100644 --- a/prj.vbw +++ b/prj.vbw @@ -1,25 +1,27 @@ -frm = 26, 26, 990, 342, C, 0, 0, 964, 316, C modProjectFiles = 52, 52, 1016, 368, C modTextFiles = 104, 104, 1068, 420, C -modRegEx = 78, 78, 1042, 394, C frmTest = 104, 104, 1068, 420, C -modConvertForm = 78, 78, 1042, 394, C modSubTracking = 52, 52, 1016, 388, C -modUsingEverything = 130, 130, 1068, 459, C -modSupportFiles = 130, 130, 1068, 459, C -modConfig = 130, 130, 1068, 460, C modConvertUtils = 78, 78, 870, 385, C -modControlProperties = 130, 130, 896, 463, C modProjectSpecific = 130, 130, 896, 466, C frmConfig = 78, 78, 1477, 574, C, 52, 52, 1451, 548, C modINI = 208, 208, 1647, 732, C modGit = 104, 104, 1376, 580, C modDirStack = 130, 130, 1402, 606, C -modShell = 156, 156, 1428, 632, C modTestCases = 52, 52, 1364, 576, C -modQuickLint = 52, 52, 1364, 576, Z -frmLinter = 0, 0, 0, 0, C, 0, 0, 0, 0, C +frmLinter = 78, 78, 1131, 555, C, 104, 104, 1157, 581, C +frm = 26, 26, 990, 342, C, 0, 0, 964, 316, C +modRegEx = 78, 78, 1042, 394, C +modConvertForm = 78, 78, 1042, 394, C +modUsingEverything = 130, 130, 1068, 459, C +modSupportFiles = 130, 130, 1068, 459, C +modConfig = 130, 130, 1068, 460, C +modControlProperties = 130, 130, 896, 463, C +modShell = 156, 156, 1428, 632, C +modQuickLint = 52, 52, 1364, 576, C modConvert = 52, 52, 1016, 368, C modVB6ToCS = 0, 0, 938, 329, C modRefScan = 156, 156, 922, 484, C modUtils = 22, 30, 986, 609, C +modQuickConvert = 25, 98, 1078, 575, Z +modOrigConvert = 0, 0, 1309, 524, C diff --git a/quick/App.config b/quick/App.config new file mode 100644 index 0000000..d4df07f --- /dev/null +++ b/quick/App.config @@ -0,0 +1,6 @@ + + + + + + diff --git a/quick/App.xaml.cs b/quick/App.xaml.cs new file mode 100644 index 0000000..d220d94 --- /dev/null +++ b/quick/App.xaml.cs @@ -0,0 +1,17 @@ +using System; +using System.Collections.Generic; +using System.Configuration; +using System.Data; +using System.Linq; +using System.Threading.Tasks; +using System.Windows; + +namespace VB2CS +{ + /// + /// Interaction logic for App.xaml + /// + public partial class App : Application + { + } +} diff --git a/quick/Forms/frm.xaml b/quick/Forms/frm.xaml new file mode 100644 index 0000000..98a7744 --- /dev/null +++ b/quick/Forms/frm.xaml @@ -0,0 +1,35 @@ + + + + + + +