├── .gitattributes ├── .gitignore ├── Debug ├── Module1.bas ├── Proyecto1.exe.manifest ├── Proyecto1.vbp ├── Proyecto1.vbw └── clsTestClass.cls ├── openmsvbvm.sln └── openmsvbvm ├── ClassFactory.cpp ├── ClassFactory.h ├── DllObjectInterface.cpp ├── DllObjectInterface.h ├── README.md ├── Resource.rc ├── Source.def ├── dllmain.cpp ├── openmsvbvm.vcxproj ├── openmsvbvm.vcxproj.filters ├── resource.h ├── vba_Arrays.cpp ├── vba_CommandLine.cpp ├── vba_CommandLine.h ├── vba_DateManipulation.cpp ├── vba_DllFunctionCall.cpp ├── vba_File.cpp ├── vba_InputBox.cpp ├── vba_InteractionFunctions.cpp ├── vba_Locale.cpp ├── vba_Locale.h ├── vba_MessageBox.cpp ├── vba_Settings.cpp ├── vba_enums.h ├── vba_exception.cpp ├── vba_exception.h ├── vba_exceptions.cpp ├── vba_internal.h ├── vba_internal_coordinates.h ├── vba_internal_includes.h ├── vba_objApp.cpp ├── vba_objApp.h ├── vba_objApp.idl ├── vba_objApp_h.h ├── vba_objManipulation.cpp ├── vba_objManipulation.h ├── vba_objVBGlobal.cpp ├── vba_objVBGlobal.h ├── vba_objVBGlobal.idl ├── vba_objVBGlobal_h.h ├── vba_ole_bridge_macros.h ├── vba_strComparation.cpp ├── vba_strConversion.cpp ├── vba_strManipulation.cpp ├── vba_strManipulation.h ├── vba_structures.h ├── vba_varManipulation.cpp └── vba_varManipulation.h /.gitattributes: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | # Set default behavior to automatically normalize line endings. 3 | ############################################################################### 4 | * text=auto 5 | 6 | ############################################################################### 7 | # Set default behavior for command prompt diff. 8 | # 9 | # This is need for earlier builds of msysgit that does not have it on by 10 | # default for csharp files. 11 | # Note: This is only used by command line 12 | ############################################################################### 13 | #*.cs diff=csharp 14 | 15 | ############################################################################### 16 | # Set the merge driver for project and solution files 17 | # 18 | # Merging from the command prompt will add diff markers to the files if there 19 | # are conflicts (Merging from VS is not affected by the settings below, in VS 20 | # the diff markers are never inserted). Diff markers may cause the following 21 | # file extensions to fail to load in VS. An alternative would be to treat 22 | # these files as binary and thus will always conflict and require user 23 | # intervention with every merge. To do so, just uncomment the entries below 24 | ############################################################################### 25 | #*.sln merge=binary 26 | #*.csproj merge=binary 27 | #*.vbproj merge=binary 28 | #*.vcxproj merge=binary 29 | #*.vcproj merge=binary 30 | #*.dbproj merge=binary 31 | #*.fsproj merge=binary 32 | #*.lsproj merge=binary 33 | #*.wixproj merge=binary 34 | #*.modelproj merge=binary 35 | #*.sqlproj merge=binary 36 | #*.wwaproj merge=binary 37 | 38 | ############################################################################### 39 | # behavior for image files 40 | # 41 | # image files are treated as binary by default. 42 | ############################################################################### 43 | #*.jpg binary 44 | #*.png binary 45 | #*.gif binary 46 | 47 | ############################################################################### 48 | # diff behavior for common document formats 49 | # 50 | # Convert binary document formats to text before diffing them. This feature 51 | # is only available from the command line. Turn it on by uncommenting the 52 | # entries below. 53 | ############################################################################### 54 | #*.doc diff=astextplain 55 | #*.DOC diff=astextplain 56 | #*.docx diff=astextplain 57 | #*.DOCX diff=astextplain 58 | #*.dot diff=astextplain 59 | #*.DOT diff=astextplain 60 | #*.pdf diff=astextplain 61 | #*.PDF diff=astextplain 62 | #*.rtf diff=astextplain 63 | #*.RTF diff=astextplain 64 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ## Ignore Visual Studio temporary files, build results, and 2 | ## files generated by popular Visual Studio add-ons. 3 | 4 | # User-specific files 5 | *.suo 6 | *.user 7 | *.userosscache 8 | *.sln.docstates 9 | 10 | # User-specific files (MonoDevelop/Xamarin Studio) 11 | *.userprefs 12 | 13 | # Build results 14 | # Removed, so we can have a VB6 test project there [Dd]ebug/ 15 | [Dd]ebugPublic/ 16 | [Rr]elease/ 17 | [Rr]eleases/ 18 | x64/ 19 | x86/ 20 | bld/ 21 | [Bb]in/ 22 | [Oo]bj/ 23 | [Ll]og/ 24 | 25 | # Visual Studio 2015 cache/options directory 26 | .vs/ 27 | # Uncomment if you have tasks that create the project's static files in wwwroot 28 | #wwwroot/ 29 | 30 | # MSTest test Results 31 | [Tt]est[Rr]esult*/ 32 | [Bb]uild[Ll]og.* 33 | 34 | # NUNIT 35 | *.VisualState.xml 36 | TestResult.xml 37 | 38 | # Build Results of an ATL Project 39 | [Dd]ebugPS/ 40 | [Rr]eleasePS/ 41 | dlldata.c 42 | 43 | # DNX 44 | project.lock.json 45 | project.fragment.lock.json 46 | artifacts/ 47 | 48 | *_i.c 49 | *_p.c 50 | *_i.h 51 | *.ilk 52 | *.meta 53 | *.obj 54 | *.pch 55 | *.pdb 56 | *.pgc 57 | *.pgd 58 | *.rsp 59 | *.sbr 60 | *.tlb 61 | *.tli 62 | *.tlh 63 | *.tmp 64 | *.tmp_proj 65 | *.log 66 | *.vspscc 67 | *.vssscc 68 | .builds 69 | *.pidb 70 | *.svclog 71 | *.scc 72 | 73 | # Chutzpah Test files 74 | _Chutzpah* 75 | 76 | # Visual C++ cache files 77 | ipch/ 78 | *.aps 79 | *.ncb 80 | *.opendb 81 | *.opensdf 82 | *.sdf 83 | *.cachefile 84 | *.VC.db 85 | *.VC.VC.opendb 86 | 87 | # Visual Studio profiler 88 | *.psess 89 | *.vsp 90 | *.vspx 91 | *.sap 92 | 93 | # TFS 2012 Local Workspace 94 | $tf/ 95 | 96 | # Guidance Automation Toolkit 97 | *.gpState 98 | 99 | # ReSharper is a .NET coding add-in 100 | _ReSharper*/ 101 | *.[Rr]e[Ss]harper 102 | *.DotSettings.user 103 | 104 | # JustCode is a .NET coding add-in 105 | .JustCode 106 | 107 | # TeamCity is a build add-in 108 | _TeamCity* 109 | 110 | # DotCover is a Code Coverage Tool 111 | *.dotCover 112 | 113 | # NCrunch 114 | _NCrunch_* 115 | .*crunch*.local.xml 116 | nCrunchTemp_* 117 | 118 | # MightyMoose 119 | *.mm.* 120 | AutoTest.Net/ 121 | 122 | # Web workbench (sass) 123 | .sass-cache/ 124 | 125 | # Installshield output folder 126 | [Ee]xpress/ 127 | 128 | # DocProject is a documentation generator add-in 129 | DocProject/buildhelp/ 130 | DocProject/Help/*.HxT 131 | DocProject/Help/*.HxC 132 | DocProject/Help/*.hhc 133 | DocProject/Help/*.hhk 134 | DocProject/Help/*.hhp 135 | DocProject/Help/Html2 136 | DocProject/Help/html 137 | 138 | # Click-Once directory 139 | publish/ 140 | 141 | # Publish Web Output 142 | *.[Pp]ublish.xml 143 | *.azurePubxml 144 | # TODO: Comment the next line if you want to checkin your web deploy settings 145 | # but database connection strings (with potential passwords) will be unencrypted 146 | #*.pubxml 147 | *.publishproj 148 | 149 | # Microsoft Azure Web App publish settings. Comment the next line if you want to 150 | # checkin your Azure Web App publish settings, but sensitive information contained 151 | # in these scripts will be unencrypted 152 | PublishScripts/ 153 | 154 | # NuGet Packages 155 | *.nupkg 156 | # The packages folder can be ignored because of Package Restore 157 | **/packages/* 158 | # except build/, which is used as an MSBuild target. 159 | !**/packages/build/ 160 | # Uncomment if necessary however generally it will be regenerated when needed 161 | #!**/packages/repositories.config 162 | # NuGet v3's project.json files produces more ignoreable files 163 | *.nuget.props 164 | *.nuget.targets 165 | 166 | # Microsoft Azure Build Output 167 | csx/ 168 | *.build.csdef 169 | 170 | # Microsoft Azure Emulator 171 | ecf/ 172 | rcf/ 173 | 174 | # Windows Store app package directories and files 175 | AppPackages/ 176 | BundleArtifacts/ 177 | Package.StoreAssociation.xml 178 | _pkginfo.txt 179 | 180 | # Visual Studio cache files 181 | # files ending in .cache can be ignored 182 | *.[Cc]ache 183 | # but keep track of directories ending in .cache 184 | !*.[Cc]ache/ 185 | 186 | # Others 187 | ClientBin/ 188 | ~$* 189 | *~ 190 | *.dbmdl 191 | *.dbproj.schemaview 192 | *.jfm 193 | *.pfx 194 | *.publishsettings 195 | node_modules/ 196 | orleans.codegen.cs 197 | 198 | # Since there are multiple workflows, uncomment next line to ignore bower_components 199 | # (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) 200 | #bower_components/ 201 | 202 | # RIA/Silverlight projects 203 | Generated_Code/ 204 | 205 | # Backup & report files from converting an old project file 206 | # to a newer Visual Studio version. Backup files are not needed, 207 | # because we have git ;-) 208 | _UpgradeReport_Files/ 209 | Backup*/ 210 | UpgradeLog*.XML 211 | UpgradeLog*.htm 212 | 213 | # SQL Server files 214 | *.mdf 215 | *.ldf 216 | 217 | # Business Intelligence projects 218 | *.rdl.data 219 | *.bim.layout 220 | *.bim_*.settings 221 | 222 | # Microsoft Fakes 223 | FakesAssemblies/ 224 | 225 | # GhostDoc plugin setting file 226 | *.GhostDoc.xml 227 | 228 | # Node.js Tools for Visual Studio 229 | .ntvs_analysis.dat 230 | 231 | # Visual Studio 6 build log 232 | *.plg 233 | 234 | # Visual Studio 6 workspace options file 235 | *.opt 236 | 237 | # Visual Studio LightSwitch build output 238 | **/*.HTMLClient/GeneratedArtifacts 239 | **/*.DesktopClient/GeneratedArtifacts 240 | **/*.DesktopClient/ModelManifest.xml 241 | **/*.Server/GeneratedArtifacts 242 | **/*.Server/ModelManifest.xml 243 | _Pvt_Extensions 244 | 245 | # Paket dependency manager 246 | .paket/paket.exe 247 | paket-files/ 248 | 249 | # FAKE - F# Make 250 | .fake/ 251 | 252 | # JetBrains Rider 253 | .idea/ 254 | *.sln.iml 255 | 256 | # CodeRush 257 | .cr/ 258 | 259 | # Python Tools for Visual Studio (PTVS) 260 | __pycache__/ 261 | *.pyc 262 | 263 | openmsvbvm/[Dd]ebug/ 264 | openmsvbvm/[Rr]elease/ -------------------------------------------------------------------------------- /Debug/Module1.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "Module1" 2 | Option Explicit 3 | 4 | Private Declare Function GetVersion Lib "kernel32" () As Long 5 | Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long 6 | Private Declare Function MessageBoxW Lib "user32" (ByVal hwnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal wType As Long) As Long 7 | Private Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long 8 | 9 | 10 | Private Declare Sub InitCommonControls Lib "comctl32" () 11 | 12 | Private Type tTest 13 | sString As String 14 | 'sFixedString As String * 30 15 | lLong As Long 16 | iInteger As Integer 17 | End Type 18 | 19 | Sub Main() 20 | 'Call InitCommonControls 21 | 22 | Call OnErrorGotoTest 23 | 24 | 'Call OnErrorResumeNextTest 25 | 26 | 'Call FPExceptionTest 27 | 28 | 'Call DllStringCallTest 29 | 30 | 'Call MsgboxReturnCodeTest 31 | 32 | 'Call StrCompTest 33 | 34 | 'Dim s As String 35 | 's = Replace$("This is a test", "test", "sample") 36 | 'MsgBox s 37 | 38 | 'Call ObjectCreateTest 39 | 40 | 'Call DateTest 41 | 42 | 'Call InputBoxTest 43 | 44 | 'Call ToStringConversionTest 45 | 46 | 'Call ObjectAppInteractionTest 47 | 48 | 'Call FileManipulationTest 49 | 50 | 'Call StringCopyTest 51 | 52 | 'Call ClassCreationTest 53 | 54 | 'Call ArraysTest 55 | 56 | 'Call VBAInteractionTest 57 | 58 | 'Call llmul 59 | 60 | Debug.Print "ASD" 61 | 62 | MsgBox "END" 63 | End Sub 64 | 65 | Private Sub llmul() 66 | Dim a As Currency 67 | Dim b As Currency 68 | Dim c As Currency 69 | a = -1.3333@ 70 | b = 1.2@ 71 | c = a * b 72 | 'MsgBox c 73 | End Sub 74 | Private Sub ArraysTest() 75 | 'Dim strArray() As String 76 | 'ReDim strArray(36) 77 | 'strArray(0) = "One" 78 | 'strArray(1) = "Two" 79 | 'strArray(2) = "Three" 80 | 'ReDim Preserve strArray(69) 81 | 'strArray(3) = "Four" 82 | 'MsgBox strArray(3) 83 | 'MsgBox "UBound() = " & UBound(strArray) & " - LBound() = " & LBound(strArray) 84 | 85 | 86 | Dim tUDTArray(30) As tTest 87 | 'ReDim tUDTArray(30) 88 | 'tUDTArray(0).sFixedString = "HAHAHA" 89 | With tUDTArray(0) 90 | .lLong = &HC0C0C0C0 91 | .sString = "string" 92 | End With 93 | 94 | With tUDTArray(0) 95 | MsgBox "tUDTArray(0)" & vbCrLf & _ 96 | vbTab & ".sString = '" & .sString & "'" & vbCrLf & _ 97 | vbTab & ".lLong = " & Hex(.lLong) 98 | End With 99 | End Sub 100 | 101 | Private Sub VBAInteractionTest() 102 | 'VBA.AppActivate "Debug", 300 103 | 'VBA.Beep 104 | Dim s(4) As Variant 105 | s(0) = "Zero" 106 | s(1) = "One" 107 | s(2) = "Two" 108 | s(3) = "Three" 109 | MsgBox VBA.Choose(2147483600, "Zero", "One", "Two", "Three") 110 | 'MsgBox "Command() = " & Command() & vbCrLf & "Command$() = " & Command$() 111 | 'SaveSetting "ItsMeMario", "Section", "Key", "Setting" 112 | 'MsgBox "GetSetting = " & GetSetting("ItsMeMario", "Section", "Key") ', "ThisIsADefaultValue") 113 | 'DeleteSetting "ItsMeMario", "Section", "Key" 114 | 'MsgBox Environ("TMP") '("TMP") 115 | 'MsgBox IIf(0, Environ("TMP"), Environ("PATH")) 116 | 'MsgBox Partition(10, 0, 100, 5) 117 | 'SendKeys "A", 333 118 | 'MsgBox Switch(False, "should not happen 1", False, "should not happen 2", True, "Yes!!") 119 | End Sub 120 | 121 | Private Sub OnErrorGotoTest() 122 | On Error GoTo fnErrHandler 123 | 'On Error Resume Next 124 | MsgBox "This should happen" 125 | MsgBox 1 / 0 126 | fnNonErrHandler: 127 | MsgBox "This should not be visible" 128 | fnErrHandler: 129 | MsgBox "OnErrorTest() end" 130 | End Sub 131 | 132 | Private Sub OnErrorResumeNextTest() 133 | 'On Error Resume Next 134 | MsgBox "This should happen" 135 | MsgBox 1 / 0 136 | fnNonErrHandler: 137 | MsgBox "This should not be visible" 138 | fnErrHandler: 139 | MsgBox "OnErrorTest() end" 140 | End Sub 141 | 142 | Private Sub MsgboxReturnCodeTest() 143 | Select Case MsgBox("Just a messagebox and the command is " & Command$, vbInformation + vbYesNoCancel, "Just the title") 144 | Case vbYes: MsgBox UCase$("Yes"): Shell "calc" 145 | Case vbNo: MsgBox LCase$("No") 146 | Case vbCancel: MsgBox "Cancel" 147 | End Select 148 | End Sub 149 | 150 | Private Sub StringCaseTest() 151 | MsgBox LCase$("LCASE") & " " & UCase$("ucase") 152 | End Sub 153 | 154 | Private Sub StrCompTest() 155 | Dim l As Long 156 | l = StrComp("lcase", "XXXCASE") ', vbTextCompare) 157 | MsgBox "strcomp = " & l 158 | End Sub 159 | 160 | Private Sub DllStringCallTest() 161 | MessageBox 0, "Testing", "Title", vbOK 162 | End Sub 163 | 164 | Private Sub FPExceptionTest() 165 | 'MsgBox 2147483647 + 1 166 | MsgBox 1 / 0 167 | End Sub 168 | 169 | Private Sub DateTest() 170 | Dim t As Date 171 | t = Now 172 | MsgBox "asd " & t 173 | End Sub 174 | 175 | Private Sub ClassCreationTest() 176 | Dim j As clsTestClass3 177 | Set j = New clsTestClass3 178 | 'j.Pelotudo True 179 | 'MsgBox "delay?" 180 | 'j.Exported2 181 | 'j.SetTrue 182 | 'j.Exported2 183 | 'j.SetFalse 184 | 'j.Exported2 185 | 186 | j.SetString "TESTTTTTTTT!!!!!" 187 | j.MsgboxString True 188 | 189 | Set j = Nothing 190 | 191 | End Sub 192 | 193 | Private Sub StringCopyTest() 194 | Dim s As String 195 | Dim s2 As String 196 | s = "This is S" 197 | s2 = s 198 | MsgBox s2 199 | End Sub 200 | 201 | Private Sub FileManipulationTest() 202 | Dim l As Long 203 | Open "file-wb.txt" For Binary Access Write As #69 204 | 'Put #69, , "string" 205 | 'Put #69, , &HC0C0 206 | Put #69, , &HC0C0C0C0 207 | 'Put #69, , 1.11113 208 | Close #69 209 | 210 | 'Open "file-rb.txt" For Binary Access Read As #69 211 | Open "file-wb.txt" For Binary Access Read As #69 212 | Get #69, , l 213 | 214 | 'MsgBox l & " and should be " & &HC0C0C0C0 215 | 216 | MsgBox "Fsize = " & LOF(69) 217 | Seek 69, 1 218 | 219 | Close #69 220 | Exit Sub 221 | 222 | 223 | Open "file-rwb.txt" For Binary Access Read Write As #69 224 | Close #69 225 | 226 | Open "file-out.txt" For Output As #69 227 | Close #69 228 | 229 | Open "file-in.txt" For Input As #69 230 | Close #69 231 | 232 | Open "file-rand.txt" For Random As #69 233 | Close #69 234 | 235 | Open "file-out-w.txt" For Output Access Write As #69 236 | Close #69 237 | 238 | Open "file-in-r.txt" For Input Access Read As #69 239 | Close #69 240 | 241 | Open "file-rand.txt" For Random As #69 242 | Close #69 243 | End Sub 244 | 245 | Private Sub InputBoxTest() 246 | MsgBox InputBox$("This is the caption of the inputbox", 123456789, "this should be the default value", , , "HelpFile", 6969), vbInformation + vbOKOnly 247 | End Sub 248 | 249 | Private Sub ToStringConversionTest() 250 | MsgBox CStr(True) & " " & CStr(1&) & " " & CStr(1#) & " " & CStr(1.1) & " " & CStr(3.1416949383838) 251 | End Sub 252 | 253 | Private Sub ObjectCreateTest() 254 | 'Call CreateObject("NonExisting") 255 | Call CreateObject("Scripting.FileSystemObject").CreateTextFile("test.txt", True) 256 | MsgBox CreateObject("Scripting.FileSystemObject").GetSpecialFolder(0) 257 | MsgBox CreateObject("Scripting.FileSystemObject").FileExists("test.txt") 258 | End Sub 259 | 260 | Private Sub ObjectAppInteractionTest() 261 | MsgBox "App.Title = " & App.Title & vbCrLf & _ 262 | "App.EXEName = " & App.EXEName & vbCrLf & _ 263 | "App.Path = " & App.Path 264 | End Sub 265 | 266 | -------------------------------------------------------------------------------- /Debug/Proyecto1.exe.manifest: -------------------------------------------------------------------------------- 1 | 2 | 3 | 8 | Microsoft Visual Basic 9 | 10 | 11 | 19 | 20 | 21 | 22 | 23 | 24 | 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /Debug/Proyecto1.vbp: -------------------------------------------------------------------------------- 1 | Type=Exe 2 | Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\Windows\SysWOW64\stdole2.tlb#OLE Automation 3 | Module=Module1; Module1.bas 4 | Class=clsTestClass3; clsTestClass.cls 5 | Startup="Sub Main" 6 | HelpFile="" 7 | Title="Proyecto1sddasdasd" 8 | ExeName32="Proyecto1.exe" 9 | Command32="" 10 | Name="Proyecto1" 11 | HelpContextID="0" 12 | CompatibleMode="0" 13 | MajorVer=1 14 | MinorVer=0 15 | RevisionVer=0 16 | AutoIncrementVer=0 17 | ServerSupportFiles=0 18 | VersionCompanyName="Cocus Devices" 19 | CompilationType=0 20 | OptimizationType=0 21 | FavorPentiumPro(tm)=0 22 | CodeViewDebugInfo=-1 23 | NoAliasing=0 24 | BoundsCheck=0 25 | OverflowCheck=0 26 | FlPointCheck=0 27 | FDIVCheck=0 28 | UnroundedFP=0 29 | StartMode=0 30 | Unattended=0 31 | Retained=0 32 | ThreadPerObject=0 33 | MaxNumberOfThreads=1 34 | 35 | [vbAdvance] 36 | IsConsole=0 37 | HasStubFile=0 38 | GenerateMap=0 39 | TSAware=0 40 | XPManifest=1 41 | ResBuildName=.\Proyecto1.dll 42 | ReplaceIcon=0 43 | SendCommandArgs=0 44 | SymbDbgPref=0 45 | RevisionVersion=0 46 | -------------------------------------------------------------------------------- /Debug/Proyecto1.vbw: -------------------------------------------------------------------------------- 1 | Module1 = 343, 0, 1735, 520, 2 | clsTestClass3 = 52, 52, 786, 418, C 3 | -------------------------------------------------------------------------------- /Debug/clsTestClass.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | Persistable = 0 'NotPersistable 5 | DataBindingBehavior = 0 'vbNone 6 | DataSourceBehavior = 0 'vbNone 7 | MTSTransactionMode = 0 'NotAnMTSObject 8 | END 9 | Attribute VB_Name = "clsTestClass3" 10 | Attribute VB_GlobalNameSpace = False 11 | Attribute VB_Creatable = True 12 | Attribute VB_PredeclaredId = False 13 | Attribute VB_Exposed = False 14 | Option Explicit 15 | 16 | Private c_bTesting As Boolean 17 | 18 | Private c_sString As String 19 | 20 | 'Public puto1 As Long 21 | 'Public puto2 As Long 22 | 23 | 'Private c_bTesting2 As Boolean 24 | 25 | 'Private c_bTesting22 As Boolean 26 | 'Private c_bTesting222 As Boolean 27 | 28 | Private Sub Class_Initialize() 29 | MsgBox "Class_Initialize()" 30 | c_bTesting = True 31 | End Sub 32 | 33 | Public Sub SetTrue() 34 | c_bTesting = True 35 | End Sub 36 | 37 | Public Sub SetFalse() 38 | c_bTesting = False 39 | End Sub 40 | 41 | Public Sub SetString(ByVal sString As String) 42 | c_sString = sString 43 | End Sub 44 | 45 | Public Function MsgboxString(ByVal bYesNo As Boolean) As Boolean 46 | MsgBox c_sString & " " & CStr(c_bTesting) 47 | MsgboxString = True 48 | End Function 49 | 50 | Public Function Exported2() As Boolean 51 | MsgBox "Exported2Called!!! " & c_bTesting & " " & Hex(VarPtr(Me)) 52 | Exported2 = False 53 | End Function 54 | 55 | Private Sub Class_Terminate() 56 | MsgBox "Class_Terminate()" 57 | End Sub 58 | -------------------------------------------------------------------------------- /openmsvbvm.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio 15 4 | VisualStudioVersion = 15.0.27703.2042 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "openmsvbvm", "openmsvbvm\openmsvbvm.vcxproj", "{308A6CD3-E957-45F1-814F-05228F69D9EE}" 7 | EndProject 8 | Global 9 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 10 | Debug|x64 = Debug|x64 11 | Debug|x86 = Debug|x86 12 | Release|x64 = Release|x64 13 | Release|x86 = Release|x86 14 | EndGlobalSection 15 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 16 | {308A6CD3-E957-45F1-814F-05228F69D9EE}.Debug|x64.ActiveCfg = Debug|x64 17 | {308A6CD3-E957-45F1-814F-05228F69D9EE}.Debug|x64.Build.0 = Debug|x64 18 | {308A6CD3-E957-45F1-814F-05228F69D9EE}.Debug|x86.ActiveCfg = Debug|Win32 19 | {308A6CD3-E957-45F1-814F-05228F69D9EE}.Debug|x86.Build.0 = Debug|Win32 20 | {308A6CD3-E957-45F1-814F-05228F69D9EE}.Release|x64.ActiveCfg = Release|x64 21 | {308A6CD3-E957-45F1-814F-05228F69D9EE}.Release|x64.Build.0 = Release|x64 22 | {308A6CD3-E957-45F1-814F-05228F69D9EE}.Release|x86.ActiveCfg = Release|Win32 23 | {308A6CD3-E957-45F1-814F-05228F69D9EE}.Release|x86.Build.0 = Release|Win32 24 | EndGlobalSection 25 | GlobalSection(SolutionProperties) = preSolution 26 | HideSolutionNode = FALSE 27 | EndGlobalSection 28 | GlobalSection(ExtensibilityGlobals) = postSolution 29 | SolutionGuid = {9234912D-D44A-4061-9C55-5E049DF09CC5} 30 | EndGlobalSection 31 | EndGlobal 32 | -------------------------------------------------------------------------------- /openmsvbvm/ClassFactory.cpp: -------------------------------------------------------------------------------- 1 | #include "ClassFactory.h" 2 | 3 | #include "vba_objApp.h" 4 | #include "vba_objVBGlobal.h" 5 | 6 | 7 | 8 | extern ULONG g_ServerLocks; 9 | 10 | CMasterFactory::CMasterFactory() : m_nRefCount(1) 11 | { 12 | } 13 | 14 | CMasterFactory::~CMasterFactory() 15 | { 16 | } 17 | 18 | HRESULT __stdcall CMasterFactory::QueryInterface(REFIID riid, void ** ppObj) 19 | { 20 | HRESULT rc = S_OK; 21 | 22 | if (riid == IID_IUnknown) 23 | { 24 | *ppObj = (IUnknown*)this; 25 | } 26 | else if (riid == IID_IClassFactory) 27 | { 28 | *ppObj = (IClassFactory*)this; 29 | } 30 | /*else if (riid == IID_IVBGlobal) 31 | { 32 | 33 | }*/ 34 | else rc = E_NOINTERFACE; 35 | 36 | if (rc == S_OK) 37 | this->AddRef(); 38 | 39 | return rc; 40 | } 41 | 42 | ULONG __stdcall CMasterFactory::AddRef() 43 | { 44 | InterlockedIncrement(&m_nRefCount); 45 | 46 | return this->m_nRefCount; 47 | } 48 | 49 | ULONG __stdcall CMasterFactory::Release() 50 | { 51 | InterlockedDecrement(&m_nRefCount); 52 | 53 | if (this->m_nRefCount == 0) 54 | { 55 | delete this; 56 | return 0; 57 | } 58 | else 59 | { 60 | return this->m_nRefCount; 61 | } 62 | } 63 | 64 | HRESULT __stdcall CMasterFactory::CreateInstance( 65 | IUnknown * pUnknownOuter, 66 | const IID & iid, 67 | void ** ppv) 68 | { 69 | HRESULT rc = E_UNEXPECTED; 70 | 71 | if (pUnknownOuter != NULL) 72 | { 73 | rc = CLASS_E_NOAGGREGATION; 74 | } 75 | else if (iid == IID_IVBGlobal) 76 | { 77 | IUnknown* p; 78 | if ((p = new CVBGlobal()) == NULL) 79 | { 80 | rc = E_OUTOFMEMORY; 81 | } 82 | else { 83 | rc = p->QueryInterface(iid, ppv); 84 | p->Release(); 85 | } 86 | } 87 | else if (iid == IID_IApp) 88 | { 89 | IUnknown* p; 90 | if ((p = new CApp()) == NULL) 91 | { 92 | rc = E_OUTOFMEMORY; 93 | } 94 | else { 95 | rc = p->QueryInterface(iid, ppv); 96 | p->Release(); 97 | } 98 | } 99 | return rc; 100 | } 101 | 102 | HRESULT __stdcall CMasterFactory::LockServer(BOOL bLock) 103 | { 104 | if (bLock) 105 | { 106 | InterlockedIncrement((LONG*)&(g_ServerLocks)); 107 | } 108 | else 109 | { 110 | InterlockedDecrement((LONG*)&(g_ServerLocks)); 111 | } 112 | 113 | return S_OK; 114 | } 115 | -------------------------------------------------------------------------------- /openmsvbvm/ClassFactory.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cocus/openmsvbvm/1ad89d89b91d76f5c5c0937be6e22264cc272e9c/openmsvbvm/ClassFactory.h -------------------------------------------------------------------------------- /openmsvbvm/DllObjectInterface.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | 4 | #include "DllObjectInterface.h" 5 | #include "ClassFactory.h" 6 | 7 | #include "vba_objVBGlobal.h" 8 | #include "vba_objApp.h" 9 | 10 | ULONG g_ServerLocks = 0; 11 | ULONG g_Components = 0; 12 | 13 | GUID CLSID_VBGlobal = { 0xfcfb3d23, 0xa0fa, 0x1068, { 0xa7, 0x38, 0x08, 0x00, 0x2b, 0x33, 0x71, 0xb5 } }; 14 | // 33ad4f78-6699-11cf-b70c-00aa0060d393 15 | GUID CLSID_App = { 0xfcfb3d23, 0xa0fa, 0x1068, { 0xa7, 0x38, 0x08, 0x00, 0x2b, 0x33, 0x71, 0xb5 } }; // TODO: Fix this GUID 16 | 17 | 18 | STDAPI DllCanUnloadNow(void) 19 | { 20 | HRESULT rc = E_UNEXPECTED; 21 | 22 | if ((g_ServerLocks == 0) && (g_Components == 0)) 23 | { 24 | rc = S_OK; 25 | } 26 | else 27 | { 28 | rc = S_FALSE; 29 | } 30 | return rc; 31 | }; 32 | 33 | CMasterFactory factory; 34 | 35 | STDAPI DllGetClassObject( 36 | const CLSID& clsid, 37 | const IID& iid, 38 | void **ppv 39 | ) 40 | { 41 | HRESULT rc = CLASS_E_CLASSNOTAVAILABLE; 42 | 43 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 44 | 45 | if (clsid == CLSID_VBGlobal) 46 | { 47 | DEBUG_WIDE( 48 | "clsid == CLSID_VBGlobal" 49 | ); 50 | rc = factory.CreateInstance(nullptr, iid, ppv); 51 | } 52 | else if (clsid == CLSID_App) 53 | { 54 | DEBUG_WIDE( 55 | "clsid == CLSID_App" 56 | ); 57 | rc = factory.CreateInstance(nullptr, iid, ppv); 58 | } 59 | 60 | return rc; 61 | }; -------------------------------------------------------------------------------- /openmsvbvm/DllObjectInterface.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include 4 | 5 | STDAPI DllGetClassObject(const CLSID& clsid, const IID& iid, void**ppv); -------------------------------------------------------------------------------- /openmsvbvm/README.md: -------------------------------------------------------------------------------- 1 | # What is this? 2 | This is an open source interpretation of what the MSVBVM60 library does. Such library is used in VB6 applications as a base-library, where most VB functions are implemented. 3 | 4 | # Why? 5 | Well, there's no need to do this, but since VB6 is getting outdated, an open source runtime library might add some years to VB6's lifespan. 6 | 7 | # How we did this? 8 | Since the source code of this library is not available, and reverse engineering the library is a no-go, we've used some tools to get the information we need. 9 | For instance, IDA was used against a dummy VB6 .exe file where the target function was called. 10 | API Monitor from ROHITAB was also used to check some runtime values and function calls from the original MSVBVM60.dll. 11 | Some reverse-engineering sites such as the ones listed in http://sandsprite.com/vb-reversing/ 12 | 13 | # How to contribute 14 | In order to contribute, please clone this repo, build it, and after you can run the example VB6 project, you can start adding new functionality. 15 | To do so, try to add a test in the dummy VB6 project and check if that doesn't work against this library. Normally these kind of errors are related to missing exported functions, so, it's easy to check what the original library did (using the methods described before). 16 | After the functionality is implemented, create a pull request. 17 | 18 | # Compiling the sources 19 | You'll need Visual Studio 2017 to compile the library. Just open the solution and build it (either Debug or Release). 20 | An example VB6 project is located inside the Debug folder. In order to compile it, you'll need VB6 installed. Compile the .exe of that project inside the Debug folder, and run it from either opening it directly from Explorer, or from "Run" in Visual Studio (launch configuration will open the VB6 project, and you can add debug the library from there). 21 | 22 | # Status of the library 23 | This library IS NOT A FULL replacement of the original library. So, don't expect to be a drop-in replacement. 24 | Currently, a small subset of the original library are implemented. 25 | Most notable ones: 26 | - Creation of ActiveX objects (CreateObject) 27 | - Access to the VBA object (Shell, Iif, etc.) 28 | - DLL function calls 29 | - MsgBox 30 | - InputBox 31 | -------------------------------------------------------------------------------- /openmsvbvm/Resource.rc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cocus/openmsvbvm/1ad89d89b91d76f5c5c0937be6e22264cc272e9c/openmsvbvm/Resource.rc -------------------------------------------------------------------------------- /openmsvbvm/Source.def: -------------------------------------------------------------------------------- 1 | LIBRARY 2 | EXPORTS 3 | 4 | __vbaChkstk @182 5 | 6 | ThunRTMain @100 7 | 8 | _adj_fdiv_m16i @659 9 | _adj_fdiv_m32 @688 10 | _adj_fdiv_m32i @701 11 | _adj_fdiv_m64 @718 12 | 13 | _adj_fdiv_r @719 14 | 15 | _adj_fdivr_m16i @720 16 | _adj_fdivr_m32 @721 17 | _adj_fdivr_m32i @722 18 | _adj_fdivr_m64 @723 19 | 20 | _adj_fprem @725 21 | _adj_fprem1 @726 22 | 23 | _CIatan @156 24 | _CIcos @157 25 | _CIexp @158 26 | _CIlog @159 27 | _CIsin @160 28 | _CIsqrt @161 29 | _CItan @162 30 | 31 | VarPtr @644 32 | 33 | 34 | __vbaCyMul @198 35 | _allmul @728 36 | 37 | ; vba_InteractionFunctions.cpp 38 | rtcChoose @665 39 | rtcShell @600 40 | rtcAppActivate @597 41 | rtcBeep @534 42 | rtcEnvironBstr @667 43 | rtcEnvironVar @666 44 | rtcImmediateIf @681 45 | rtcPartition @664 46 | rtcSendKeys @599 47 | 48 | ; vba_Settings.cpp 49 | rtcSaveSetting @690 50 | rtcDeleteSetting @691 51 | rtcGetSetting @689 52 | 53 | ; vba_Arrays.cpp 54 | __vbaAryDestruct @167 55 | __vbaGenerateBoundsError @246 56 | __vbaAryConstruct2 @164 57 | __vbaErase @213 58 | __vbaRedim @385 59 | __vbaRedimPreserve @386 60 | __vbaGenerateBoundsError @246 61 | __vbaAryDestruct @167 62 | __vbaAryLock @108 63 | __vbaAryUnlock @172 64 | __vbaLbound @325 65 | __vbaUbound @445 66 | 67 | ; vba_DllFunctionCall.cpp 68 | DllFunctionCall @187 69 | 70 | ; vba_DateManipulation.cpp 71 | rtcGetPresentDate @546 72 | __vbaDateVar @209 73 | 74 | ; vba_exception.cpp 75 | __vbaExitProc @223 76 | __vbaOnError @352 77 | __vbaExceptHandler @218 78 | __vbaFPException @224 79 | __vbaSetSystemError @394 80 | 81 | ; vba_File.cpp 82 | __vbaFileClose @229 83 | __vbaFileOpen @235 84 | __vbaPut3 @357 85 | __vbaGet3 @247 86 | rtcFileLength @570 87 | __vbaFileSeek @236 88 | 89 | ; vba_varManipulation.cpp 90 | __vbaVarCat @452 91 | rtcHexBstrFromVar @572 92 | rtcHexVarFromVar @573 93 | __vbaVarCopy @143 94 | __vbaVarDup @144 95 | __vbaVarMove @145 96 | __vbaFreeVar @131 97 | __vbaFreeVarList @245 98 | 99 | ; vba_objManipulation.cpp 100 | __vbaFreeObj @129 101 | __vbaHresultCheckObj @258 102 | __vbaNew2 @340 103 | __vbaNew @341 104 | __vbaFreeObjList @243 105 | rtcCreateObject2 @716 106 | __vbaObjVar @351 107 | __vbaVarLateMemCallLdRf @113 108 | __vbaVarLateMemCallLd @112 109 | __vbaVarAdd @450 110 | __vbaVarAnd @451 111 | __vbaVarDiv @460 112 | __vbaVarEqv @461 113 | __vbaVarIdiv @466 114 | __vbaVarImp @467 115 | __vbaVarMod @476 116 | __vbaVarMul @477 117 | __vbaVarOr @480 118 | __vbaVarPow @481 119 | __vbaVarSub @488 120 | __vbaVarXor @509 121 | __vbaObjSet @349 122 | __vbaObjSetAddref @350 123 | __vbaCastObj @178 124 | EVENT_SINK_QueryInterface @400 125 | EVENT_SINK_Release @402 126 | EVENT_SINK_AddRef @401 127 | 128 | ; vba_CommandLine.cpp 129 | rtcCommandBstr @669 130 | rtcCommandVar @670 131 | 132 | ; vba_InputBox.cpp 133 | rtcInputBox @596 134 | 135 | ; vba_MessageBox.cpp 136 | rtcMsgBox @595 137 | 138 | ; vba_strComparation.cpp 139 | __vbaStrComp @407 140 | 141 | ; vba_strConversion.cpp 142 | __vbaStrR8 @423 143 | __vbaStrR4 @422 144 | __vbaStrI4 @418 145 | __vbaStrI2 @417 146 | __vbaStrUI1 @428 147 | __vbaStrBool @399 148 | __vbaStrCy @409 149 | __vbaStrDate @415 150 | __vbaStrToAnsi @426 151 | 152 | ; vba_strManipulation.cpp 153 | rtcUpperCaseBstr @527 154 | rtcLowerCaseBstr @517 155 | rtcReplace @712 156 | __vbaStrCat @405 157 | __vbaStrMove @139 158 | __vbaFreeStr @130 159 | __vbaFreeStrList @244 160 | __vbaStrErrVarCopy @111 161 | __vbaStrVarCopy @429 162 | __vbaStrCopy @138 -------------------------------------------------------------------------------- /openmsvbvm/dllmain.cpp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cocus/openmsvbvm/1ad89d89b91d76f5c5c0937be6e22264cc272e9c/openmsvbvm/dllmain.cpp -------------------------------------------------------------------------------- /openmsvbvm/openmsvbvm.vcxproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Debug 6 | Win32 7 | 8 | 9 | Release 10 | Win32 11 | 12 | 13 | Debug 14 | x64 15 | 16 | 17 | Release 18 | x64 19 | 20 | 21 | 22 | 15.0 23 | {308A6CD3-E957-45F1-814F-05228F69D9EE} 24 | Win32Proj 25 | openmsvbvm 26 | 10.0.17134.0 27 | 28 | 29 | 30 | DynamicLibrary 31 | true 32 | v141 33 | NotSet 34 | 35 | 36 | DynamicLibrary 37 | false 38 | v141 39 | true 40 | NotSet 41 | 42 | 43 | DynamicLibrary 44 | true 45 | v141 46 | NotSet 47 | 48 | 49 | DynamicLibrary 50 | false 51 | v141 52 | true 53 | NotSet 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | true 75 | 76 | 77 | true 78 | 79 | 80 | false 81 | 82 | 83 | false 84 | 85 | 86 | 87 | NotUsing 88 | Level3 89 | Disabled 90 | true 91 | WIN32;_DEBUG;OPENMSVBVM_EXPORTS;_WINDOWS;_USRDLL;%(PreprocessorDefinitions) 92 | true 93 | true 94 | 95 | 96 | Windows 97 | true 98 | Source.def 99 | 100 | 101 | copy /Y "$(TargetPath)" "$(TargetDir)msvbvm60.dll" 102 | copy /Y "$(OutDir)$(TargetName).pdb" "$(TargetDir)msvbvm60.pdb" 103 | 104 | 105 | 106 | 107 | NotUsing 108 | Level3 109 | Disabled 110 | true 111 | _DEBUG;OPENMSVBVM_EXPORTS;_WINDOWS;_USRDLL;%(PreprocessorDefinitions) 112 | true 113 | 114 | 115 | Windows 116 | true 117 | Source.def 118 | 119 | 120 | copy /Y "$(TargetPath)" "$(TargetDir)msvbvm60.dll" 121 | 122 | 123 | 124 | 125 | NotUsing 126 | Level3 127 | MaxSpeed 128 | true 129 | true 130 | true 131 | WIN32;NDEBUG;OPENMSVBVM_EXPORTS;_WINDOWS;_USRDLL;%(PreprocessorDefinitions) 132 | true 133 | true 134 | 135 | 136 | Windows 137 | true 138 | true 139 | true 140 | Source.def 141 | 142 | 143 | copy /Y "$(TargetPath)" "$(TargetDir)msvbvm60.dll" 144 | copy /Y "$(OutDir)$(TargetName).pdb" "$(TargetDir)msvbvm60.pdb" 145 | 146 | 147 | 148 | 149 | NotUsing 150 | Level3 151 | MaxSpeed 152 | true 153 | true 154 | true 155 | NDEBUG;OPENMSVBVM_EXPORTS;_WINDOWS;_USRDLL;%(PreprocessorDefinitions) 156 | true 157 | 158 | 159 | Windows 160 | true 161 | true 162 | true 163 | Source.def 164 | 165 | 166 | copy /Y "$(TargetPath)" "$(TargetDir)msvbvm60.dll" 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 221 | 222 | 223 | 224 | 225 | 226 | 227 | 228 | -------------------------------------------------------------------------------- /openmsvbvm/openmsvbvm.vcxproj.filters: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | {4FC737F1-C7A5-4376-A066-2A32D752A2FF} 6 | cpp;c;cc;cxx;def;odl;idl;hpj;bat;asm;asmx 7 | 8 | 9 | {93995380-89BD-4b04-88EB-625FBE52EBFB} 10 | h;hh;hpp;hxx;hm;inl;inc;ipp;xsd 11 | 12 | 13 | {67DA6AB6-F800-4c08-8B7A-83BB121AAD01} 14 | rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe;resx;tiff;tif;png;wav;mfcribbon-ms 15 | 16 | 17 | {4f7e6775-5c4a-4130-82b8-e4e95a34d778} 18 | 19 | 20 | {2c77da8a-c0b4-456f-82d8-06716db6b34f} 21 | 22 | 23 | {bf5360b6-6851-428d-a416-821b161a335d} 24 | 25 | 26 | {d5697d40-1356-459d-897f-004eaf830560} 27 | 28 | 29 | {e909f5bd-4a4f-4805-83e3-2e5cfc475c2d} 30 | 31 | 32 | {0221a90a-5055-47e7-a567-0c1d1fb5027d} 33 | 34 | 35 | {491b344a-3ed1-4e1b-bbf4-4c2c3286a684} 36 | 37 | 38 | {5b7448b3-c642-4744-a705-f21049dc59c1} 39 | 40 | 41 | {7ba692a1-7c00-408f-9b18-5d3e81a3960a} 42 | 43 | 44 | {a97f4288-2f83-479d-b115-0a952d6d1e8b} 45 | 46 | 47 | {d126d7d0-5335-4ca6-b0ef-28c93bf48e42} 48 | 49 | 50 | {aa9f6b1d-443f-4afb-9937-9e81e3e8fa41} 51 | 52 | 53 | {fe6a04b3-275b-4072-9973-ecb71c10ee0d} 54 | 55 | 56 | {c028aac2-9484-42c2-bd76-a65d062db6c7} 57 | 58 | 59 | {795107e9-9fc4-43d8-a11b-2d4b86f1ae6d} 60 | 61 | 62 | {00ee610e-67d2-4e14-a88d-996ab32b8ccb} 63 | 64 | 65 | 66 | 67 | Archivos de origen 68 | 69 | 70 | Archivos de origen\String 71 | 72 | 73 | Archivos de origen\String 74 | 75 | 76 | Archivos de origen\String 77 | 78 | 79 | Archivos de origen\InputBox 80 | 81 | 82 | Archivos de origen\ObjectInterface 83 | 84 | 85 | Archivos de origen\Objects\VBGlobal 86 | 87 | 88 | Archivos de origen\Objects\App 89 | 90 | 91 | Archivos de origen\Objects\VBGlobal 92 | 93 | 94 | Archivos de origen\Objects\App 95 | 96 | 97 | Archivos de origen\Objects 98 | 99 | 100 | Archivos de origen\Objects 101 | 102 | 103 | Archivos de origen\Variant 104 | 105 | 106 | Archivos de origen\File 107 | 108 | 109 | Archivos de origen\MessageBox 110 | 111 | 112 | Archivos de origen\CommandLine 113 | 114 | 115 | Archivos de origen\Exceptions 116 | 117 | 118 | Archivos de origen\DateTime 119 | 120 | 121 | Archivos de origen\Interop 122 | 123 | 124 | Archivos de origen\VBA.Interaction 125 | 126 | 127 | Archivos de origen\VBA.Interaction 128 | 129 | 130 | Archivos de origen\Arrays 131 | 132 | 133 | Archivos de origen\Locale 134 | 135 | 136 | 137 | 138 | Archivos de encabezado 139 | 140 | 141 | Archivos de encabezado 142 | 143 | 144 | Archivos de encabezado 145 | 146 | 147 | Archivos de encabezado 148 | 149 | 150 | Archivos de origen\Objects\App 151 | 152 | 153 | Archivos de origen\Objects\VBGlobal 154 | 155 | 156 | Archivos de origen\Objects 157 | 158 | 159 | Archivos de origen\Objects\VBGlobal 160 | 161 | 162 | Archivos de origen\Objects\App 163 | 164 | 165 | Archivos de origen\Objects 166 | 167 | 168 | Archivos de origen\Variant 169 | 170 | 171 | Archivos de origen\ObjectInterface 172 | 173 | 174 | Archivos de origen\String 175 | 176 | 177 | Archivos de encabezado 178 | 179 | 180 | Archivos de encabezado 181 | 182 | 183 | Archivos de encabezado 184 | 185 | 186 | Archivos de origen\CommandLine 187 | 188 | 189 | Archivos de origen\Exceptions 190 | 191 | 192 | 193 | 194 | Archivos de recursos 195 | 196 | 197 | 198 | 199 | Archivos de origen\Objects\VBGlobal 200 | 201 | 202 | Archivos de origen\Objects\App 203 | 204 | 205 | 206 | 207 | Archivos de origen 208 | 209 | 210 | 211 | -------------------------------------------------------------------------------- /openmsvbvm/resource.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cocus/openmsvbvm/1ad89d89b91d76f5c5c0937be6e22264cc272e9c/openmsvbvm/resource.h -------------------------------------------------------------------------------- /openmsvbvm/vba_Arrays.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | 3 | #include "vba_exception.h" 4 | 5 | #include "vba_strManipulation.h" 6 | #include "vba_objManipulation.h" 7 | #include "vba_varManipulation.h" 8 | 9 | 10 | 11 | /** 12 | * @brief Raises the Subscript out of range exception. 13 | */ 14 | EXPORT void __stdcall __vbaGenerateBoundsError() 15 | { 16 | vbaRaiseException(VBA_EXCEPTION_SUBSCRIPT_OUT_OF_RANGE); 17 | } /* __vbaGenerateBoundsError */ 18 | 19 | /** 20 | * @brief Locks a SafeArray and copies the pointer to another pointer. 21 | * @param ppsaDest Pointer to a SafeArray pointer, where psaSource will be set to. 22 | * @param psaSource Source SafeArray pointer (to be locked). 23 | */ 24 | EXPORT void __stdcall __vbaAryLock( 25 | SAFEARRAY ** ppsaDest, 26 | SAFEARRAY * psaSource 27 | ) 28 | { 29 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 30 | 31 | DEBUG_WIDE( 32 | "Locking array %.8x", 33 | (unsigned int)psaSource 34 | ); 35 | 36 | if (!psaSource || !ppsaDest) 37 | { 38 | vbaRaiseException(VBA_EXCEPTION_SUBSCRIPT_OUT_OF_RANGE); 39 | return; 40 | } 41 | 42 | if (SafeArrayLock(psaSource) != S_OK) 43 | { 44 | vbaRaiseException(VBA_EXCEPTION_ARRAY_FIXED_OR_TEMPORARILY_LOCKED); 45 | return; 46 | } 47 | 48 | *ppsaDest = psaSource; 49 | } /* __vbaAryLock */ 50 | 51 | /** 52 | * @brief Unlocks and nulls a pointer to a previously locked SafeArray pointer. 53 | * @param ppsaSafeArray Pointer to a SafeArray pointer. 54 | */ 55 | EXPORT void __stdcall __vbaAryUnlock( 56 | SAFEARRAY ** ppsaSafeArray 57 | ) 58 | { 59 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 60 | 61 | DEBUG_WIDE( 62 | "Unlocking array %.8x", 63 | (unsigned int)ppsaSafeArray 64 | ); 65 | 66 | if (!*ppsaSafeArray) 67 | { 68 | return; 69 | } 70 | 71 | if (SafeArrayUnlock(*ppsaSafeArray) != S_OK) 72 | { 73 | vbaRaiseException(VBA_EXCEPTION_ARRAY_FIXED_OR_TEMPORARILY_LOCKED); 74 | return; 75 | } 76 | 77 | *ppsaSafeArray = 0; 78 | } /* __vbaAryUnlock */ 79 | 80 | /** 81 | * @brief Obtains the lower bound of given dimension of a SafeArray. 82 | * @param iDimension Dimension number (base 1). 83 | * @param psaSafeArray Pointer to the SafeArray. 84 | * @return Lower bound of the given dimension, or zero (and a exception) on failure. 85 | */ 86 | EXPORT LONG __stdcall __vbaLbound( 87 | signed int iDimension, 88 | SAFEARRAY * psaSafeArray 89 | ) 90 | { 91 | if (iDimension < 1) 92 | { 93 | vbaRaiseException(VBA_EXCEPTION_SUBSCRIPT_OUT_OF_RANGE); 94 | return 0; 95 | } 96 | if (!psaSafeArray) 97 | { 98 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 99 | return 0; 100 | } 101 | if (iDimension > psaSafeArray->cDims) 102 | { 103 | vbaRaiseException(VBA_EXCEPTION_SUBSCRIPT_OUT_OF_RANGE); 104 | return 0; 105 | } 106 | 107 | return psaSafeArray->rgsabound[psaSafeArray->cDims - iDimension].lLbound; 108 | } /* __vbaLbound */ 109 | 110 | /** 111 | * @brief Obtains the upper bound of given dimension of a SafeArray. 112 | * @param iDimension Dimension number (base 1). 113 | * @param psaSafeArray Pointer to the SafeArray. 114 | * @return Upper bound of the given dimension, or zero (and a exception) on failure. 115 | */ 116 | EXPORT LONG __stdcall __vbaUbound( 117 | signed int iDimension, 118 | SAFEARRAY * psaSafeArray 119 | ) 120 | { 121 | if (iDimension < 1) 122 | { 123 | vbaRaiseException(VBA_EXCEPTION_SUBSCRIPT_OUT_OF_RANGE); 124 | return 0; 125 | } 126 | if (!psaSafeArray) 127 | { 128 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 129 | return 0; 130 | } 131 | if (iDimension > psaSafeArray->cDims) 132 | { 133 | vbaRaiseException(VBA_EXCEPTION_SUBSCRIPT_OUT_OF_RANGE); 134 | return 0; 135 | } 136 | 137 | SAFEARRAYBOUND * psabDimensionBounds = &psaSafeArray->rgsabound[psaSafeArray->cDims - iDimension]; 138 | 139 | return psabDimensionBounds->lLbound 140 | + psabDimensionBounds->cElements; 141 | } /* __vbaUbound */ 142 | 143 | /** 144 | * @brief Creates a SafeArray from a statically defined structure. 145 | * @param psaDest Pointer to the destination SafeArray. 146 | * @param psaSource Pointer to the statically defined SafeArray. 147 | * @param lpVoidArg Pointer to a IRecordInfo, GUID or nothing depending on the 148 | * features in the SafeArray. 149 | */ 150 | EXPORT void __stdcall __vbaAryConstruct2( 151 | SAFEARRAY * psaDest, 152 | SAFEARRAY * psaSource, 153 | void * lpVoidArg 154 | ) 155 | { 156 | /* Copy the source array psaSource to the destination array psaDest, including the bounds */ 157 | memcpy( 158 | psaDest, 159 | psaSource, 160 | sizeof(SAFEARRAY) + (psaSource->cDims > 0u ? (sizeof(SAFEARRAYBOUND) * (psaSource->cDims - 1)) : 0) 161 | ); 162 | 163 | /* Is an embedded array in a structure? */ 164 | if (!(psaDest->fFeatures & FADF_EMBEDDED)) 165 | { 166 | if (SafeArrayAllocData(psaDest) < 0 || !psaDest->pvData) 167 | { 168 | SafeArrayDestroyDescriptor(psaDest); 169 | return; 170 | } 171 | } 172 | 173 | /* Do we have an additional argument? */ 174 | if (lpVoidArg) 175 | { 176 | /* If this array contains records, then the additional argument is a pointer to a RecordInfo struct */ 177 | if (psaDest->fFeatures & FADF_RECORD) 178 | { 179 | psaDest->rgsabound[0].lLbound = 0; 180 | SafeArraySetRecordInfo( 181 | psaDest, 182 | reinterpret_cast(lpVoidArg) 183 | ); 184 | } 185 | /* If this array contains the IID, then the additional argument is a pointer to a GUID struct */ 186 | else if (psaDest->fFeatures & FADF_HAVEIID) 187 | { 188 | psaDest->cLocks = 0; 189 | psaDest->pvData = 0; 190 | psaDest->rgsabound[0].cElements = 0; 191 | psaDest->rgsabound[0].lLbound = 0; 192 | SafeArraySetIID( 193 | psaDest, 194 | (const GUID&)lpVoidArg 195 | ); 196 | } 197 | else if ((psaSource->fFeatures & FADF_HAVEVARTYPE)) 198 | { 199 | // ? 200 | } 201 | } 202 | } /* __vbaAryConstruct2 */ 203 | 204 | /** 205 | * @brief Erases a SafeArray and nulls the pointer to that SafeArray. 206 | * @param pData ? 207 | * @param ppSafeArray Pointer to a SafeArray pointer that will be 208 | * destroyed. 209 | */ 210 | EXPORT void __stdcall __vbaErase( 211 | int * pData, 212 | SAFEARRAY ** ppSafeArray 213 | ) 214 | { 215 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 216 | 217 | DEBUG_WIDE( 218 | "pData %.8x, ppsaSafeArray %.8x", 219 | (unsigned int)pData, 220 | (unsigned int)ppSafeArray 221 | ); 222 | 223 | if (!*ppSafeArray) 224 | { 225 | return; 226 | } 227 | 228 | switch (SafeArrayDestroy(*ppSafeArray)) 229 | { 230 | case DISP_E_ARRAYISLOCKED: 231 | { 232 | vbaRaiseException(VBA_EXCEPTION_ARRAY_FIXED_OR_TEMPORARILY_LOCKED); 233 | break; 234 | } 235 | 236 | case S_OK: 237 | { 238 | *ppSafeArray = nullptr; 239 | break; 240 | } 241 | 242 | default: 243 | { 244 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 245 | break; 246 | } 247 | } 248 | } /* __vbaErase */ 249 | 250 | /** 251 | * @brief Destructs a SafeArray and its contents. 252 | * @param pData ? 253 | * @param ppSafeArray Pointer to a SafeArray pointer that will be 254 | * destroyed and nulled. 255 | */ 256 | EXPORT void __stdcall __vbaAryDestruct( 257 | int * pData, 258 | SAFEARRAY ** ppSafeArray 259 | ) 260 | { 261 | if (!*ppSafeArray) 262 | { 263 | return; 264 | } 265 | 266 | if (((*ppSafeArray)->fFeatures & FADF_EMBEDDED) || 267 | ((*ppSafeArray)->fFeatures & FADF_AUTO)) 268 | { 269 | if ((*ppSafeArray)->fFeatures & FADF_RECORD) 270 | { 271 | SafeArraySetRecordInfo(*ppSafeArray, 0); 272 | } 273 | } 274 | else 275 | { 276 | if ((*ppSafeArray)->pvData) 277 | { 278 | (*ppSafeArray)->fFeatures &= 0xFFEDu; 279 | SafeArrayDestroyData(*ppSafeArray); 280 | 281 | if ((*ppSafeArray)->fFeatures & FADF_RECORD) 282 | { 283 | SafeArraySetRecordInfo(*ppSafeArray, 0); 284 | } 285 | } 286 | 287 | // This might be sufficient, since SafeArrayDestroy also 288 | // does the same as SafeArrayDestroyData. 289 | __vbaErase(pData, ppSafeArray); 290 | } 291 | } /* __vbaAryDestruct */ 292 | 293 | /** 294 | * @brief Redims a given dimension of a SafeArray, preserving it's contents. 295 | * @param ppsaSafeArray Pointer to a SafeArray pointer. 296 | * @param uiDimensions Number of dimensions to redim. 297 | * @param ... New value for each dimension. 298 | */ 299 | EXPORT void __cdecl __vbaRedimPreserve( 300 | int iUnk1, 301 | int iUnk2, 302 | SAFEARRAY ** ppsaSafeArray, 303 | int iUnk3, 304 | unsigned int uiDimensions, 305 | ... 306 | ) 307 | { 308 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 309 | 310 | DEBUG_WIDE( 311 | "ppsaSafeArray %.8x, uiDimensions %.8x", 312 | (unsigned int)ppsaSafeArray, 313 | uiDimensions 314 | ); 315 | 316 | va_list args; 317 | va_start(args, uiDimensions); 318 | 319 | if (uiDimensions == 1) 320 | { 321 | /* Redim a one-dimension array by just calling SafeArrayRedim */ 322 | int iNewElementCount = va_arg(args, int); 323 | 324 | DEBUG_WIDE( 325 | "iNewElementCount = %d, PreviousElementCount %d", 326 | iNewElementCount, 327 | (*ppsaSafeArray)->rgsabound[0].cElements 328 | ); 329 | 330 | SAFEARRAYBOUND sabNewBound; 331 | memcpy( 332 | &sabNewBound, 333 | &(*ppsaSafeArray)->rgsabound[0], 334 | sizeof(sabNewBound) 335 | ); 336 | sabNewBound.cElements = iNewElementCount; 337 | 338 | HRESULT hr = SafeArrayRedim( 339 | *ppsaSafeArray, 340 | &sabNewBound 341 | ); 342 | } 343 | else 344 | { 345 | // TODO: Multi dimension array redim! 346 | } 347 | 348 | va_end(args); 349 | } /* __vbaRedimPreserve */ 350 | 351 | /** 352 | * @brief Redims a given dimension of a SafeArray, nuking it's contents. 353 | * @param uFeatures SafeArray features. 354 | * @param ulElementsSize Size of each element of the array. 355 | * @param ppsaOut Pointer to a SafeArray pointer. 356 | * @param uiDimensions Number of new dimensions to redim. 357 | * @param ... Lower and Upper bound for each dimension (two different arguments per dimension). 358 | */ 359 | EXPORT void __cdecl __vbaRedim( 360 | USHORT uFeatures, 361 | ULONG ulElementsSize, 362 | SAFEARRAY ** ppsaOut, 363 | void * lpArgument, 364 | USHORT uiDimensions, 365 | ... 366 | ) 367 | { 368 | if (!ppsaOut) 369 | { 370 | // Wtf? 371 | return; 372 | } 373 | 374 | if (*ppsaOut) 375 | { 376 | // We have a previously defined array, so nuke it first 377 | __vbaErase((int*)lpArgument, ppsaOut); 378 | } 379 | 380 | HRESULT hr; 381 | 382 | if (uFeatures & (FADF_RECORD | FADF_HAVEIID | FADF_HAVEVARTYPE)) 383 | { 384 | // If the array's feature is RECORD, HAVEIID or HAVEVARTYPE 385 | // then create the descriptor of the SafeArray using SafeArrayAllocDescriptorEx 386 | 387 | VARTYPE vtArrayVarType; 388 | 389 | if (uFeatures & FADF_HAVEIID) 390 | { 391 | vtArrayVarType = VT_DISPATCH; // ? 392 | } 393 | else if (uFeatures & FADF_RECORD) 394 | { 395 | vtArrayVarType = VT_RECORD; 396 | } 397 | else 398 | { 399 | vtArrayVarType = (VARTYPE)lpArgument; // ? 400 | } 401 | 402 | // Allocate the descriptor for this SafeArray with given vartype 403 | hr = SafeArrayAllocDescriptorEx( 404 | vtArrayVarType, 405 | uiDimensions, 406 | ppsaOut 407 | ); 408 | 409 | if (hr != S_OK) 410 | { 411 | vbaRaiseException(vbaErrorFromHRESULT(hr)); 412 | return; 413 | } 414 | 415 | if (uFeatures & FADF_HAVEIID) 416 | { 417 | // If we have a IID in the lpArgument, then set it via SafeArraySetIID 418 | hr = SafeArraySetIID( 419 | *ppsaOut, 420 | reinterpret_cast(lpArgument) 421 | ); 422 | 423 | if (hr != S_OK) 424 | { 425 | SafeArrayDestroyDescriptor(*ppsaOut); 426 | 427 | vbaRaiseException(vbaErrorFromHRESULT(hr)); 428 | return; 429 | } 430 | } 431 | else if (uFeatures & FADF_RECORD) 432 | { 433 | // If we have a IRecordInfo* in the lpArgument, then set it via SafeArraySetRecordInfo 434 | hr = SafeArraySetRecordInfo( 435 | *ppsaOut, 436 | reinterpret_cast(lpArgument) 437 | ); 438 | 439 | if (hr != S_OK) 440 | { 441 | SafeArrayDestroyDescriptor(*ppsaOut); 442 | 443 | vbaRaiseException(vbaErrorFromHRESULT(hr)); 444 | return; 445 | } 446 | } 447 | } 448 | else 449 | { 450 | // Otherwise, create a standard SafeArray 451 | hr = SafeArrayAllocDescriptor( 452 | uiDimensions, 453 | ppsaOut 454 | ); 455 | 456 | if (hr != S_OK) 457 | { 458 | vbaRaiseException(vbaErrorFromHRESULT(hr)); 459 | return; 460 | } 461 | } 462 | 463 | // Set the members of the SafeArray with given arguments 464 | (*ppsaOut)->fFeatures = uFeatures; 465 | (*ppsaOut)->cbElements = ulElementsSize; 466 | 467 | va_list args; 468 | va_start(args, uiDimensions); 469 | 470 | // Set the bounds of the dimensions 471 | int iCurrDim = 0; 472 | while (uiDimensions--) 473 | { 474 | // We have two elements in the stack per each dimension: 475 | // First one is the Lower-Bound 476 | // Second one is the Element count (i.e. Upper-Bound) 477 | (*ppsaOut)->rgsabound[iCurrDim].cElements = va_arg(args, int) + 1; 478 | (*ppsaOut)->rgsabound[iCurrDim].lLbound = va_arg(args, int); 479 | 480 | // Fix the element count by subtracting the lower bound 481 | (*ppsaOut)->rgsabound[iCurrDim].cElements -= (*ppsaOut)->rgsabound[iCurrDim].lLbound; 482 | 483 | iCurrDim++; 484 | } 485 | 486 | va_end(args); 487 | 488 | // Now alloc the data for all the dimensions and elements 489 | hr = SafeArrayAllocData(*ppsaOut); 490 | 491 | if (hr != S_OK) 492 | { 493 | SafeArrayDestroyDescriptor(*ppsaOut); 494 | *ppsaOut = 0; 495 | 496 | vbaRaiseException(vbaErrorFromHRESULT(hr)); 497 | } 498 | } /* __vbaRedim */ -------------------------------------------------------------------------------- /openmsvbvm/vba_CommandLine.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | 4 | // TODO: Make this thread-dependant? 5 | static BSTR m_bstrCommandLine; 6 | 7 | /** 8 | * @brief Returns a BSTR with the app command line. 9 | * @returns A BSTR with the full command line. 10 | */ 11 | EXPORT BSTR __stdcall rtcCommandBstr(void) 12 | { 13 | BSTR result; 14 | 15 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 16 | 17 | if (m_bstrCommandLine) 18 | { 19 | result = SysAllocString(m_bstrCommandLine); 20 | } 21 | else 22 | { 23 | result = SysAllocString(L""); 24 | } 25 | 26 | DEBUG_WIDE( 27 | "psz '%ls'", 28 | result 29 | ); 30 | 31 | return result; 32 | } 33 | 34 | /** 35 | * @brief Returns a Variant with the app command line. 36 | * @param pvargDest Destination Variant variable. 37 | * @returns A Variant (VT_BSTR) with the full command line. 38 | */ 39 | EXPORT VARIANTARG * __stdcall rtcCommandVar( 40 | VARIANTARG *pvargDest 41 | ) 42 | { 43 | if (pvargDest) 44 | { 45 | pvargDest->vt = VT_BSTR; 46 | pvargDest->bstrVal = rtcCommandBstr(); 47 | } 48 | 49 | return pvargDest; 50 | } 51 | 52 | OLECHAR * __stdcall rtcSetCommandLine( 53 | OLECHAR * psz 54 | ) 55 | { 56 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 57 | 58 | DEBUG_WIDE( 59 | "psz '%ls'", 60 | psz 61 | ); 62 | 63 | if (m_bstrCommandLine) 64 | { 65 | SysFreeString(m_bstrCommandLine); 66 | } 67 | 68 | m_bstrCommandLine = SysAllocString(psz); 69 | 70 | return m_bstrCommandLine; 71 | } -------------------------------------------------------------------------------- /openmsvbvm/vba_CommandLine.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "vba_internal.h" 4 | 5 | OLECHAR * __stdcall rtcSetCommandLine( 6 | OLECHAR *psz 7 | ); 8 | 9 | EXPORT BSTR __stdcall rtcCommandBstr(void); -------------------------------------------------------------------------------- /openmsvbvm/vba_DateManipulation.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | 4 | #include "vba_Locale.h" 5 | 6 | #include 7 | 8 | 9 | /** 10 | * @brief Gets the current date time into a VARIANTARG. 11 | * @param pvargResult Pointer to the destination VARIANTARG. 12 | */ 13 | EXPORT void __stdcall rtcGetPresentDate( 14 | VARIANTARG * pvargResult 15 | ) 16 | { 17 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 18 | UDATE udDate; 19 | HRESULT result; 20 | 21 | GetLocalTime(&udDate.st); 22 | // TODO: Do this in a nicer way! 23 | time_t rawtime; 24 | time(&rawtime); 25 | struct tm t; 26 | localtime_s(&t, &rawtime); 27 | char buff[30]; 28 | strftime(buff, sizeof(buff), "%j", &t); 29 | udDate.wDayOfYear = atoi(buff); 30 | 31 | pvargResult->vt = VT_DATE; 32 | 33 | result = VarDateFromUdate( 34 | &udDate, 35 | VAR_VALIDDATE, 36 | &pvargResult->date 37 | ); 38 | 39 | DEBUG_WIDE( 40 | "pvargResult %.8x, pvargResult->vt %.8x, pvargResult->date %.16x, VarDateFromUdate = %.8x", 41 | (unsigned int)pvargResult, 42 | pvargResult->vt, 43 | (unsigned long)pvargResult->date, 44 | (unsigned int)result 45 | ); 46 | 47 | if (result != S_OK) 48 | { 49 | vbaRaiseException(vbaErrorFromHRESULT(result)); 50 | return; 51 | } 52 | } /* rtcGetPresentDate */ 53 | 54 | /** 55 | * @brief Converts a VARIANTARG to DATE. 56 | * @param pvargDate Pointer to the source VARIANTARG. 57 | * @return DATE representation of pvargDate, and 0.0 if fails to convert. 58 | */ 59 | EXPORT DATE __stdcall __vbaDateVar( 60 | VARIANTARG * pvargDate 61 | ) 62 | { 63 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 64 | DEBUG_WIDE( 65 | "pvargDate %.8x", 66 | (unsigned int)pvargDate 67 | ); 68 | 69 | if (pvargDate->vt = VT_DATE) 70 | { 71 | // Don't convert it since it's already a VT_DATE 72 | return pvargDate->date; 73 | } 74 | else 75 | { 76 | VARIANTARG vargDateTemp; 77 | HRESULT hr; 78 | 79 | // Convert to VT_DATE 80 | hr = VariantChangeType( 81 | &vargDateTemp, 82 | pvargDate, 83 | 0, 84 | VT_DATE 85 | ); 86 | 87 | if (hr != S_OK) 88 | { 89 | vbaRaiseException(VBA_EXCEPTION_TYPE_MISMATCH); 90 | return 0.0; 91 | } 92 | 93 | return vargDateTemp.date; 94 | } 95 | } /* __vbaDateVar */ -------------------------------------------------------------------------------- /openmsvbvm/vba_DllFunctionCall.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | #include "vba_structures.h" 4 | 5 | /** 6 | * @brief Loads a DLL and gets the address of a specified procedure. 7 | * @param dllTemplate Pointer to a serDllTemplate structure, with the proper information 8 | * about the DLL and procedure to call. 9 | * @return FARPROC (func pointer) of the specified procedure on success, 0 otherwise. 10 | */ 11 | EXPORT FARPROC __stdcall DllFunctionCall( 12 | struct serDllTemplate * dllTemplate 13 | ) 14 | { 15 | FARPROC hFuncAddr; 16 | HMODULE hModule; 17 | 18 | if (!dllTemplate) 19 | { 20 | vbaRaiseException(VBA_EXCEPTION_INTERNAL_ERROR); 21 | } 22 | 23 | hModule = LoadLibraryA( 24 | dllTemplate->lpLibraryNameA 25 | ); 26 | if (!hModule) 27 | { 28 | RaiseExceptionIfLastErrorIsSet(); 29 | } 30 | 31 | hFuncAddr = GetProcAddress( 32 | hModule, 33 | dllTemplate->lpProcAddressA 34 | ); 35 | if (!hFuncAddr) 36 | { 37 | RaiseExceptionIfLastErrorIsSet(); 38 | } 39 | 40 | return hFuncAddr; 41 | } /* DllFunctionCall */ -------------------------------------------------------------------------------- /openmsvbvm/vba_File.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | 4 | #include 5 | #include 6 | #include 7 | 8 | #include "vba_enums.h" 9 | 10 | #include "vba_objManipulation.h" 11 | #include "vba_varManipulation.h" 12 | 13 | class vbaFileAbstraction 14 | { 15 | public: 16 | vbaFileAbstraction( 17 | std::wstring file, 18 | vbaFileOpenMode mode 19 | ) : file(file), mode(mode) 20 | { 21 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 22 | 23 | DEBUG_WIDE_OBJ( 24 | "mode = %.8x", 25 | (unsigned int)mode 26 | ); 27 | 28 | if (mode & VB_FMODE_ACCESS_WRITE) 29 | { 30 | _wfopen_s(&sysHandle, file.c_str(), L"wb+"); 31 | } 32 | else //if (mode & VB_FMODE_ACCESS_READ) // TODO!!! 33 | { 34 | _wfopen_s(&sysHandle, file.c_str(), L"rb+"); 35 | } 36 | } 37 | 38 | void get3( 39 | unsigned int uiSize, 40 | char *pData 41 | ) 42 | { 43 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 44 | 45 | DEBUG_WIDE_OBJ( 46 | "uiSize %.8x, pData %.8x", 47 | (unsigned int)uiSize, 48 | (unsigned int)pData 49 | ); 50 | 51 | /* This should not happen, but... */ 52 | if (pData == nullptr) 53 | { 54 | return; 55 | } 56 | 57 | /* TODO: check: If the size is null, then we have a pointer to a string */ 58 | if (uiSize == 0) 59 | { 60 | DEBUG_WIDE_OBJ( 61 | "uiSize == 0!" 62 | ); 63 | 64 | return; 65 | } 66 | 67 | size_t ret = fread(pData, 1, uiSize, sysHandle); 68 | 69 | DEBUG_WIDE_OBJ( 70 | "fread wrote %.8x bytes, and we aimed for %.8x bytes", 71 | (unsigned int)ret, 72 | (unsigned int)uiSize 73 | ); 74 | } /* get3 */ 75 | 76 | void put3( 77 | unsigned int uiSize, 78 | char *pData 79 | ) 80 | { 81 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 82 | 83 | DEBUG_WIDE_OBJ( 84 | "uiSize %.8x, pData %.8x", 85 | (unsigned int)uiSize, 86 | (unsigned int)pData 87 | ); 88 | 89 | /* This should not happen, but... */ 90 | if (pData == nullptr) 91 | { 92 | return; 93 | } 94 | 95 | /* TODO: check: If the size is null, then we have a pointer to a string */ 96 | if (uiSize == 0) 97 | { 98 | /* Get the true BSTR from the specified pointer */ 99 | pData = (char*)(*(BSTR*)pData); 100 | 101 | if (pData == nullptr) 102 | { 103 | DEBUG_WIDE_OBJ( 104 | "pData = NULL, after de-referencing the original pointer" 105 | ); 106 | return; 107 | } 108 | 109 | /* Get the size of the string */ 110 | uiSize = SysStringLen((BSTR)pData); 111 | if (uiSize == 0) 112 | { 113 | DEBUG_WIDE_OBJ( 114 | "wcslen = 0, could not get the size of the buffer to write" 115 | ); 116 | return; 117 | } 118 | } 119 | 120 | size_t ret = fwrite(pData, 1, uiSize, sysHandle); 121 | 122 | DEBUG_WIDE_OBJ( 123 | "fwrite wrote %.8x bytes, and we aimed for %.8x bytes", 124 | (unsigned int)ret, 125 | (unsigned int)uiSize 126 | ); 127 | } /* put3 */ 128 | 129 | unsigned long rtcFileLength() 130 | { 131 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 132 | 133 | unsigned long ulOriginalPos = ftell(sysHandle); 134 | 135 | fseek(sysHandle, 0, SEEK_END); 136 | 137 | unsigned long ulSize = ftell(sysHandle); 138 | 139 | fseek(sysHandle, ulOriginalPos, SEEK_SET); 140 | 141 | DEBUG_WIDE_OBJ( 142 | "ulOriginalPos %.8x, ulSize %.8x", 143 | ulOriginalPos, 144 | ulSize 145 | ); 146 | 147 | return ulSize; 148 | 149 | } /* rtcFileLength */ 150 | 151 | ~vbaFileAbstraction() 152 | { 153 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 154 | 155 | DEBUG_WIDE_OBJ( 156 | "this->sysHandle %.8x, file '%ls'", 157 | (unsigned int)sysHandle, 158 | file.c_str() 159 | ); 160 | 161 | if (sysHandle) 162 | { 163 | fclose(sysHandle); 164 | sysHandle = NULL; 165 | } 166 | } 167 | 168 | private: 169 | FILE * sysHandle = nullptr; 170 | std::wstring file = L""; 171 | vbaFileOpenMode mode; 172 | }; /* class vbaFileAbstraction */ 173 | 174 | 175 | /* TODO: This should be thread-dependant, and maybe add locks? */ 176 | static std::map _vbaFileHandles; 177 | 178 | /** 179 | * @brief TBD 180 | * @param TBD 181 | * @returns TBD 182 | */ 183 | static bool vbaFileGetObjectFromVBHandle( 184 | unsigned int uiVBHandle, 185 | vbaFileAbstraction** obj 186 | ) 187 | { 188 | std::map::iterator it; 189 | 190 | it = _vbaFileHandles.find(uiVBHandle); 191 | 192 | if (it != _vbaFileHandles.end()) 193 | { 194 | *obj = it->second; 195 | 196 | return true; 197 | } 198 | 199 | return false; 200 | } /* vbaFileGetObjectFromVBHandle */ 201 | 202 | /** 203 | * @brief Tries to open a file, and assigns the VB Handle identifier to the local list. 204 | * @param uiMode Mode bitfield (see vbaFileOpenMode enum) specifying how to open the file. 205 | * @param unknown ??? (seems to be always -1). 206 | * @param uiVBHandle VB file handle identifier for this file. 207 | * @param bstrFileName File path. 208 | * @returns The length of the file path argument (minus one) on success. 209 | */ 210 | EXPORT unsigned int __stdcall __vbaFileOpen( 211 | unsigned int uiMode, 212 | int unknown, 213 | unsigned int uiVBHandle, 214 | BSTR bstrFileName 215 | ) 216 | { 217 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 218 | 219 | DEBUG_WIDE( 220 | "uiMode %.8x, unknown %.8x, uiVBHandle %.8x, file = '%ls'", 221 | uiMode, 222 | unknown, 223 | uiVBHandle, 224 | bstrFileName 225 | ); 226 | 227 | vbaFileAbstraction * obj; 228 | if (vbaFileGetObjectFromVBHandle(uiVBHandle, &obj)) 229 | { 230 | vbaRaiseException(VBA_EXCEPTION_FILE_ALREADY_OPEN); 231 | } 232 | else 233 | { 234 | /* TODO: create a factory for this! */ 235 | obj = new vbaFileAbstraction(std::wstring(bstrFileName), (vbaFileOpenMode)uiMode); 236 | 237 | _vbaFileHandles.insert(std::pair( 238 | uiVBHandle, 239 | obj 240 | )); 241 | } 242 | 243 | return wcslen(bstrFileName) + 1; 244 | } /* __vbaFileOpen */ 245 | 246 | /** 247 | * @brief Closes a previously open VB file. 248 | * @param uiVBHandle VB file handle identifier for this file. 249 | */ 250 | EXPORT void __stdcall __vbaFileClose( 251 | int vbHandle 252 | ) 253 | { 254 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 255 | 256 | DEBUG_WIDE( 257 | "vbHandle = %.8x", 258 | (unsigned int)vbHandle 259 | ); 260 | 261 | vbaFileAbstraction * obj; 262 | if (vbaFileGetObjectFromVBHandle(vbHandle, &obj)) 263 | { 264 | _vbaFileHandles.erase(vbHandle); 265 | delete obj; 266 | } 267 | else 268 | { 269 | vbaRaiseException(VBA_EXCEPTION_BAD_FILENAME_OR_NUMBER); 270 | } 271 | } /* __vbaFileClose */ 272 | 273 | /** 274 | * @brief Gets the file size of a previously open VB file. 275 | * @param uiVBHandle VB file handle identifier for this file. 276 | * @returns The file size on success, 0 otherwise. 277 | */ 278 | EXPORT unsigned long __stdcall rtcFileLength( 279 | unsigned int uiVBHandle 280 | ) 281 | { 282 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 283 | 284 | DEBUG_WIDE( 285 | "uiVBHandle %.8x", 286 | (unsigned int)uiVBHandle 287 | ); 288 | 289 | vbaFileAbstraction * obj; 290 | if (vbaFileGetObjectFromVBHandle(uiVBHandle, &obj)) 291 | { 292 | return obj->rtcFileLength(); 293 | } 294 | else 295 | { 296 | vbaRaiseException(VBA_EXCEPTION_BAD_FILENAME_OR_NUMBER); 297 | return 0; 298 | } 299 | } /* rtcFileLength */ 300 | 301 | /** 302 | * @brief Sets the absoulte position of a previously open VB file. 303 | * @param ulPos New position of the file (absolute). 304 | * @param uiVBHandle VB file handle identifier for this file. 305 | * @returns The previous file position on success, 0 otherwise. 306 | */ 307 | EXPORT unsigned long __stdcall __vbaFileSeek( 308 | unsigned long ulPos, 309 | unsigned int uiVBHandle 310 | ) 311 | { 312 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 313 | 314 | DEBUG_WIDE( 315 | "ulPos %.8x, uiVBHandle %.8x", 316 | ulPos, 317 | (unsigned int)uiVBHandle 318 | ); 319 | 320 | if (ulPos < 1) 321 | { 322 | vbaRaiseException(VBA_EXCEPTION_BAD_RECORD_NUMBER); 323 | return 0; 324 | } 325 | 326 | vbaFileAbstraction * obj; 327 | if (vbaFileGetObjectFromVBHandle(uiVBHandle, &obj)) 328 | { 329 | //return obj->rtcFileLength(); 330 | } 331 | else 332 | { 333 | vbaRaiseException(VBA_EXCEPTION_BAD_FILENAME_OR_NUMBER); 334 | } 335 | return 0; 336 | 337 | } /* __vbaFileSeek */ 338 | 339 | /** 340 | * @brief Reads data from a previously open VB file. 341 | * @param uiSize Size of the data buffer, or zero for strings. 342 | * @param *pData Pointer to the destination data buffer. 343 | * @param uiVBHandle VB file handle identifier for this file. 344 | */ 345 | EXPORT void __stdcall __vbaGet3( 346 | unsigned int uiSize, 347 | char *pData, 348 | unsigned int uiVBHandle 349 | ) 350 | { 351 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 352 | 353 | DEBUG_WIDE( 354 | "uiSize %.8x, pData %.8x, uiVBHandle %.8x", 355 | (unsigned int)uiSize, 356 | (unsigned int)pData, 357 | (unsigned int)uiVBHandle 358 | ); 359 | 360 | vbaFileAbstraction * obj; 361 | if (vbaFileGetObjectFromVBHandle(uiVBHandle, &obj)) 362 | { 363 | obj->get3(uiSize, pData); 364 | } 365 | else 366 | { 367 | vbaRaiseException(VBA_EXCEPTION_BAD_FILENAME_OR_NUMBER); 368 | } 369 | } /* __vbaGet3 */ 370 | 371 | /** 372 | * @brief Writes data to a previously open VB file. 373 | * @param uiSize Size of the data buffer, or zero for strings. 374 | * @param *pData Pointer to the source data buffer. 375 | * @param uiVBHandle VB file handle identifier for this file. 376 | */ 377 | EXPORT void __stdcall __vbaPut3( 378 | unsigned int uiSize, 379 | char *pData, 380 | unsigned int uiVBHandle 381 | ) 382 | { 383 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 384 | 385 | DEBUG_WIDE( 386 | "uiSize %.8x, pData %.8x, uiVBHandle %.8x", 387 | (unsigned int)uiSize, 388 | (unsigned int)pData, 389 | (unsigned int)uiVBHandle 390 | ); 391 | 392 | vbaFileAbstraction * obj; 393 | if (vbaFileGetObjectFromVBHandle(uiVBHandle, &obj)) 394 | { 395 | obj->put3(uiSize, pData); 396 | } 397 | else 398 | { 399 | vbaRaiseException(VBA_EXCEPTION_BAD_FILENAME_OR_NUMBER); 400 | } 401 | } /* __vbaPut3 */ -------------------------------------------------------------------------------- /openmsvbvm/vba_InputBox.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | #include "resource.h" 4 | #include 5 | 6 | #include "vba_strManipulation.h" 7 | 8 | typedef struct 9 | { 10 | LONG lX; 11 | bool bHasX; 12 | LONG lY; 13 | bool bHasY; 14 | wchar_t *lpwstrTitle; 15 | wchar_t *lpwstrPrompt; 16 | wchar_t *lpwstrDefaultValue; 17 | wchar_t *lpwstrHelpFile; 18 | wchar_t *lpwstrHelpContext; 19 | wchar_t *lpwstrReturnValue; 20 | 21 | } inputBoxStorage_t; 22 | 23 | static BOOL CALLBACK InputBoxDlgProc( 24 | HWND hwnd, 25 | UINT message, 26 | WPARAM wParam, 27 | LPARAM lParam 28 | ) 29 | { 30 | switch (message) 31 | { 32 | case WM_INITDIALOG: 33 | { 34 | /* Code from https://docs.microsoft.com/en-us/windows/desktop/dlgbox/using-dialog-boxes */ 35 | // Get the owner window and dialog box rectangles. 36 | HWND hwndParent; 37 | RECT rcDlg; 38 | RECT rcOwner; 39 | RECT rc; 40 | 41 | if ((hwndParent = GetParent(hwnd)) == NULL) 42 | { 43 | hwndParent = GetDesktopWindow(); 44 | } 45 | 46 | GetWindowRect(hwndParent, &rcOwner); 47 | GetWindowRect(hwnd, &rcDlg); 48 | CopyRect(&rc, &rcOwner); 49 | 50 | // Offset the owner and dialog box rectangles so that right and bottom 51 | // values represent the width and height, and then offset the owner again 52 | // to discard space taken up by the dialog box. 53 | OffsetRect(&rcDlg, -rcDlg.left, -rcDlg.top); 54 | OffsetRect(&rc, -rc.left, -rc.top); 55 | OffsetRect(&rc, -rcDlg.right, -rcDlg.bottom); 56 | 57 | /* Setup the pointer to the inputBoxStorage for later usage */ 58 | SetWindowLongPtr(hwnd, DWLP_USER, lParam); 59 | 60 | /* Retrieve the storage structure from the user defined parameter */ 61 | inputBoxStorage_t * ibs = (inputBoxStorage_t*)lParam; 62 | if (!ibs) 63 | { 64 | return FALSE; 65 | } 66 | 67 | if (!ibs->bHasX) 68 | { 69 | ibs->lX = rcOwner.left + (rc.right / 2); 70 | } 71 | if (!ibs->bHasY) 72 | { 73 | ibs->lY = rcOwner.top + (rc.bottom / 2); 74 | } 75 | 76 | /* Set the window pos with the specified X, Y values */ 77 | SetWindowPos( 78 | hwnd, 79 | HWND_TOP, 80 | ibs->lX, 81 | ibs->lY, 82 | 0, 0, // Ignores size arguments. 83 | SWP_NOSIZE 84 | ); 85 | 86 | HWND h = NULL; 87 | 88 | 89 | /* If there's a helpfile present, show the Help button */ 90 | if (ibs->lpwstrHelpFile) 91 | { 92 | h = GetDlgItem(hwnd, IDC_BUTTON_HELP); 93 | ShowWindow(h, SW_SHOW); 94 | } 95 | 96 | /* Set the default value (if there's one) */ 97 | if (ibs->lpwstrDefaultValue) 98 | { 99 | h = GetDlgItem(hwnd, IDC_INPUT); 100 | SetWindowTextW(h, ibs->lpwstrDefaultValue); 101 | } 102 | 103 | /* Set the lpwstrPrompt (static text) if there's one */ 104 | if (ibs->lpwstrPrompt) 105 | { 106 | h = GetDlgItem(hwnd, IDC_USER_STATIC); 107 | SetWindowTextW(h, ibs->lpwstrPrompt); 108 | } 109 | 110 | /* Set the window lpwstrTitle (if there's one) */ 111 | if (ibs->lpwstrTitle) 112 | { 113 | SetWindowTextW(hwnd, ibs->lpwstrTitle); 114 | } 115 | 116 | /* Set the caption of the controls using system-dependant strings (if available) */ 117 | typedef LPCWSTR(WINAPI *pmb_getstring)(int strId); 118 | HMODULE hLibUser32 = LoadLibraryA("user32.dll"); 119 | if (hLibUser32) 120 | { 121 | /* Use the undoc'd function MB_GetString, if available */ 122 | pmb_getstring p = (pmb_getstring)GetProcAddress(hLibUser32, "MB_GetString"); 123 | 124 | if (p) 125 | { 126 | LPCWSTR text = NULL; 127 | h = GetDlgItem(hwnd, IDC_BUTTON_HELP); 128 | text = p(8); /* IDHELP */ 129 | if (text && h) 130 | { 131 | SetWindowTextW(h, text); 132 | } 133 | 134 | h = GetDlgItem(hwnd, IDC_BUTTON_OK); 135 | text = p(0); /* IDOK */ 136 | if (text && h) 137 | { 138 | SetWindowTextW(h, text); 139 | } 140 | 141 | h = GetDlgItem(hwnd, IDC_BUTTON_CANCEL); 142 | text = p(1); /* IDCANCEL */ 143 | if (text && h) 144 | { 145 | SetWindowTextW(h, text); 146 | } 147 | } /* if (p) */ 148 | } /* if (hLibUser32) */ 149 | 150 | if (GetDlgCtrlID((HWND)wParam) != IDC_INPUT) 151 | { 152 | SetFocus(GetDlgItem(hwnd, IDC_INPUT)); 153 | /** 154 | * Return false only to override the default behavior of DialogBoxes in Windows: 155 | * The system assigns the default keyboard focus only if the dialog box procedure 156 | * returns TRUE, and we don't want that. 157 | */ 158 | return FALSE; 159 | } 160 | 161 | return TRUE; 162 | } /* WM_INITDIALOG */ 163 | 164 | case WM_COMMAND: 165 | { 166 | if ((LOWORD(wParam) == IDC_BUTTON_OK) || 167 | (LOWORD(wParam) == IDC_BUTTON_CANCEL) || 168 | (LOWORD(wParam) == IDC_BUTTON_HELP)) 169 | { 170 | inputBoxStorage_t * is = (inputBoxStorage_t*)GetWindowLongPtr(hwnd, DWLP_USER); 171 | if (!is) 172 | { 173 | /* If we can't get our pointer, cancel this dialog. */ 174 | EndDialog(hwnd, IDC_BUTTON_CANCEL); 175 | } 176 | 177 | switch (LOWORD(wParam)) 178 | { 179 | case IDC_BUTTON_OK: 180 | { 181 | HWND h = GetDlgItem(hwnd, IDC_INPUT); 182 | 183 | int textLen = GetWindowTextLengthW(h); 184 | is->lpwstrReturnValue = new wchar_t[textLen + 1]; 185 | GetWindowTextW(h, is->lpwstrReturnValue, textLen + 1); 186 | 187 | EndDialog(hwnd, LOWORD(wParam)); 188 | break; 189 | } /* IDC_BUTTON_OK */ 190 | 191 | case IDC_BUTTON_CANCEL: 192 | { 193 | EndDialog(hwnd, LOWORD(wParam)); 194 | break; 195 | } /* IDC_BUTTON_CANCEL*/ 196 | 197 | case IDC_BUTTON_HELP: 198 | { 199 | /*HWND help = HtmlHelp( 200 | GetDesktopWindow(), 201 | "c:\\Help.chm::/Intro.htm>Mainwin", 202 | HH_DISPLAY_TOPIC, 203 | NULL);*/ 204 | /* TODO: support this HtmlHelp outdated thing */ 205 | break; 206 | } /* IDC_BUTTON_HELP */ 207 | } 208 | } /* if (LOWORD(wParam) == IDC_BUTTON_OK || IDC_BUTTON_CANCEL || IDC_BUTTON_HELP) */ 209 | break; 210 | } /* WM_COMMAND */ 211 | 212 | default: 213 | { 214 | return FALSE; 215 | } 216 | } 217 | 218 | return TRUE; 219 | } /* InputBoxDlgProc */ 220 | 221 | extern 222 | HMODULE g_dllModuleHandle; 223 | 224 | /** 225 | * @brief VB's input box implementation. 226 | * @param pvarPrompt Prompt to be used in the dialog box. Can be omitted. 227 | * @param pvarTitle Title to be used in the dialog box. Can be omitted. 228 | * @param pvarDefaultValue Default value to be used in the dialog box. Can be omitted. 229 | * @param pvarX X position of the dialog box. Can be omitted. 230 | * @param pvarY X position of the dialog box. Can be omitted. 231 | * @param pvarHelpFile Help file path. Can be omitted. 232 | * @param pvarHelpContext Help context ID (only if pvarHelpFile is specified). Can be omitted. 233 | * @returns A BSTR with the user input text. 234 | */ 235 | EXPORT BSTR __stdcall rtcInputBox( 236 | VARIANTARG * pvarPrompt, 237 | VARIANTARG * pvarTitle, 238 | VARIANTARG * pvarDefaultValue, 239 | VARIANTARG * pvarX, 240 | VARIANTARG * pvarY, 241 | VARIANTARG * pvarHelpFile, 242 | VARIANTARG * pvarHelpContext 243 | ) 244 | { 245 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 246 | 247 | DEBUG_WIDE( 248 | "pvarPrompt %.8x, pvarTitle %.8x, pvarDefaultValue %.8x, pvarX %.8x, pvarY %.8x, pvarHelpFile %.8x, pvarHelpContext %.8x", 249 | (unsigned int)pvarPrompt, 250 | (unsigned int)pvarTitle, 251 | (unsigned int)pvarDefaultValue, 252 | (unsigned int)pvarX, 253 | (unsigned int)pvarY, 254 | (unsigned int)pvarHelpFile, 255 | (unsigned int)pvarHelpContext 256 | ); 257 | 258 | inputBoxStorage_t st = { 0 }; 259 | 260 | /* Setup the X value, if specified */ 261 | if (pvarX->vt == VT_I2) 262 | { 263 | st.bHasX = true; 264 | st.lX = pvarX->iVal; 265 | } 266 | 267 | /* Setup the Y value, if specified. TODO: Support more types. */ 268 | if (pvarY->vt == VT_I2) 269 | { 270 | st.bHasY = true; 271 | st.lY = pvarY->iVal; 272 | } 273 | 274 | /* Setup the HelpFile, if specified. TODO: Support more types. */ 275 | if (pvarHelpFile) 276 | { 277 | st.lpwstrHelpFile = __vbaStrErrVarCopy(pvarHelpFile); 278 | } 279 | 280 | /* Setup the HelpContext, if specified */ 281 | if (pvarHelpContext) 282 | { 283 | st.lpwstrHelpContext = __vbaStrErrVarCopy(pvarHelpContext); 284 | } 285 | 286 | /* Setup the Prompt, if specified */ 287 | if (pvarPrompt) 288 | { 289 | st.lpwstrPrompt = __vbaStrErrVarCopy(pvarPrompt); 290 | } 291 | 292 | /* Setup the DefaultValue, if specified */ 293 | if (pvarDefaultValue) 294 | { 295 | st.lpwstrDefaultValue = __vbaStrErrVarCopy(pvarDefaultValue); 296 | } 297 | 298 | /* Setup the Title, if specified */ 299 | if (pvarTitle) 300 | { 301 | st.lpwstrTitle = __vbaStrErrVarCopy(pvarTitle); 302 | } 303 | 304 | /* Call the DialogBoxParamW and wait for the return value */ 305 | INT_PTR ret = DialogBoxParamW( 306 | g_dllModuleHandle, 307 | MAKEINTRESOURCEW(ID_DIALOG_INPUTBOX), 308 | 0, 309 | InputBoxDlgProc, 310 | (LPARAM)&st 311 | ); 312 | 313 | /* Free the strings */ 314 | if (st.lpwstrHelpFile) 315 | { 316 | __vbaFreeStr((BSTR*)&st.lpwstrHelpFile); 317 | } 318 | if (st.lpwstrHelpContext) 319 | { 320 | __vbaFreeStr((BSTR*)&st.lpwstrHelpContext); 321 | } 322 | if (st.lpwstrPrompt) 323 | { 324 | __vbaFreeStr((BSTR*)&st.lpwstrPrompt); 325 | } 326 | if (st.lpwstrDefaultValue) 327 | { 328 | __vbaFreeStr((BSTR*)&st.lpwstrDefaultValue); 329 | } 330 | if (st.lpwstrTitle) 331 | { 332 | __vbaFreeStr((BSTR*)&st.lpwstrTitle); 333 | } 334 | 335 | DEBUG_WIDE( 336 | "DialogBoxParamW ret = %.8x, GetLastError = %.8x, st.returnvalue %.8x", 337 | (unsigned int)ret, 338 | (unsigned int)GetLastError(), 339 | (unsigned int)st.lpwstrReturnValue 340 | ); 341 | 342 | /* Check if the user accepted the dialog box or not */ 343 | switch (ret) 344 | { 345 | case IDC_BUTTON_OK: 346 | { 347 | /* If there isn't a return vale, leave */ 348 | if (!st.lpwstrReturnValue) 349 | { 350 | break; 351 | } 352 | 353 | /* Create a copy of the wchar_t value to a BSTR */ 354 | BSTR ret = SysAllocString(st.lpwstrReturnValue); 355 | /* Delete the wchar_t array */ 356 | delete[] st.lpwstrReturnValue; 357 | 358 | return ret; 359 | } 360 | case IDC_BUTTON_CANCEL: 361 | default: 362 | { 363 | break; 364 | } 365 | } 366 | 367 | /* Default return value for cancel, or error */ 368 | return SysAllocString(L""); 369 | } /* rtcInputBox */ -------------------------------------------------------------------------------- /openmsvbvm/vba_InteractionFunctions.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | 3 | #include "vba_exception.h" 4 | 5 | #include "vba_strManipulation.h" 6 | 7 | #include 8 | 9 | /** 10 | * @brief Sets the focus to the specified window with the corresponding title. 11 | * @param pvargTitle Title of the window. 12 | * @param pvargWait Bool that specifies to wait for user input or not. 13 | */ 14 | EXPORT void __stdcall rtcAppActivate( 15 | VARIANTARG * pvargTitle, 16 | VARIANTARG * pvargWait 17 | ) 18 | { 19 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 20 | 21 | DEBUG_WIDE( 22 | "pvargTitle %.8x, pvargWait %.8x", 23 | (unsigned int)pvargTitle, 24 | (unsigned int)pvargWait 25 | ); 26 | 27 | UINT uiWaitTime = 0; 28 | BSTR strTitle; 29 | 30 | /* Create a copy of pvargTitle and convert it to BSTR */ 31 | strTitle = __vbaStrErrVarCopy(pvargTitle); 32 | 33 | DEBUG_WIDE( 34 | "Window title: '%ls', wait time %.8x", 35 | strTitle, 36 | uiWaitTime 37 | ); 38 | 39 | HWND hWnd = FindWindowW(nullptr, strTitle); 40 | 41 | SysFreeString(strTitle); 42 | 43 | if (!hWnd) 44 | { 45 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 46 | return; 47 | } 48 | 49 | DEBUG_WIDE( 50 | "Window hWnd %.8x", 51 | (unsigned int)hWnd 52 | ); 53 | 54 | DWORD dwProcessId; 55 | DWORD dwThreadProcessId; 56 | 57 | dwThreadProcessId = GetWindowThreadProcessId(hWnd, &dwProcessId); 58 | AttachThreadInput(0, dwThreadProcessId, true); 59 | 60 | SetForegroundWindow(hWnd); 61 | SetFocus(hWnd); 62 | 63 | AttachThreadInput(0, dwThreadProcessId, 0); 64 | } /* rtcAppActivate */ 65 | 66 | /** 67 | * @brief Plays a system beep. 68 | */ 69 | EXPORT void __stdcall rtcBeep() 70 | { 71 | MessageBeep(MB_OK); 72 | } /* rtcBeep */ 73 | 74 | /** 75 | * @brief Chooses gets an item from a SAFEARRAY using its index. 76 | * @param pvargDest Pointer to a VARIANTARG where the selected element will be copied to. 77 | * @param fIndex Index of selected element within the array. Float because VB is weird. 78 | * @param ppsaArray Pointer to a pointer of a SAFEARRAY that holds the elements to choose from. 79 | */ 80 | EXPORT void __stdcall rtcChoose( 81 | VARIANTARG * pvargDest, 82 | FLOAT fIndex, 83 | SAFEARRAY ** ppsaArray) 84 | { 85 | VARIANTARG vargLocalCopy; 86 | VARIANTARG pv; 87 | LONG lIndices = 0; 88 | HRESULT hr; 89 | 90 | /* Zero out the destination variant variable */ 91 | memset( 92 | pvargDest, 93 | 0, 94 | sizeof(VARIANTARG) 95 | ); 96 | 97 | pvargDest->vt = VT_NULL; 98 | 99 | /* Check for index bounds */ 100 | if (!(fIndex >= 0.0 && fIndex < 2147483600.0)) 101 | { 102 | // TODO: Raise an exception? 103 | return; 104 | } 105 | 106 | /* If the array is more than one dimension, raise an exception */ 107 | if (SafeArrayGetDim(*ppsaArray) != 1) 108 | { 109 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 110 | return; 111 | } 112 | 113 | #pragma warning (disable : 244) /* We know that we'll loose some data by converting, don't yell at me because of that */ 114 | /* For some weird reason VB passes a float instead of a LONG, so convert that to LONG */ 115 | lIndices = fIndex - 1; 116 | #pragma warning (default : 244) /* Restore previous warning */ 117 | 118 | /* Get the element from the array */ 119 | hr = SafeArrayGetElement( 120 | *ppsaArray, 121 | &lIndices, 122 | (void *)&pv 123 | ); 124 | 125 | if (hr < 0) 126 | { 127 | vbaRaiseException(vbaErrorFromHRESULT(hr)); 128 | return; 129 | } 130 | 131 | if (!(pv.vt & VT_BYREF)) 132 | { 133 | /* VT_BYREF not set */ 134 | memcpy( 135 | pvargDest, 136 | &pv, 137 | sizeof(VARIANTARG) 138 | ); 139 | } 140 | else 141 | { 142 | /* VT_BYREF set */ 143 | hr = VariantCopyInd( 144 | &vargLocalCopy, 145 | &pv 146 | ); 147 | 148 | if (hr < 0) 149 | { 150 | vbaRaiseException(vbaErrorFromHRESULT(hr)); 151 | return; 152 | } 153 | else 154 | { 155 | memcpy( 156 | pvargDest, 157 | &vargLocalCopy, 158 | sizeof(VARIANTARG) 159 | ); 160 | } 161 | } 162 | 163 | return; 164 | } /* rtcChoose */ 165 | 166 | /** 167 | * @brief Gets a named environment variable. 168 | * @param pvargIn Environment variable name. 169 | * @return BSTR with the choosen environment variable, or "" 170 | * if the variable doesn't exists. 171 | */ 172 | EXPORT BSTR __stdcall rtcEnvironBstr( 173 | VARIANTARG * pvargIn 174 | ) 175 | { 176 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 177 | 178 | BSTR bstrRet; 179 | BSTR bstrEnvName; 180 | 181 | bstrEnvName = __vbaStrVarCopy(pvargIn); 182 | 183 | if (!bstrEnvName) 184 | { 185 | bstrRet = SysAllocString(L""); 186 | } 187 | else 188 | { 189 | DEBUG_WIDE( 190 | "EnvironmentVariable: '%ls'", 191 | bstrEnvName 192 | ); 193 | 194 | DWORD dwSize; 195 | dwSize = GetEnvironmentVariableW( 196 | bstrEnvName, 197 | NULL, 198 | 0 199 | ); 200 | 201 | if (dwSize == 0) 202 | { 203 | /* Specified environment string not found */ 204 | bstrRet = SysAllocString(L""); 205 | } 206 | else 207 | { 208 | bstrRet = SysAllocStringLen( 209 | NULL, 210 | dwSize 211 | ); 212 | 213 | if (!bstrRet) 214 | { 215 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 216 | } 217 | else 218 | { 219 | dwSize = GetEnvironmentVariableW( 220 | bstrEnvName, 221 | bstrRet, 222 | dwSize 223 | ); 224 | } 225 | } 226 | } 227 | 228 | return bstrRet; 229 | } /* rtcEnvironBstr */ 230 | 231 | /** 232 | * @brief Gets a named environment variable. 233 | * @param pvargOut Pointer to the destination VARIANTARG. 234 | * @param pvargIn Environment variable name. 235 | * @return pvargOut always, with the choosen environment variable, or "" 236 | * if the variable doesn't exists. 237 | */ 238 | EXPORT VARIANTARG * __stdcall rtcEnvironVar( 239 | VARIANTARG *pvargOut, 240 | VARIANTARG *pvargIn 241 | ) 242 | { 243 | pvargOut->vt = VT_BSTR; 244 | pvargOut->bstrVal = rtcEnvironBstr(pvargIn); 245 | 246 | return pvargOut; 247 | } /* rtcEnvironVar */ 248 | 249 | /** 250 | * @brief Returns a variant between two variant variables based on the 251 | * boolean value of a third variable. 252 | * @param pvargDest Pointer to the destination VARIANTARG. 253 | * @param pvargBooleanValue VARIANTARG that selects which value to use. 254 | * @param pvargTrueValue VARIANTARG to return if the boolean value is true. 255 | * @param pvargFalseValue VARIANTARG to return if the boolean value is false. 256 | * @return pvargDest always, with a copy of the value of pvargTrueValue 257 | * or pvargFalseValue. 258 | */ 259 | EXPORT VARIANTARG * __stdcall rtcImmediateIf( 260 | VARIANTARG *pvargDest, 261 | VARIANTARG *pvargBooleanValue, 262 | VARIANTARG *pvargTrueValue, 263 | VARIANTARG *pvargFalseValue 264 | ) 265 | { 266 | HRESULT hr; 267 | VARIANTARG vargB; 268 | 269 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 270 | 271 | /* Convert pvargBooleanValue to a Boolean variant (deref if necessary) */ 272 | hr = VariantChangeType( 273 | &vargB, 274 | pvargBooleanValue, 275 | 0, 276 | VT_BOOL 277 | ); 278 | 279 | if (hr != S_OK) 280 | { 281 | vbaRaiseException(vbaErrorFromHRESULT(hr)); 282 | return pvargDest; 283 | } 284 | 285 | DEBUG_WIDE( 286 | "booleanValue %.1d, trueValueVT %.8x, falseValueVT %.8x", 287 | vargB.boolVal, 288 | pvargTrueValue->vt, 289 | pvargFalseValue->vt 290 | ) 291 | 292 | /* Create a copy of pvargTrueValue or pvargFalseValue as needed */ 293 | hr = VariantCopyInd( 294 | pvargDest, 295 | vargB.boolVal ? pvargTrueValue : pvargFalseValue 296 | ); 297 | 298 | if (hr != S_OK) 299 | { 300 | vbaRaiseException(vbaErrorFromHRESULT(hr)); 301 | } 302 | 303 | return pvargDest; 304 | } /* rtcImmediateIf */ 305 | 306 | /** 307 | * @brief Returns a Variant (String) indicating where a number 308 | * occurs within a calculated series of ranges. 309 | * @param pvargDest Pointer to the destination VARIANTARG. 310 | * @param pvargNumber Whole number that you want to evaluate against the ranges. 311 | * @param pvargStart Whole number that is the start of the overall range of numbers. The number can't be less than 0. 312 | * @param pvargEnd Whole number that is the end of the overall range of numbers. The number can't be equal to or less than start. 313 | * @param pvargInterval Whole number that specifies the interval. 314 | */ 315 | EXPORT void __stdcall rtcPartition( 316 | VARIANTARG *pvargDest, 317 | VARIANTARG *pvargNumber, 318 | VARIANTARG *pvargStart, 319 | VARIANTARG *pvargEnd, 320 | VARIANTARG *pvargInterval 321 | ) 322 | { 323 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 324 | 325 | VARIANTARG vargNumber; 326 | VARIANTARG vargStart; 327 | VARIANTARG vargEnd; 328 | VARIANTARG vargInterval; 329 | 330 | int iRange1, iRange2; 331 | 332 | HRESULT hr; 333 | 334 | VariantInit(&vargNumber); 335 | VariantInit(&vargStart); 336 | VariantInit(&vargEnd); 337 | VariantInit(&vargInterval); 338 | 339 | /* Convert Number to I4 */ 340 | hr = VariantChangeType( 341 | &vargNumber, 342 | pvargNumber, 343 | 0, 344 | VT_I4 345 | ); 346 | 347 | if (hr != S_OK) 348 | { 349 | vbaRaiseException(VBA_EXCEPTION_TYPE_MISMATCH); 350 | return; 351 | } 352 | 353 | /* Convert Start to I4 */ 354 | hr = VariantChangeType( 355 | &vargStart, 356 | pvargStart, 357 | 0, 358 | VT_I4 359 | ); 360 | 361 | if (hr != S_OK) 362 | { 363 | vbaRaiseException(VBA_EXCEPTION_TYPE_MISMATCH); 364 | return; 365 | } 366 | 367 | /* Convert End to I4 */ 368 | hr = VariantChangeType( 369 | &vargEnd, 370 | pvargEnd, 371 | 0, 372 | VT_I4 373 | ); 374 | 375 | if (hr != S_OK) 376 | { 377 | vbaRaiseException(VBA_EXCEPTION_TYPE_MISMATCH); 378 | return; 379 | } 380 | 381 | /* Convert Interval to I4 */ 382 | hr = VariantChangeType( 383 | &vargInterval, 384 | pvargInterval, 385 | 0, 386 | VT_I4 387 | ); 388 | 389 | if (hr != S_OK) 390 | { 391 | vbaRaiseException(VBA_EXCEPTION_TYPE_MISMATCH); 392 | return; 393 | } 394 | 395 | DEBUG_WIDE( 396 | "Number %.d, Start %.d, End %.d, Interval %.d", 397 | vargNumber.intVal, 398 | vargStart.intVal, 399 | vargEnd.intVal, 400 | vargInterval.intVal 401 | ); 402 | 403 | if (vargInterval.intVal == 1) 404 | { 405 | /* If interval is 1, the range is number:number, regardless of the start and stop arguments. */ 406 | iRange1 = vargNumber.intVal; 407 | iRange2 = iRange1; 408 | } 409 | else 410 | { 411 | // TODO: Come up with an algorithm for this 412 | } 413 | } /* rtcPartition */ 414 | 415 | /** 416 | * @brief Sends multiple keys or combination of keys to the focused window. 417 | * @param bstrKeys BSTR with the keys and combination of keys. 418 | * @param pvargWaitTime Pointer to a VARIANTARG with the optional value of 419 | * the waiting time after sending the keys. 420 | */ 421 | EXPORT void __stdcall rtcSendKeys( 422 | BSTR bstrKeys, 423 | VARIANTARG *pvargWaitTime 424 | ) 425 | { 426 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 427 | 428 | DEBUG_WIDE( 429 | "inputKeys '%ls', pvargWaitTime %.8d", 430 | bstrKeys, 431 | pvargWaitTime->intVal 432 | ); 433 | 434 | // TODO: implement something like Karl E. Peterson's SendInput 435 | // http://www.classicvb.net/samples/SendInput/ 436 | } /* rtcSendKeys */ 437 | 438 | /** 439 | * @brief Starts up a new process. 440 | * @param vargPath Path to the application. 441 | * @param uiShowCmd Show mode for the newly created app. 442 | * @return PID of the newly created process on success, -1 otherwise. 443 | */ 444 | EXPORT DWORD __stdcall rtcShell( 445 | VARIANTARG *vargPath, 446 | unsigned int uiShowCmd 447 | ) 448 | { 449 | BSTR bstrCmdLine; 450 | BOOL processCreated; 451 | STARTUPINFOW StartupInfo; 452 | PROCESS_INFORMATION ProcessInformation; 453 | 454 | DWORD lastError; 455 | 456 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 457 | 458 | DEBUG_WIDE( 459 | "vargPath %.8x, uiShowCmd %.8x", 460 | (unsigned int)vargPath, 461 | uiShowCmd 462 | ); 463 | 464 | /* Check if the uiShowCmd argument is valid */ 465 | if (uiShowCmd > 11) 466 | { 467 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 468 | return -1; 469 | } 470 | 471 | bstrCmdLine = __vbaStrVarCopy(vargPath); 472 | if (!bstrCmdLine) 473 | { 474 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); // Or VBA_EXCEPTION_OUT_OF_STRING_SPACE? 475 | return -1; 476 | } 477 | 478 | /* Setup the StartupInfoW struct */ 479 | memset(&StartupInfo, 0, sizeof(StartupInfo)); 480 | StartupInfo.cb = sizeof(StartupInfo); 481 | StartupInfo.dwFlags = STARTF_USESHOWWINDOW; 482 | StartupInfo.wShowWindow = uiShowCmd; 483 | 484 | /* Start the process */ 485 | processCreated = CreateProcessW( 486 | 0, 487 | bstrCmdLine, 488 | 0, 489 | 0, 490 | 0, 491 | 0, 492 | 0, 493 | 0, 494 | &StartupInfo, 495 | &ProcessInformation 496 | ); 497 | 498 | lastError = GetLastError(); 499 | 500 | SysFreeString(bstrCmdLine); 501 | 502 | if (!processCreated) 503 | { 504 | switch (lastError) 505 | { 506 | case ERROR_FILE_NOT_FOUND: 507 | { 508 | vbaRaiseException(VBA_EXCEPTION_FILE_NOT_FOUND); 509 | break; 510 | } 511 | case ERROR_PATH_NOT_FOUND: 512 | { 513 | vbaRaiseException(VBA_EXCEPTION_PATH_NOT_FOUND); 514 | break; 515 | } 516 | case ERROR_OUTOFMEMORY: 517 | case ERROR_NOT_ENOUGH_MEMORY: 518 | { 519 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_MEMORY); 520 | break; 521 | } 522 | default: 523 | { 524 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 525 | } 526 | } 527 | 528 | return -1; 529 | } 530 | 531 | WaitForInputIdle(ProcessInformation.hProcess, 10000); 532 | 533 | CloseHandle(ProcessInformation.hThread); 534 | CloseHandle(ProcessInformation.hProcess); 535 | 536 | return ProcessInformation.dwProcessId; 537 | } /* rtcShell */ -------------------------------------------------------------------------------- /openmsvbvm/vba_Locale.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_Locale.h" 2 | 3 | LCID getUserLocale() 4 | { 5 | LCID result; 6 | 7 | DEBUG_DECLARE_ASCII_BUFFER_IF_NEEDED(); 8 | 9 | result = GetUserDefaultLCID(); 10 | 11 | if (!result) 12 | { 13 | result = 0x0409; /* Default: United States */ 14 | } 15 | 16 | DEBUG_ASCII( 17 | "locale = %.8x", 18 | (unsigned int)result 19 | ); 20 | 21 | return result; 22 | } -------------------------------------------------------------------------------- /openmsvbvm/vba_Locale.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "vba_internal.h" 4 | 5 | LCID getUserLocale(); -------------------------------------------------------------------------------- /openmsvbvm/vba_MessageBox.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | 4 | #include "vba_strManipulation.h" 5 | 6 | /** 7 | * @brief VB's message box implementation. 8 | * @param pvargMessage Message of the dialog box. Can be omitted. 9 | * @param uType Type of the message box. Same as MessageBoxW. 10 | * @param pvargTitle Title to be used in the dialog box. Can be omitted. 11 | * @param pvarHelpFile Help file path. Can be omitted. 12 | * @param pvarHelpContext Help context ID (only if pvarHelpFile is specified). Can be omitted. 13 | * @returns An int with the result of the message box (which button was selected). 14 | */ 15 | EXPORT int __stdcall rtcMsgBox( 16 | VARIANTARG *pvargMessage, 17 | UINT uType, 18 | VARIANTARG *pvargTitle, 19 | VARIANTARG *pvarHelpFile, 20 | VARIANTARG *pvarHelpContext 21 | ) 22 | { 23 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 24 | 25 | DEBUG_WIDE( 26 | "msg %.8x, uType %.8x, title %.8x, a4 %.8x, a5 %.8x", 27 | (unsigned int)pvargMessage, 28 | uType, 29 | (unsigned int)pvargTitle, 30 | (unsigned int)pvarHelpFile, 31 | (unsigned int)pvarHelpContext 32 | ); 33 | 34 | BSTR message = __vbaStrErrVarCopy(pvargMessage); 35 | BSTR title = __vbaStrErrVarCopy(pvargTitle); 36 | 37 | if (!title) 38 | { 39 | title = SysAllocString(L""); 40 | } 41 | if (!message) 42 | { 43 | message = SysAllocString(L""); 44 | } 45 | 46 | // TODO: Whenever forms become available, use the topmost form's handle for the hWnd argument 47 | int ret = MessageBoxW( 48 | 0, 49 | message, 50 | title, 51 | uType 52 | ); 53 | 54 | __vbaFreeStr(&message); 55 | __vbaFreeStr(&title); 56 | 57 | return ret; 58 | } /* rtcMsgBox */ -------------------------------------------------------------------------------- /openmsvbvm/vba_Settings.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | 3 | #include "vba_exception.h" 4 | 5 | #include "vba_strManipulation.h" 6 | 7 | #include 8 | 9 | 10 | 11 | 12 | #define VB_REGISTRY_PATH_BASE L"Software\\VB and VBA Program Settings\\" 13 | #define VB_REGISTRY_PATH_BASE_LEN 37 14 | #define VB_REGISTRY_DEFAULT_HIVE HKEY_CURRENT_USER 15 | 16 | 17 | /** 18 | * @brief Saves a setting in the Windows registry. 19 | * @param bstrAppName Application name to be used for the registry sub key. 20 | * @param bstrSection Section name to be used for the registry sub key. 21 | * @param bstrKey Key name for the registry sub key. 22 | * @param bstrSetting Value for the registry sub key. 23 | */ 24 | EXPORT void __stdcall rtcSaveSetting( 25 | BSTR bstrAppName, 26 | BSTR bstrSection, 27 | BSTR bstrKey, 28 | BSTR bstrSetting 29 | ) 30 | { 31 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 32 | 33 | DEBUG_WIDE( 34 | "strAppName '%ls', strSection '%ls', strKey '%ls', strSetting '%ls'", 35 | bstrAppName, 36 | bstrSection, 37 | bstrKey, 38 | bstrSetting 39 | ); 40 | 41 | wchar_t wcSubKey[MAX_PATH]; 42 | 43 | if (strSafeGetLength(bstrAppName) + strSafeGetLength(bstrSection) + VB_REGISTRY_PATH_BASE_LEN + 1 > MAX_PATH) 44 | { 45 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 46 | return; 47 | } 48 | 49 | swprintf( 50 | wcSubKey, 51 | MAX_PATH, 52 | VB_REGISTRY_PATH_BASE L"%ls\\%ls", 53 | bstrAppName, 54 | bstrSection 55 | ); 56 | 57 | HKEY hkSettingKey; 58 | LSTATUS lResult; 59 | 60 | /* Create the settings key under wcSubkey in HKEY_CURRENT_USER */ 61 | lResult = RegCreateKeyW( 62 | VB_REGISTRY_DEFAULT_HIVE, 63 | wcSubKey, 64 | &hkSettingKey 65 | ); 66 | 67 | if (lResult != S_OK) 68 | { 69 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 70 | return; 71 | } 72 | 73 | /* Save the user-defined settings in the previously created key */ 74 | lResult = RegSetValueExW( 75 | hkSettingKey, 76 | bstrKey, 77 | NULL, 78 | REG_SZ, 79 | (const BYTE*)bstrSetting, 80 | strSafeGetLength(bstrSetting) 81 | ); 82 | 83 | if (lResult != S_OK) 84 | { 85 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 86 | return; 87 | } 88 | 89 | /* Close the previously created key */ 90 | lResult = RegCloseKey(hkSettingKey); 91 | 92 | if (lResult != S_OK) 93 | { 94 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 95 | return; 96 | } 97 | 98 | return; 99 | } 100 | 101 | 102 | /* The following functions regarding the registry were taken from https://docs.microsoft.com/en-us/windows/desktop/sysinfo/deleting-a-key-with-subkeys */ 103 | //************************************************************* 104 | // 105 | // RegDelnodeRecurse() 106 | // 107 | // Purpose: Deletes a registry key and all its subkeys / values. 108 | // 109 | // Parameters: hKeyRoot - Root key 110 | // lpSubKey - SubKey to delete 111 | // 112 | // Return: ERROR_SUCCESS if successful. 113 | // LRESULT if an error occurs. 114 | // 115 | //************************************************************* 116 | 117 | LRESULT RegDelnodeRecurse(HKEY hKeyRoot, LPWSTR lpSubKey) 118 | { 119 | LPWSTR lpEnd; 120 | LONG lResult; 121 | DWORD dwSize; 122 | wchar_t szName[MAX_PATH]; 123 | HKEY hKey; 124 | FILETIME ftWrite; 125 | 126 | // First, see if we can delete the key without having 127 | // to recurse. 128 | 129 | lResult = RegDeleteKeyW(hKeyRoot, lpSubKey); 130 | 131 | if (lResult == ERROR_SUCCESS) 132 | return lResult; 133 | 134 | lResult = RegOpenKeyExW(hKeyRoot, lpSubKey, 0, KEY_READ, &hKey); 135 | 136 | if (lResult != ERROR_SUCCESS) 137 | { 138 | return lResult; 139 | } 140 | 141 | // Check for an ending slash and add one if it is missing. 142 | 143 | lpEnd = lpSubKey + lstrlenW(lpSubKey); 144 | 145 | if (*(lpEnd - 1) != TEXT('\\')) 146 | { 147 | *lpEnd = TEXT('\\'); 148 | lpEnd++; 149 | *lpEnd = TEXT('\0'); 150 | } 151 | 152 | // Enumerate the keys 153 | 154 | dwSize = MAX_PATH; 155 | lResult = RegEnumKeyExW(hKey, 0, szName, &dwSize, NULL, 156 | NULL, NULL, &ftWrite); 157 | 158 | if (lResult == ERROR_SUCCESS) 159 | { 160 | do { 161 | 162 | *lpEnd = TEXT('\0'); 163 | StringCchCatW(lpSubKey, MAX_PATH * 2, szName); 164 | 165 | if (!RegDelnodeRecurse(hKeyRoot, lpSubKey)) { 166 | break; 167 | } 168 | 169 | dwSize = MAX_PATH; 170 | 171 | lResult = RegEnumKeyExW(hKey, 0, szName, &dwSize, NULL, 172 | NULL, NULL, &ftWrite); 173 | 174 | } while (lResult == ERROR_SUCCESS); 175 | } 176 | 177 | lpEnd--; 178 | *lpEnd = TEXT('\0'); 179 | 180 | RegCloseKey(hKey); 181 | 182 | // Try again to delete the key. 183 | 184 | lResult = RegDeleteKeyW(hKeyRoot, lpSubKey); 185 | 186 | return lResult; 187 | } 188 | 189 | //************************************************************* 190 | // 191 | // RegDelnode() 192 | // 193 | // Purpose: Deletes a registry key and all its subkeys / values. 194 | // 195 | // Parameters: hKeyRoot - Root key 196 | // lpSubKey - SubKey to delete 197 | // 198 | // Return: ERROR_SUCCESS if successful. 199 | // LRESULT if an error occurs. 200 | // 201 | //************************************************************* 202 | 203 | LRESULT RegDelnode(HKEY hKeyRoot, LPWSTR lpSubKey) 204 | { 205 | wchar_t szDelKey[MAX_PATH * 2]; 206 | 207 | StringCchCopyW(szDelKey, MAX_PATH * 2, lpSubKey); 208 | return RegDelnodeRecurse(hKeyRoot, szDelKey); 209 | 210 | } 211 | 212 | /** 213 | * @brief Deletes a setting (or multiple settings) in the Windows registry. 214 | * @param bstrAppName Application name to be used for the registry sub key. 215 | * @param vargSection Section name to be used for the registry sub key. 216 | * @param vargKey Key name for the registry sub key. 217 | * @remark This will recursively delete multiple values if no key is specified. 218 | * Also, if no section is specified, it will delete all the sub-sections within the appname. 219 | */ 220 | EXPORT void __stdcall rtcDeleteSetting( 221 | BSTR bstrAppName, 222 | VARIANTARG vargSection, 223 | VARIANTARG vargKey 224 | ) 225 | { 226 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 227 | 228 | wchar_t wcSubKey[MAX_PATH]; 229 | LSTATUS lResult; 230 | HKEY hkKey; 231 | BSTR bstrSection; 232 | BSTR bstrKey; 233 | 234 | if (strSafeGetLength(bstrAppName) == 0) 235 | { 236 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 237 | return; 238 | } 239 | 240 | if (vargKey.vt == VT_ERROR) 241 | { 242 | if (vargSection.vt == VT_ERROR) 243 | { 244 | /* Section and key were not specified, so erase all the app settings */ 245 | DEBUG_WIDE( 246 | "Erase all app settings '%ls'", 247 | bstrAppName 248 | ); 249 | 250 | /* Prepare the Key path */ 251 | if (strSafeGetLength(bstrAppName) + VB_REGISTRY_PATH_BASE_LEN > MAX_PATH) 252 | { 253 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 254 | return; 255 | } 256 | 257 | swprintf( 258 | wcSubKey, 259 | MAX_PATH, 260 | VB_REGISTRY_PATH_BASE L"%ls", 261 | bstrAppName 262 | ); 263 | 264 | /* And delete that Key recursively */ 265 | LRESULT lResult = RegDelnode(VB_REGISTRY_DEFAULT_HIVE, wcSubKey); 266 | if (lResult != ERROR_SUCCESS) 267 | { 268 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 269 | return; 270 | } 271 | } 272 | else 273 | { 274 | bstrSection = __vbaStrVarCopy(&vargSection); 275 | 276 | /* Key not specified, so erease the entire section */ 277 | DEBUG_WIDE( 278 | "Erase entire section settings '%ls', '%ls'", 279 | bstrAppName, 280 | bstrSection 281 | ); 282 | 283 | /* Prepare the Key path */ 284 | if (strSafeGetLength(bstrAppName) + strSafeGetLength(bstrSection) + VB_REGISTRY_PATH_BASE_LEN + 1 > MAX_PATH) 285 | { 286 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 287 | return; 288 | } 289 | 290 | swprintf( 291 | wcSubKey, 292 | MAX_PATH, 293 | VB_REGISTRY_PATH_BASE L"%ls\\%ls", 294 | bstrAppName, 295 | bstrSection 296 | ); 297 | 298 | /* And delete that Key recursively */ 299 | LRESULT lResult = RegDelnode(VB_REGISTRY_DEFAULT_HIVE, wcSubKey); 300 | if (lResult != ERROR_SUCCESS) 301 | { 302 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 303 | return; 304 | } 305 | } 306 | } 307 | else 308 | { 309 | bstrSection = __vbaStrVarCopy(&vargSection); 310 | bstrKey = __vbaStrVarCopy(&vargKey); 311 | 312 | /* Erase a specific Key */ 313 | DEBUG_WIDE( 314 | "Erase specific key setting '%ls', '%ls', '%ls'", 315 | bstrAppName, 316 | bstrSection, 317 | bstrKey 318 | ); 319 | 320 | /* Prepare the Key path */ 321 | if (strSafeGetLength(bstrAppName) + strSafeGetLength(bstrSection) + VB_REGISTRY_PATH_BASE_LEN + 1 > MAX_PATH) 322 | { 323 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 324 | return; 325 | } 326 | 327 | swprintf( 328 | wcSubKey, 329 | MAX_PATH, 330 | VB_REGISTRY_PATH_BASE L"%ls\\%ls", 331 | bstrAppName, 332 | bstrSection 333 | ); 334 | 335 | /* Open that key */ 336 | lResult = RegOpenKeyExW( 337 | VB_REGISTRY_DEFAULT_HIVE, 338 | wcSubKey, 339 | 0, 340 | KEY_WRITE, 341 | &hkKey 342 | ); 343 | 344 | if (lResult != ERROR_SUCCESS) 345 | { 346 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 347 | return; 348 | } 349 | 350 | /* Delete the specified value inside that key */ 351 | lResult = RegDeleteValueW( 352 | hkKey, 353 | bstrKey 354 | ); 355 | 356 | /* Cleanup */ 357 | RegCloseKey(hkKey); 358 | 359 | if (lResult != ERROR_SUCCESS) 360 | { 361 | /* And notify if there were some error */ 362 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 363 | } 364 | } 365 | } 366 | 367 | /** 368 | * @brief Gets a setting in the Windows registry. If it doesn't exists, 369 | it will use the provided default value. 370 | * @param bstrAppName Application name to be used for the registry sub key. 371 | * @param bstrSection Section name to be used for the registry sub key. 372 | * @param bstrKey Key name for the registry sub key. 373 | * @param vargDefaultValue Default value used if the registry key doesn't exists. 374 | * @return BSTR with the setting value, or the default converted to BSTR. 375 | */ 376 | EXPORT BSTR __stdcall rtcGetSetting( 377 | BSTR bstrAppName, 378 | BSTR bstrSection, 379 | BSTR bstrKey, 380 | VARIANTARG vargDefaultValue 381 | ) 382 | { 383 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 384 | 385 | wchar_t wcSubKey[MAX_PATH]; 386 | LSTATUS lResult; 387 | HKEY hkKey; 388 | 389 | /* Erase a specific Key */ 390 | DEBUG_WIDE( 391 | "Erase specific key setting '%ls', '%ls', '%ls'", 392 | bstrAppName, 393 | bstrSection, 394 | bstrKey 395 | ); 396 | 397 | /* Prepare the Key path */ 398 | if (strSafeGetLength(bstrAppName) + strSafeGetLength(bstrSection) + VB_REGISTRY_PATH_BASE_LEN + 1 > MAX_PATH) 399 | { 400 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 401 | return NULL; 402 | } 403 | 404 | swprintf( 405 | wcSubKey, 406 | MAX_PATH, 407 | VB_REGISTRY_PATH_BASE L"%ls\\%ls", 408 | bstrAppName, 409 | bstrSection 410 | ); 411 | 412 | /* Open that key */ 413 | lResult = RegOpenKeyExW( 414 | VB_REGISTRY_DEFAULT_HIVE, 415 | wcSubKey, 416 | 0, 417 | KEY_READ, 418 | &hkKey 419 | ); 420 | BSTR bstrRet; 421 | 422 | if (lResult != ERROR_SUCCESS) 423 | { 424 | bstrRet = __vbaStrVarCopy(&vargDefaultValue); 425 | if (!bstrRet) 426 | { 427 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 428 | } 429 | return bstrRet; 430 | } 431 | 432 | DWORD dwType; 433 | DWORD dwDataSize; 434 | 435 | /* Get the specified value */ 436 | lResult = RegQueryValueExW( 437 | hkKey, 438 | bstrKey, 439 | NULL, 440 | &dwType, 441 | NULL, 442 | &dwDataSize 443 | ); 444 | 445 | if (lResult != ERROR_SUCCESS) 446 | { 447 | RegCloseKey(hkKey); 448 | 449 | bstrRet = __vbaStrVarCopy(&vargDefaultValue); 450 | if (!bstrRet) 451 | { 452 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 453 | } 454 | return bstrRet; 455 | } 456 | 457 | if (dwType != REG_SZ) 458 | { 459 | RegCloseKey(hkKey); 460 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 461 | return NULL; 462 | } 463 | 464 | bstrRet = SysAllocStringLen( 465 | NULL, 466 | (dwDataSize / 2) - 1 467 | ); 468 | 469 | if (bstrRet == NULL) 470 | { 471 | SysFreeString(bstrRet); 472 | RegCloseKey(hkKey); 473 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 474 | return NULL; 475 | } 476 | 477 | /* Get the specified value */ 478 | lResult = RegQueryValueExW( 479 | hkKey, 480 | bstrKey, 481 | NULL, 482 | &dwType, 483 | reinterpret_cast(bstrRet), 484 | &dwDataSize 485 | ); 486 | 487 | /* Cleanup */ 488 | RegCloseKey(hkKey); 489 | 490 | if (lResult != ERROR_SUCCESS) 491 | { 492 | /* And notify if there were some error */ 493 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 494 | } 495 | 496 | return bstrRet; 497 | } -------------------------------------------------------------------------------- /openmsvbvm/vba_enums.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | typedef enum 4 | { 5 | VB_FMODE_INPUT = 0x0001, 6 | VB_FMODE_OUTPUT = 0x0002, 7 | VB_FMODE_RANDOM = 0x0004, 8 | VB_FMODE_BINARY = 0x0020, 9 | 10 | VB_FMODE_ACCESS_WRITE = 0x0200, 11 | VB_FMODE_ACCESS_READ = 0x0100, 12 | } vbaFileOpenMode; -------------------------------------------------------------------------------- /openmsvbvm/vba_exception.cpp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cocus/openmsvbvm/1ad89d89b91d76f5c5c0937be6e22264cc272e9c/openmsvbvm/vba_exception.cpp -------------------------------------------------------------------------------- /openmsvbvm/vba_exception.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cocus/openmsvbvm/1ad89d89b91d76f5c5c0937be6e22264cc272e9c/openmsvbvm/vba_exception.h -------------------------------------------------------------------------------- /openmsvbvm/vba_exceptions.cpp: -------------------------------------------------------------------------------- 1 | 2 | #include "vba_exception.h" 3 | 4 | CEXTERN unsigned int __stdcall vbaErrorFromSTGResult(int a1) 5 | { 6 | unsigned int result; // eax 7 | 8 | if (a1 >= 0) 9 | return 0; 10 | if ((a1 & 0x1FFF0000) == 0xA0000) 11 | return (unsigned __int16)a1; 12 | if ((a1 & 0x1FFF0000) == 0x10000) 13 | return 440; 14 | if (a1 == 0x80004001) 15 | return 445; 16 | if (a1 == 0x80030002) 17 | return 432; 18 | result = a1;//vbaErrorFromHRESULT(a1); 19 | if (result > 0x2EA) 20 | return 440; 21 | return result; 22 | } 23 | 24 | 25 | CEXTERN void vbaRaiseException(int exceptionCode) 26 | { 27 | char debug[300]; 28 | snprintf(debug, sizeof(debug), "%s: exception code = %.4d", __func__, exceptionCode); 29 | OutputDebugStringA(debug); 30 | } -------------------------------------------------------------------------------- /openmsvbvm/vba_internal.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | #include 11 | 12 | 13 | #define DEBUG_STORAGE_SIZE 300 14 | #define DEBUG_DECLARE_ASCII_BUFFER_IF_NEEDED() char debugA[DEBUG_STORAGE_SIZE]; 15 | #define DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED() wchar_t debugW[DEBUG_STORAGE_SIZE]; 16 | 17 | #define WIDE2(x) L##x 18 | #define WIDECHAR(x) WIDE2(x) 19 | 20 | #define WIDE_FUNCTION WIDECHAR(__FUNCTION__) 21 | 22 | #define DEBUG_ASCII(fmt, ...) snprintf(debugA, DEBUG_STORAGE_SIZE - 1, "%s: " fmt, __FUNCTION__, __VA_ARGS__); OutputDebugStringA(debugA); 23 | #define DEBUG_ASCII_OBJ(fmt, ...) snprintf(debugA, DEBUG_STORAGE_SIZE - 1, "%s(%.8x): " fmt, __FUNCTION__, (unsigned long)this, __VA_ARGS__); OutputDebugStringA(debugA); 24 | #define DEBUG_WIDE(fmt, ...) swprintf(debugW, DEBUG_STORAGE_SIZE - 1, L"%s: " L##fmt, WIDE_FUNCTION, __VA_ARGS__); OutputDebugStringW(debugW); 25 | #define DEBUG_WIDE_OBJ(fmt, ...) swprintf(debugW, DEBUG_STORAGE_SIZE - 1, L"%s(%.8x): " L##fmt, WIDE_FUNCTION, (unsigned long)this, __VA_ARGS__); OutputDebugStringW(debugW); 26 | #define DEBUG_WIDE_GUID(guid, prepend) { OLECHAR* guidString; StringFromCLSID(guid, &guidString); DEBUG_WIDE(prepend ": %ls", guidString); CoTaskMemFree(guidString); } 27 | 28 | 29 | 30 | 31 | #define ARGS(...) __VA_ARGS__ 32 | 33 | 34 | #ifdef __cplusplus 35 | #define CEXTERN extern "C" 36 | #else 37 | #define CEXTERN 38 | #endif 39 | 40 | 41 | #ifdef __cplusplus 42 | #define EXPORT extern "C" __declspec (dllexport) 43 | #else 44 | #define EXPORT __declspec (dllexport) 45 | #endif -------------------------------------------------------------------------------- /openmsvbvm/vba_internal_coordinates.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include "vba_internal.h" 4 | 5 | //LONG convertCoordinates() 6 | -------------------------------------------------------------------------------- /openmsvbvm/vba_internal_includes.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | #include 11 | 12 | 13 | #ifdef __cplusplus 14 | #define CEXTERN extern "C" 15 | #else 16 | #define CEXTERN 17 | #endif 18 | 19 | 20 | #ifdef __cplusplus 21 | #define EXPORT extern "C" __declspec (dllexport) 22 | #else 23 | #define EXPORT __declspec (dllexport) 24 | #endif -------------------------------------------------------------------------------- /openmsvbvm/vba_objApp.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_objApp.h" 2 | 3 | #include "vba_internal.h" 4 | #include "vba_exception.h" 5 | 6 | HRESULT __stdcall CApp::get_Path(BSTR * rhs) 7 | { 8 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 9 | 10 | DEBUG_WIDE_OBJ("rhs %.8x", (unsigned int)rhs); 11 | 12 | wchar_t drive[_MAX_DRIVE]; 13 | wchar_t dir[_MAX_DIR]; 14 | wchar_t wszFileName[MAX_PATH]; 15 | 16 | GetModuleFileNameW(NULL, wszFileName, MAX_PATH); 17 | 18 | errno_t err; 19 | 20 | err = _wsplitpath_s( 21 | wszFileName, 22 | drive, _MAX_DRIVE, 23 | dir, _MAX_DIR, 24 | nullptr, 0, 25 | nullptr, 0 26 | ); 27 | 28 | swprintf( 29 | wszFileName, 30 | MAX_PATH, 31 | L"%ls%ls", 32 | drive, 33 | dir 34 | ); 35 | 36 | *rhs = SysAllocString(wszFileName); 37 | return S_OK; 38 | } 39 | 40 | HRESULT __stdcall CApp::put_Path(BSTR rhs) 41 | { 42 | return E_NOTIMPL; 43 | } 44 | 45 | HRESULT __stdcall CApp::get_EXEName(BSTR * rhs) 46 | { 47 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 48 | 49 | DEBUG_WIDE_OBJ("rhs %.8x", (unsigned int)rhs); 50 | 51 | wchar_t filename[_MAX_FNAME]; 52 | wchar_t wszFileName[MAX_PATH]; 53 | 54 | GetModuleFileNameW(NULL, wszFileName, MAX_PATH); 55 | 56 | errno_t err; 57 | 58 | err = _wsplitpath_s( 59 | wszFileName, 60 | nullptr, 0, 61 | nullptr, 0, 62 | filename, _MAX_FNAME, 63 | nullptr, 0 64 | ); 65 | 66 | *rhs = SysAllocString(filename); 67 | return S_OK; 68 | } 69 | 70 | HRESULT __stdcall CApp::put_EXEName(BSTR rhs) 71 | { 72 | return E_NOTIMPL; 73 | } 74 | 75 | HRESULT __stdcall CApp::get_Title(BSTR * rhs) 76 | { 77 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 78 | 79 | DEBUG_WIDE_OBJ("rhs %.8x", (unsigned int)rhs); 80 | 81 | 82 | 83 | /*DWORD dwHandle, dwLen; 84 | UINT BufLen; 85 | LPTSTR lpData, lpBuffer, LibName = argv[1]; 86 | VS_FIXEDFILEINFO *pFileInfo; 87 | 88 | LibName = fullpath(argv[1]); // try first the current directory 89 | dwLen = GetFileVersionInfoSize(LibName, &dwHandle); 90 | if (!dwLen) { 91 | free(LibName); 92 | LibName = searchpath(argv[1], ".dll"); 93 | dwLen = GetFileVersionInfoSize(LibName, &dwHandle); 94 | } 95 | if (!dwLen) { 96 | free(LibName); 97 | LibName = argv[1]; 98 | dwLen = GetFileVersionInfoSize(LibName, &dwHandle); 99 | } 100 | printf("Library: %s\n", LibName); 101 | if (!dwLen) { 102 | printf("VersionInfo not found\n"); 103 | return -1; 104 | } 105 | lpData = (LPTSTR)malloc(dwLen); 106 | if (!lpData) { 107 | perror("malloc"); 108 | return -1; 109 | } 110 | if (!GetFileVersionInfo(LibName, dwHandle, dwLen, lpData)) { 111 | free(lpData); 112 | printf("VersionInfo: not found\n"); 113 | return -1; 114 | } 115 | if (!VerQueryValue(lpData, "\\", (LPVOID)&pFileInfo, (PUINT)&BufLen)) { 116 | printf("VersionInfo: not found\n"); 117 | } 118 | else { 119 | printf("MajorVersion: %d\n", HIWORD(pFileInfo->dwFileVersionMS)); 120 | printf("MinorVersion: %d\n", LOWORD(pFileInfo->dwFileVersionMS)); 121 | printf("BuildNumber: %d\n", HIWORD(pFileInfo->dwFileVersionLS)); 122 | printf("RevisionNumber (QFE): %d\n", LOWORD(pFileInfo->dwFileVersionLS)); 123 | } 124 | 125 | if (!VerQueryValue(lpData, TEXT("\\StringFileInfo\\040904E4\\FileVersion"), 126 | (LPVOID)&lpBuffer, (PUINT)&BufLen)) { 127 | // language ID 040904E4: U.S. English, char set = Windows, Multilingual 128 | printf("FileVersion: not found\n"); 129 | } 130 | else 131 | printf("FileVersion: %s\n", lpBuffer); 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | // Structure used to store enumerated languages and code pages. 150 | HRESULT hr; 151 | 152 | struct LANGANDCODEPAGE { 153 | WORD wLanguage; 154 | WORD wCodePage; 155 | } *lpTranslate; 156 | 157 | 158 | // Read the list of languages and code pages. 159 | 160 | 161 | VerQueryValue(pBlock, 162 | TEXT("\VarFileInfo\Translation"), 163 | (LPVOID*)&lpTranslate, 164 | &cbTranslate); 165 | 166 | 167 | // Read the file description for each language and code page. 168 | 169 | 170 | for (i = 0; i < (cbTranslate / sizeof(struct LANGANDCODEPAGE)); i++) 171 | { 172 | hr = StringCchPrintf(SubBlock, 50, 173 | TEXT("\StringFileInfo\%04x%04x\FileDescription"), 174 | lpTranslate[i].wLanguage, 175 | lpTranslate[i].wCodePage); 176 | if (FAILED(hr)) 177 | { 178 | // TODO: write error handler. 179 | } 180 | 181 | 182 | // Retrieve file description for language and code page "i". 183 | VerQueryValue(pBlock, 184 | SubBlock, 185 | &lpBuffer, 186 | &dwBytes); 187 | } 188 | 189 | 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | */ 199 | 200 | 201 | 202 | 203 | 204 | *rhs = SysAllocString(L"This should be the title!"); 205 | return S_OK; 206 | } 207 | 208 | HRESULT __stdcall CApp::put_Title(BSTR rhs) 209 | { 210 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 211 | 212 | DEBUG_WIDE_OBJ("rhs %.8x", (unsigned int)rhs); 213 | return S_OK; 214 | } 215 | 216 | 217 | HRESULT __stdcall CApp::QueryInterface( 218 | REFIID riid, 219 | void **ppObj 220 | ) 221 | { 222 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 223 | 224 | DEBUG_WIDE_OBJ("riid , ppObj %.8x", (unsigned int)ppObj); 225 | if (riid == IID_IUnknown) 226 | { 227 | *ppObj = static_cast(this); 228 | AddRef(); 229 | return S_OK; 230 | } 231 | if (riid == IID_IApp) 232 | { 233 | *ppObj = static_cast(this); 234 | AddRef(); 235 | return S_OK; 236 | } 237 | // 238 | // if control reaches here then , let the client know that 239 | // we do not satisfy the required interface 240 | // 241 | *ppObj = NULL; 242 | return E_NOINTERFACE; 243 | } 244 | 245 | ULONG __stdcall CApp::AddRef() 246 | { 247 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 248 | 249 | DEBUG_WIDE_OBJ(""); 250 | 251 | return InterlockedIncrement(&m_nRefCount); 252 | } 253 | 254 | ULONG __stdcall CApp::Release() 255 | { 256 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 257 | 258 | DEBUG_WIDE_OBJ(""); 259 | 260 | long nRefCount = 0; 261 | nRefCount = InterlockedDecrement(&m_nRefCount); 262 | if (nRefCount == 0) delete this; 263 | return nRefCount; 264 | } 265 | 266 | HRESULT __stdcall CApp::GetTypeInfoCount(UINT * pctInfo) 267 | { 268 | return E_NOTIMPL; 269 | } 270 | 271 | HRESULT __stdcall CApp::GetTypeInfo(UINT itinfo, LCID lcid, ITypeInfo ** pptinfo) 272 | { 273 | return E_NOTIMPL; 274 | } 275 | 276 | HRESULT __stdcall CApp::GetIDsOfNames(REFIID riid, LPOLESTR * rgszNames, UINT cNames, LCID lcid, DISPID * rgdispid) 277 | { 278 | return E_NOTIMPL; 279 | } 280 | 281 | HRESULT __stdcall CApp::Invoke(DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, DISPPARAMS * pdispparams, VARIANT * pvarResult, EXCEPINFO * pexcepinfo, UINT * puArgErr) 282 | { 283 | return E_NOTIMPL; 284 | } 285 | 286 | 287 | HRESULT _stdcall CApp::HctlDemandLoad(unsigned int * ctl) 288 | { 289 | return E_NOTIMPL; 290 | } 291 | 292 | HRESULT _stdcall CApp::ChkProp(unsigned int i, unsigned int * tagData) 293 | { 294 | return E_NOTIMPL; 295 | } 296 | HRESULT _stdcall CApp::SetPropA(unsigned int i, unsigned int * tagData) 297 | { 298 | return E_NOTIMPL; 299 | } 300 | HRESULT _stdcall CApp::GetPropA(unsigned int i, unsigned int * tagData) 301 | { 302 | return E_NOTIMPL; 303 | } 304 | HRESULT _stdcall CApp::GetPropHsz(unsigned int i, unsigned char ** hsz) 305 | { 306 | return E_NOTIMPL; 307 | } 308 | HRESULT _stdcall CApp::LoadProp(unsigned int i, unsigned int * fref) 309 | { 310 | return E_NOTIMPL; 311 | } 312 | HRESULT _stdcall CApp::SaveProp(unsigned int i, unsigned int * fref) 313 | { 314 | return E_NOTIMPL; 315 | } 316 | HRESULT _stdcall CApp::GetPalette(void) 317 | { 318 | return E_NOTIMPL; 319 | } 320 | HRESULT _stdcall CApp::Reset(void) 321 | { 322 | return E_NOTIMPL; 323 | } 324 | HRESULT _stdcall CApp::get_DefaultProp(VARIANT * var) 325 | { 326 | return E_NOTIMPL; 327 | } 328 | HRESULT _stdcall CApp::put_DefaultProp(VARIANT * var) 329 | { 330 | return E_NOTIMPL; 331 | } 332 | HRESULT _stdcall CApp::get_000x(VARIANT * var) 333 | { 334 | return E_NOTIMPL; 335 | } 336 | HRESULT _stdcall CApp::put_000x(unsigned int i) 337 | { 338 | return E_NOTIMPL; 339 | } 340 | 341 | 342 | extern ULONG g_Components; /* from DllObjectInterface.cpp */ 343 | 344 | CApp::CApp() : m_nRefCount(1) 345 | { 346 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 347 | 348 | DEBUG_WIDE_OBJ(""); 349 | 350 | InterlockedIncrement((LONG*)&g_Components); 351 | } 352 | 353 | CApp::~CApp() 354 | { 355 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 356 | 357 | DEBUG_WIDE_OBJ(""); 358 | 359 | InterlockedDecrement((LONG*)&g_Components); 360 | } 361 | 362 | -------------------------------------------------------------------------------- /openmsvbvm/vba_objApp.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include "vba_objApp_h.h" // Generated by MIDL compiler 3 | 4 | class CApp : public IApp 5 | { 6 | public: 7 | CApp(); 8 | ~CApp(); 9 | 10 | // IUnknown interface 11 | HRESULT __stdcall QueryInterface( 12 | REFIID riid, 13 | void **ppObj); 14 | ULONG __stdcall AddRef(); 15 | ULONG __stdcall Release(); 16 | 17 | // IDispatch interface 18 | HRESULT __stdcall GetTypeInfoCount(UINT * pctInfo); 19 | HRESULT __stdcall GetTypeInfo(UINT itinfo, LCID lcid, ITypeInfo** pptinfo); 20 | HRESULT __stdcall GetIDsOfNames(REFIID riid, LPOLESTR* rgszNames, UINT cNames, LCID lcid, DISPID* rgdispid); 21 | HRESULT __stdcall Invoke(DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, DISPPARAMS* pdispparams, VARIANT* pvarResult, EXCEPINFO* pexcepinfo, UINT* puArgErr); 22 | 23 | // Unknown exported stuff 24 | HRESULT _stdcall HctlDemandLoad(unsigned int * ctl); 25 | HRESULT _stdcall ChkProp(unsigned int i, unsigned int * tagData); 26 | HRESULT _stdcall SetPropA( unsigned int i, unsigned int * tagData); 27 | HRESULT _stdcall GetPropA( unsigned int i, unsigned int * tagData); 28 | HRESULT _stdcall GetPropHsz( unsigned int i, unsigned char ** hsz); 29 | HRESULT _stdcall LoadProp( unsigned int i, unsigned int * fref); 30 | HRESULT _stdcall SaveProp( unsigned int i, unsigned int * fref); 31 | HRESULT _stdcall GetPalette(void); 32 | HRESULT _stdcall Reset(void); 33 | HRESULT _stdcall get_DefaultProp( VARIANT * var); 34 | HRESULT _stdcall put_DefaultProp( VARIANT * var); 35 | HRESULT _stdcall get_000x( VARIANT * var); 36 | HRESULT _stdcall put_000x( unsigned int i); 37 | 38 | // IApp interface 39 | HRESULT __stdcall get_Path(BSTR* rhs); 40 | HRESULT __stdcall put_Path(BSTR rhs); 41 | 42 | HRESULT __stdcall get_EXEName(BSTR* rhs); 43 | HRESULT __stdcall put_EXEName(BSTR rhs); 44 | 45 | HRESULT __stdcall get_Title(BSTR* rhs); 46 | HRESULT __stdcall put_Title(BSTR rhs); 47 | 48 | private: 49 | long m_nRefCount; // for managing the reference count 50 | }; 51 | -------------------------------------------------------------------------------- /openmsvbvm/vba_objApp.idl: -------------------------------------------------------------------------------- 1 | import "oaidl.idl"; 2 | import "ocidl.idl"; 3 | 4 | [ 5 | uuid(33ad4f79-6699-11cf-b70c-00aa0060d393), /* Original */ 6 | //cocl 33ad4f78-6699-11cf-b70c-00aa0060d393 7 | //uuid(0EC94A23-2161-446D-AC25-581835A0F50E), /* New */ 8 | helpstring("Contains general information about an application."), 9 | helpcontext(0x000dfa39), 10 | hidden, 11 | nonextensible 12 | ] 13 | interface IApp : IDispatch 14 | { 15 | /* 16 | .text:6601BE8C dd offset ?HctlDemandLoad@_CCTLUSER_vtbl@@UAEJPAPAUCTL@@@Z ; _CCTLUSER_vtbl::HctlDemandLoad(CTL * *) 17 | .text:6601BE90 dd offset ?ChkProp@_CLINE_vtbl@@UAEJHTtagDATA@@@Z ; _CLINE_vtbl::ChkProp(int,tagDATA) 18 | .text:6601BE94 dd offset ?SetPropA@_CFRAME_vtbl@@UAEJHTtagDATA@@@Z ; _CFRAME_vtbl::SetPropA(int,tagDATA) 19 | .text:6601BE98 dd offset ?GetPropA@_CLINE_vtbl@@UAEJHPATtagDATA@@@Z ; _CLINE_vtbl::GetPropA(int,tagDATA *) 20 | .text:6601BE9C dd offset ?GetPropHsz@_CPIX_vtbl@@UAEJHPAPAD@Z ; _CPIX_vtbl::GetPropHsz(int,char * *) 21 | .text:6601BEA0 dd offset ?LoadProp@_CCTLUSER_vtbl@@UAEJHPAUFILEREF@@@Z ; _CCTLUSER_vtbl::LoadProp(int,FILEREF *) 22 | .text:6601BEA4 dd offset ?SaveProp@_COLE2CLIENT_vtbl@@UAEJHPAUFILEREF@@@Z ; _COLE2CLIENT_vtbl::SaveProp(int,FILEREF *) 23 | .text:6601BEA8 dd offset ?GetPalette@_CSHAPE_vtbl@@UAEPAUHPALETTE__@@XZ ; _CSHAPE_vtbl::GetPalette(void) 24 | .text:6601BEAC dd offset ?Reset@_CLABEL_vtbl@@UAEXXZ ; _CLABEL_vtbl::Reset(void) 25 | .text:6601BEB0 dd offset ?get_DefaultProp@_CAPP_vtbl@@UAGJPAUtagVARIANT@@@Z ; _CAPP_vtbl::get_DefaultProp(tagVARIANT *) 26 | .text:6601BEB4 dd offset ?put_DefaultProp@_CAPP_vtbl@@UAGJUtagVARIANT@@@Z ; _CAPP_vtbl::put_DefaultProp(tagVARIANT) 27 | .text:6601BEB8 dd offset ?get_000x@_CAPP_vtbl@@UAGJPAX@Z ; _CAPP_vtbl::get_000x(void *) 28 | .text:6601BEBC dd offset ?put_000x@_CAPP_vtbl@@UAGJJ@Z ; _CAPP_vtbl::put_000x(long) 29 | */ 30 | [helpstring("Unknown exported method")] 31 | HRESULT _stdcall HctlDemandLoad([out] unsigned int * ctl); 32 | [helpstring("Unknown exported method")] 33 | HRESULT _stdcall ChkProp([in] unsigned int i, [out] unsigned int * tagData); 34 | [helpstring("Unknown exported method")] 35 | HRESULT _stdcall SetPropA([in] unsigned int i, [out] unsigned int * tagData); 36 | [helpstring("Unknown exported method")] 37 | HRESULT _stdcall GetPropA([in] unsigned int i, [out] unsigned int * tagData); 38 | [helpstring("Unknown exported method")] 39 | HRESULT _stdcall GetPropHsz([in] unsigned int i, [out] char ** hsz); 40 | [helpstring("Unknown exported method")] 41 | HRESULT _stdcall LoadProp([in] unsigned int i, [out] unsigned int * fref); 42 | [helpstring("Unknown exported method")] 43 | HRESULT _stdcall SaveProp([in] unsigned int i, [out] unsigned int * fref); 44 | [helpstring("Unknown exported method")] 45 | HRESULT _stdcall GetPalette(void); 46 | [helpstring("Unknown exported method")] 47 | HRESULT _stdcall Reset(void); 48 | [helpstring("Unknown exported method")] 49 | HRESULT _stdcall get_DefaultProp([out] VARIANT * var); 50 | [helpstring("Unknown exported method")] 51 | HRESULT _stdcall put_DefaultProp([out] VARIANT * var); 52 | [helpstring("Unknown exported method")] 53 | HRESULT _stdcall get_000x([out] VARIANT * var); 54 | [helpstring("Unknown exported method")] 55 | HRESULT _stdcall put_000x([in] unsigned int i); 56 | 57 | [propget, helpstring("Specifies the path of the project .VBP file when running the application from the development environment or the path of the executable file when running the application as an executable file."), helpcontext(0x000dfc1a)] 58 | HRESULT _stdcall Path([out, retval] BSTR* rhs); 59 | [propput, helpstring("Specifies the path of the project .VBP file when running the application from the development environment or the path of the executable file when running the application as an executable file."), helpcontext(0x000dfc1a)] 60 | HRESULT _stdcall Path([in] BSTR rhs); 61 | 62 | [propget, helpstring("Returns the name of the executable file for the current project. If running in the development environment, returns the name of the project."), helpcontext(0x000dfc41)] 63 | HRESULT _stdcall EXEName([out, retval] BSTR* rhs); 64 | [propput, helpstring("Sets the name of the executable file for the current project. If running in the development environment, returns the name of the project."), helpcontext(0x000dfc41)] 65 | HRESULT _stdcall EXEName([in] BSTR rhs); 66 | 67 | [propget, helpstring("Returns/sets the title of the application displayed in the Microsoft Windows Task List."), helpcontext(0x000dfcad)] 68 | HRESULT _stdcall Title([out, retval] BSTR* rhs); 69 | [propput, helpstring("Returns/sets the title of the application displayed in the Microsoft Windows Task List."), helpcontext(0x000dfcad)] 70 | HRESULT _stdcall Title([in] BSTR rhs); 71 | 72 | /*[id(0x00010004), propget, helpstring("Returns a value that determines whether a previous instance of an application is already running."), helpcontext(0x000dfc8f)] 73 | HRESULT PrevInstance([out, retval] VARIANT_BOOL* rhs); 74 | [id(0x00010005), propget, helpstring("Returns/sets whether an application starts as a stand-alone project or an ActiveX component."), helpcontext(0x000dfca5)] 75 | HRESULT StartMode([out, retval] short* rhs); 76 | [id(0x00010006), propget, helpstring("Returns/sets a value that determines if a task is visible in the task list."), helpcontext(0x000dfcd9)] 77 | HRESULT TaskVisible([out, retval] VARIANT_BOOL* rhs); 78 | [id(0x00010006), propput, helpstring("Returns/sets a value that determines if a task is visible in the task list."), helpcontext(0x000dfcd9)] 79 | HRESULT TaskVisible([in] VARIANT_BOOL rhs); 80 | [id(0x00010007), propget, helpstring("Returns/sets milliseconds during which an Automation request will continue to be retried."), helpcontext(0x000dfcda)] 81 | HRESULT OleServerBusyTimeout([out, retval] long* rhs); 82 | [id(0x00010007), propput, helpstring("Returns/sets milliseconds during which an Automation request will continue to be retried."), helpcontext(0x000dfcda)] 83 | HRESULT OleServerBusyTimeout([in] long rhs); 84 | [id(0x00010008), propget, helpstring("Returns/sets title of 'busy' message displayed when an ActiveX component rejects a request."), helpcontext(0x000dfcdb)] 85 | HRESULT OleServerBusyMsgTitle([out, retval] BSTR* rhs); 86 | [id(0x00010008), propput, helpstring("Returns/sets title of 'busy' message displayed when an ActiveX component rejects a request."), helpcontext(0x000dfcdb)] 87 | HRESULT OleServerBusyMsgTitle([in] BSTR rhs); 88 | [id(0x00010009), propget, helpstring("Returns/sets text of 'busy' message displayed if an ActiveX component rejects a request."), helpcontext(0x000dfcdc)] 89 | HRESULT OleServerBusyMsgText([out, retval] BSTR* rhs); 90 | [id(0x00010009), propput, helpstring("Returns/sets text of 'busy' message displayed if an ActiveX component rejects a request."), helpcontext(0x000dfcdc)] 91 | HRESULT OleServerBusyMsgText([in] BSTR rhs); 92 | [id(0x0001000a), propget, helpstring("Determines whether a rejected Automation request raises an error, instead of displaying a 'busy' message."), helpcontext(0x000dfcdd)] 93 | HRESULT OleServerBusyRaiseError([out, retval] VARIANT_BOOL* rhs); 94 | [id(0x0001000a), propput, helpstring("Determines whether a rejected Automation request raises an error, instead of displaying a 'busy' message."), helpcontext(0x000dfcdd)] 95 | HRESULT OleServerBusyRaiseError([in] VARIANT_BOOL rhs); 96 | [id(0x0001000b), propget, helpstring("Returns/sets milliseconds Automation requests will run before user actions trigger a 'busy' message."), helpcontext(0x000dfcde)] 97 | HRESULT OleRequestPendingTimeout([out, retval] long* rhs); 98 | [id(0x0001000b), propput, helpstring("Returns/sets milliseconds Automation requests will run before user actions trigger a 'busy' message."), helpcontext(0x000dfcde)] 99 | HRESULT OleRequestPendingTimeout([in] long rhs); 100 | [id(0x0001000c), propget, helpstring("Returns/sets title of 'busy' message displayed while an Automation request is pending."), helpcontext(0x000dfcdf)] 101 | HRESULT OleRequestPendingMsgTitle([out, retval] BSTR* rhs); 102 | [id(0x0001000c), propput, helpstring("Returns/sets title of 'busy' message displayed while an Automation request is pending."), helpcontext(0x000dfcdf)] 103 | HRESULT OleRequestPendingMsgTitle([in] BSTR rhs); 104 | [id(0x0001000d), propget, helpstring("Returns/sets text of 'busy' message displayed while an Automation request is pending."), helpcontext(0x000dfce0)] 105 | HRESULT OleRequestPendingMsgText([out, retval] BSTR* rhs); 106 | [id(0x0001000d), propput, helpstring("Returns/sets text of 'busy' message displayed while an Automation request is pending."), helpcontext(0x000dfce0)] 107 | HRESULT OleRequestPendingMsgText([in] BSTR rhs); 108 | [id(0x0001000e), propget, helpstring("Returns the major release number of the project."), helpcontext(0x000dfce1)] 109 | HRESULT Major([out, retval] short* rhs); 110 | [id(0x0001000f), propget, helpstring("Returns the minor release number of the project."), helpcontext(0x000dfce2)] 111 | HRESULT Minor([out, retval] short* rhs); 112 | [id(0x00010010), propget, helpstring("Returns the revision version number of the project."), helpcontext(0x000dfce3)] 113 | HRESULT Revision([out, retval] short* rhs); 114 | [id(0x00010011), propget, helpstring("Returns comments about the running application."), helpcontext(0x000dfce4)] 115 | HRESULT Comments([out, retval] BSTR* rhs); 116 | [id(0x00010012), propget, helpstring("Returns the name of the application's author."), helpcontext(0x000dfce5)] 117 | HRESULT CompanyName([out, retval] BSTR* rhs); 118 | [id(0x00010013), propget, helpstring("Returns a file description of the running application."), helpcontext(0x000dfce6)] 119 | HRESULT FileDescription([out, retval] BSTR* rhs); 120 | [id(0x00010014), propget, helpstring("Returns copyright information about the running application."), helpcontext(0x000dfce7)] 121 | HRESULT LegalCopyright([out, retval] BSTR* rhs); 122 | [id(0x00010015), propget, helpstring("Returns trademark information about the running application."), helpcontext(0x000dfce8)] 123 | HRESULT LegalTrademarks([out, retval] BSTR* rhs); 124 | [id(0x00010016), propget, helpstring("Returns the product name of the running application."), helpcontext(0x000dfce9)] 125 | HRESULT ProductName([out, retval] BSTR* rhs); 126 | [id(0x00010017), propget, helpstring("Returns the instance handle of the application."), helpcontext(0x000dfcec)] 127 | HRESULT hInstance([out, retval] long* rhs); 128 | [id(0x00010018), propget, helpstring("Returns a value which indicates if a form can be shown non-modally (modeless)."), helpcontext(0x000dfd01)] 129 | HRESULT NonModalAllowed([out, retval] VARIANT_BOOL* rhs); 130 | [id(0x00010019), propget, helpstring("Returns the filename for an application's log (if logging to a file)."), helpcontext(0x000dfd0c)] 131 | HRESULT LogPath([out, retval] BSTR* rhs); 132 | [id(0x0001001a), propget, helpstring("Returns a value that indicates the target (event log or log file) and other log attributes."), helpcontext(0x000dfd0d)] 133 | HRESULT LogMode([out, retval] long* rhs); 134 | [id(0x0001001b), propget, helpstring("Returns/sets a value that determines whether an application will run without any user interface."), helpcontext(0x000dfd0e)] 135 | HRESULT UnattendedApp([out, retval] VARIANT_BOOL* rhs); 136 | [id(0x0001001c), propget, helpstring("Returns the ID of the executing thread."), helpcontext(0x000dfd0f)] 137 | HRESULT ThreadID([out, retval] long* rhs); 138 | [id(0x0001001d), propget, helpstring("Returns/sets the name of the Help file associated with the project."), helpcontext(0x000dfc55)] 139 | HRESULT HelpFile([out, retval] BSTR* rhs); 140 | [id(0x0001001d), propput, helpstring("Returns/sets the name of the Help file associated with the project."), helpcontext(0x000dfc55)] 141 | HRESULT HelpFile([in] BSTR rhs); 142 | [id(0x0001001e), propget, helpstring("Returns/sets a value that determines whether a project will remain loaded in memory."), helpcontext(0x000dfd35)] 143 | HRESULT RetainedProject([out, retval] VARIANT_BOOL* rhs); 144 | [id(0x00020000), helpstring("Sets the log target and log mode for an application"), helpcontext(0x000dfac1)] 145 | HRESULT StartLogging( 146 | [in] BSTR LogTarget, 147 | [in] long LogModes 148 | ); 149 | [id(0x00020001), helpstring("Logs an event in the application's log target"), helpcontext(0x000dfac2)] 150 | HRESULT LogEvent( 151 | [in] BSTR LogBuffer, 152 | [in] VARIANT EventType 153 | );*/ 154 | 155 | }; 156 | -------------------------------------------------------------------------------- /openmsvbvm/vba_objApp_h.h: -------------------------------------------------------------------------------- 1 | 2 | 3 | /* this ALWAYS GENERATED file contains the definitions for the interfaces */ 4 | 5 | 6 | /* File created by MIDL compiler version 8.01.0622 */ 7 | /* at Tue Jan 19 00:14:07 2038 8 | */ 9 | /* Compiler settings for vba_objApp.idl: 10 | Oicf, W1, Zp8, env=Win32 (32b run), target_arch=X86 8.01.0622 11 | protocol : dce , ms_ext, c_ext, robust 12 | error checks: allocation ref bounds_check enum stub_data 13 | VC __declspec() decoration level: 14 | __declspec(uuid()), __declspec(selectany), __declspec(novtable) 15 | DECLSPEC_UUID(), MIDL_INTERFACE() 16 | */ 17 | /* @@MIDL_FILE_HEADING( ) */ 18 | 19 | 20 | 21 | /* verify that the version is high enough to compile this file*/ 22 | #ifndef __REQUIRED_RPCNDR_H_VERSION__ 23 | #define __REQUIRED_RPCNDR_H_VERSION__ 500 24 | #endif 25 | 26 | #include "rpc.h" 27 | #include "rpcndr.h" 28 | 29 | #ifndef __RPCNDR_H_VERSION__ 30 | #error this stub requires an updated version of 31 | #endif /* __RPCNDR_H_VERSION__ */ 32 | 33 | #ifndef COM_NO_WINDOWS_H 34 | #include "windows.h" 35 | #include "ole2.h" 36 | #endif /*COM_NO_WINDOWS_H*/ 37 | 38 | #ifndef __vba_objApp_h_h__ 39 | #define __vba_objApp_h_h__ 40 | 41 | #if defined(_MSC_VER) && (_MSC_VER >= 1020) 42 | #pragma once 43 | #endif 44 | 45 | /* Forward Declarations */ 46 | 47 | #ifndef __IApp_FWD_DEFINED__ 48 | #define __IApp_FWD_DEFINED__ 49 | typedef interface IApp IApp; 50 | 51 | #endif /* __IApp_FWD_DEFINED__ */ 52 | 53 | 54 | /* header files for imported files */ 55 | #include "oaidl.h" 56 | #include "ocidl.h" 57 | 58 | #ifdef __cplusplus 59 | extern "C"{ 60 | #endif 61 | 62 | 63 | #ifndef __IApp_INTERFACE_DEFINED__ 64 | #define __IApp_INTERFACE_DEFINED__ 65 | 66 | /* interface IApp */ 67 | /* [object][nonextensible][hidden][helpcontext][helpstring][uuid] */ 68 | 69 | 70 | EXTERN_C const IID IID_IApp; 71 | 72 | #if defined(__cplusplus) && !defined(CINTERFACE) 73 | 74 | MIDL_INTERFACE("33ad4f79-6699-11cf-b70c-00aa0060d393") 75 | IApp : public IDispatch 76 | { 77 | public: 78 | virtual /* [helpstring] */ HRESULT __stdcall HctlDemandLoad( 79 | /* [out] */ unsigned int *ctl) = 0; 80 | 81 | virtual /* [helpstring] */ HRESULT __stdcall ChkProp( 82 | /* [in] */ unsigned int i, 83 | /* [out] */ unsigned int *tagData) = 0; 84 | 85 | virtual /* [helpstring] */ HRESULT __stdcall SetPropA( 86 | /* [in] */ unsigned int i, 87 | /* [out] */ unsigned int *tagData) = 0; 88 | 89 | virtual /* [helpstring] */ HRESULT __stdcall GetPropA( 90 | /* [in] */ unsigned int i, 91 | /* [out] */ unsigned int *tagData) = 0; 92 | 93 | virtual /* [helpstring] */ HRESULT __stdcall GetPropHsz( 94 | /* [in] */ unsigned int i, 95 | /* [out] */ unsigned char **hsz) = 0; 96 | 97 | virtual /* [helpstring] */ HRESULT __stdcall LoadProp( 98 | /* [in] */ unsigned int i, 99 | /* [out] */ unsigned int *fref) = 0; 100 | 101 | virtual /* [helpstring] */ HRESULT __stdcall SaveProp( 102 | /* [in] */ unsigned int i, 103 | /* [out] */ unsigned int *fref) = 0; 104 | 105 | virtual /* [helpstring] */ HRESULT __stdcall GetPalette( void) = 0; 106 | 107 | virtual /* [helpstring] */ HRESULT __stdcall Reset( void) = 0; 108 | 109 | virtual /* [helpstring] */ HRESULT __stdcall get_DefaultProp( 110 | /* [out] */ VARIANT *var) = 0; 111 | 112 | virtual /* [helpstring] */ HRESULT __stdcall put_DefaultProp( 113 | /* [out] */ VARIANT *var) = 0; 114 | 115 | virtual /* [helpstring] */ HRESULT __stdcall get_000x( 116 | /* [out] */ VARIANT *var) = 0; 117 | 118 | virtual /* [helpstring] */ HRESULT __stdcall put_000x( 119 | /* [in] */ unsigned int i) = 0; 120 | 121 | virtual /* [helpcontext][helpstring][propget] */ HRESULT __stdcall get_Path( 122 | /* [retval][out] */ BSTR *rhs) = 0; 123 | 124 | virtual /* [helpcontext][helpstring][propput] */ HRESULT __stdcall put_Path( 125 | /* [in] */ BSTR rhs) = 0; 126 | 127 | virtual /* [helpcontext][helpstring][propget] */ HRESULT __stdcall get_EXEName( 128 | /* [retval][out] */ BSTR *rhs) = 0; 129 | 130 | virtual /* [helpcontext][helpstring][propput] */ HRESULT __stdcall put_EXEName( 131 | /* [in] */ BSTR rhs) = 0; 132 | 133 | virtual /* [helpcontext][helpstring][propget] */ HRESULT __stdcall get_Title( 134 | /* [retval][out] */ BSTR *rhs) = 0; 135 | 136 | virtual /* [helpcontext][helpstring][propput] */ HRESULT __stdcall put_Title( 137 | /* [in] */ BSTR rhs) = 0; 138 | 139 | }; 140 | 141 | 142 | #else /* C style interface */ 143 | 144 | typedef struct IAppVtbl 145 | { 146 | BEGIN_INTERFACE 147 | 148 | HRESULT ( STDMETHODCALLTYPE *QueryInterface )( 149 | IApp * This, 150 | /* [in] */ REFIID riid, 151 | /* [annotation][iid_is][out] */ 152 | _COM_Outptr_ void **ppvObject); 153 | 154 | ULONG ( STDMETHODCALLTYPE *AddRef )( 155 | IApp * This); 156 | 157 | ULONG ( STDMETHODCALLTYPE *Release )( 158 | IApp * This); 159 | 160 | HRESULT ( STDMETHODCALLTYPE *GetTypeInfoCount )( 161 | IApp * This, 162 | /* [out] */ UINT *pctinfo); 163 | 164 | HRESULT ( STDMETHODCALLTYPE *GetTypeInfo )( 165 | IApp * This, 166 | /* [in] */ UINT iTInfo, 167 | /* [in] */ LCID lcid, 168 | /* [out] */ ITypeInfo **ppTInfo); 169 | 170 | HRESULT ( STDMETHODCALLTYPE *GetIDsOfNames )( 171 | IApp * This, 172 | /* [in] */ REFIID riid, 173 | /* [size_is][in] */ LPOLESTR *rgszNames, 174 | /* [range][in] */ UINT cNames, 175 | /* [in] */ LCID lcid, 176 | /* [size_is][out] */ DISPID *rgDispId); 177 | 178 | /* [local] */ HRESULT ( STDMETHODCALLTYPE *Invoke )( 179 | IApp * This, 180 | /* [annotation][in] */ 181 | _In_ DISPID dispIdMember, 182 | /* [annotation][in] */ 183 | _In_ REFIID riid, 184 | /* [annotation][in] */ 185 | _In_ LCID lcid, 186 | /* [annotation][in] */ 187 | _In_ WORD wFlags, 188 | /* [annotation][out][in] */ 189 | _In_ DISPPARAMS *pDispParams, 190 | /* [annotation][out] */ 191 | _Out_opt_ VARIANT *pVarResult, 192 | /* [annotation][out] */ 193 | _Out_opt_ EXCEPINFO *pExcepInfo, 194 | /* [annotation][out] */ 195 | _Out_opt_ UINT *puArgErr); 196 | 197 | /* [helpstring] */ HRESULT ( __stdcall *HctlDemandLoad )( 198 | IApp * This, 199 | /* [out] */ unsigned int *ctl); 200 | 201 | /* [helpstring] */ HRESULT ( __stdcall *ChkProp )( 202 | IApp * This, 203 | /* [in] */ unsigned int i, 204 | /* [out] */ unsigned int *tagData); 205 | 206 | /* [helpstring] */ HRESULT ( __stdcall *SetPropA )( 207 | IApp * This, 208 | /* [in] */ unsigned int i, 209 | /* [out] */ unsigned int *tagData); 210 | 211 | /* [helpstring] */ HRESULT ( __stdcall *GetPropA )( 212 | IApp * This, 213 | /* [in] */ unsigned int i, 214 | /* [out] */ unsigned int *tagData); 215 | 216 | /* [helpstring] */ HRESULT ( __stdcall *GetPropHsz )( 217 | IApp * This, 218 | /* [in] */ unsigned int i, 219 | /* [out] */ unsigned char **hsz); 220 | 221 | /* [helpstring] */ HRESULT ( __stdcall *LoadProp )( 222 | IApp * This, 223 | /* [in] */ unsigned int i, 224 | /* [out] */ unsigned int *fref); 225 | 226 | /* [helpstring] */ HRESULT ( __stdcall *SaveProp )( 227 | IApp * This, 228 | /* [in] */ unsigned int i, 229 | /* [out] */ unsigned int *fref); 230 | 231 | /* [helpstring] */ HRESULT ( __stdcall *GetPalette )( 232 | IApp * This); 233 | 234 | /* [helpstring] */ HRESULT ( __stdcall *Reset )( 235 | IApp * This); 236 | 237 | /* [helpstring] */ HRESULT ( __stdcall *get_DefaultProp )( 238 | IApp * This, 239 | /* [out] */ VARIANT *var); 240 | 241 | /* [helpstring] */ HRESULT ( __stdcall *put_DefaultProp )( 242 | IApp * This, 243 | /* [out] */ VARIANT *var); 244 | 245 | /* [helpstring] */ HRESULT ( __stdcall *get_000x )( 246 | IApp * This, 247 | /* [out] */ VARIANT *var); 248 | 249 | /* [helpstring] */ HRESULT ( __stdcall *put_000x )( 250 | IApp * This, 251 | /* [in] */ unsigned int i); 252 | 253 | /* [helpcontext][helpstring][propget] */ HRESULT ( __stdcall *get_Path )( 254 | IApp * This, 255 | /* [retval][out] */ BSTR *rhs); 256 | 257 | /* [helpcontext][helpstring][propput] */ HRESULT ( __stdcall *put_Path )( 258 | IApp * This, 259 | /* [in] */ BSTR rhs); 260 | 261 | /* [helpcontext][helpstring][propget] */ HRESULT ( __stdcall *get_EXEName )( 262 | IApp * This, 263 | /* [retval][out] */ BSTR *rhs); 264 | 265 | /* [helpcontext][helpstring][propput] */ HRESULT ( __stdcall *put_EXEName )( 266 | IApp * This, 267 | /* [in] */ BSTR rhs); 268 | 269 | /* [helpcontext][helpstring][propget] */ HRESULT ( __stdcall *get_Title )( 270 | IApp * This, 271 | /* [retval][out] */ BSTR *rhs); 272 | 273 | /* [helpcontext][helpstring][propput] */ HRESULT ( __stdcall *put_Title )( 274 | IApp * This, 275 | /* [in] */ BSTR rhs); 276 | 277 | END_INTERFACE 278 | } IAppVtbl; 279 | 280 | interface IApp 281 | { 282 | CONST_VTBL struct IAppVtbl *lpVtbl; 283 | }; 284 | 285 | 286 | 287 | #ifdef COBJMACROS 288 | 289 | 290 | #define IApp_QueryInterface(This,riid,ppvObject) \ 291 | ( (This)->lpVtbl -> QueryInterface(This,riid,ppvObject) ) 292 | 293 | #define IApp_AddRef(This) \ 294 | ( (This)->lpVtbl -> AddRef(This) ) 295 | 296 | #define IApp_Release(This) \ 297 | ( (This)->lpVtbl -> Release(This) ) 298 | 299 | 300 | #define IApp_GetTypeInfoCount(This,pctinfo) \ 301 | ( (This)->lpVtbl -> GetTypeInfoCount(This,pctinfo) ) 302 | 303 | #define IApp_GetTypeInfo(This,iTInfo,lcid,ppTInfo) \ 304 | ( (This)->lpVtbl -> GetTypeInfo(This,iTInfo,lcid,ppTInfo) ) 305 | 306 | #define IApp_GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId) \ 307 | ( (This)->lpVtbl -> GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId) ) 308 | 309 | #define IApp_Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr) \ 310 | ( (This)->lpVtbl -> Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr) ) 311 | 312 | 313 | #define IApp_HctlDemandLoad(This,ctl) \ 314 | ( (This)->lpVtbl -> HctlDemandLoad(This,ctl) ) 315 | 316 | #define IApp_ChkProp(This,i,tagData) \ 317 | ( (This)->lpVtbl -> ChkProp(This,i,tagData) ) 318 | 319 | #define IApp_SetPropA(This,i,tagData) \ 320 | ( (This)->lpVtbl -> SetPropA(This,i,tagData) ) 321 | 322 | #define IApp_GetPropA(This,i,tagData) \ 323 | ( (This)->lpVtbl -> GetPropA(This,i,tagData) ) 324 | 325 | #define IApp_GetPropHsz(This,i,hsz) \ 326 | ( (This)->lpVtbl -> GetPropHsz(This,i,hsz) ) 327 | 328 | #define IApp_LoadProp(This,i,fref) \ 329 | ( (This)->lpVtbl -> LoadProp(This,i,fref) ) 330 | 331 | #define IApp_SaveProp(This,i,fref) \ 332 | ( (This)->lpVtbl -> SaveProp(This,i,fref) ) 333 | 334 | #define IApp_GetPalette(This) \ 335 | ( (This)->lpVtbl -> GetPalette(This) ) 336 | 337 | #define IApp_Reset(This) \ 338 | ( (This)->lpVtbl -> Reset(This) ) 339 | 340 | #define IApp_get_DefaultProp(This,var) \ 341 | ( (This)->lpVtbl -> get_DefaultProp(This,var) ) 342 | 343 | #define IApp_put_DefaultProp(This,var) \ 344 | ( (This)->lpVtbl -> put_DefaultProp(This,var) ) 345 | 346 | #define IApp_get_000x(This,var) \ 347 | ( (This)->lpVtbl -> get_000x(This,var) ) 348 | 349 | #define IApp_put_000x(This,i) \ 350 | ( (This)->lpVtbl -> put_000x(This,i) ) 351 | 352 | #define IApp_get_Path(This,rhs) \ 353 | ( (This)->lpVtbl -> get_Path(This,rhs) ) 354 | 355 | #define IApp_put_Path(This,rhs) \ 356 | ( (This)->lpVtbl -> put_Path(This,rhs) ) 357 | 358 | #define IApp_get_EXEName(This,rhs) \ 359 | ( (This)->lpVtbl -> get_EXEName(This,rhs) ) 360 | 361 | #define IApp_put_EXEName(This,rhs) \ 362 | ( (This)->lpVtbl -> put_EXEName(This,rhs) ) 363 | 364 | #define IApp_get_Title(This,rhs) \ 365 | ( (This)->lpVtbl -> get_Title(This,rhs) ) 366 | 367 | #define IApp_put_Title(This,rhs) \ 368 | ( (This)->lpVtbl -> put_Title(This,rhs) ) 369 | 370 | #endif /* COBJMACROS */ 371 | 372 | 373 | #endif /* C style interface */ 374 | 375 | 376 | 377 | 378 | #endif /* __IApp_INTERFACE_DEFINED__ */ 379 | 380 | 381 | /* Additional Prototypes for ALL interfaces */ 382 | 383 | unsigned long __RPC_USER BSTR_UserSize( unsigned long *, unsigned long , BSTR * ); 384 | unsigned char * __RPC_USER BSTR_UserMarshal( unsigned long *, unsigned char *, BSTR * ); 385 | unsigned char * __RPC_USER BSTR_UserUnmarshal(unsigned long *, unsigned char *, BSTR * ); 386 | void __RPC_USER BSTR_UserFree( unsigned long *, BSTR * ); 387 | 388 | unsigned long __RPC_USER VARIANT_UserSize( unsigned long *, unsigned long , VARIANT * ); 389 | unsigned char * __RPC_USER VARIANT_UserMarshal( unsigned long *, unsigned char *, VARIANT * ); 390 | unsigned char * __RPC_USER VARIANT_UserUnmarshal(unsigned long *, unsigned char *, VARIANT * ); 391 | void __RPC_USER VARIANT_UserFree( unsigned long *, VARIANT * ); 392 | 393 | unsigned long __RPC_USER BSTR_UserSize64( unsigned long *, unsigned long , BSTR * ); 394 | unsigned char * __RPC_USER BSTR_UserMarshal64( unsigned long *, unsigned char *, BSTR * ); 395 | unsigned char * __RPC_USER BSTR_UserUnmarshal64(unsigned long *, unsigned char *, BSTR * ); 396 | void __RPC_USER BSTR_UserFree64( unsigned long *, BSTR * ); 397 | 398 | unsigned long __RPC_USER VARIANT_UserSize64( unsigned long *, unsigned long , VARIANT * ); 399 | unsigned char * __RPC_USER VARIANT_UserMarshal64( unsigned long *, unsigned char *, VARIANT * ); 400 | unsigned char * __RPC_USER VARIANT_UserUnmarshal64(unsigned long *, unsigned char *, VARIANT * ); 401 | void __RPC_USER VARIANT_UserFree64( unsigned long *, VARIANT * ); 402 | 403 | /* end of Additional Prototypes */ 404 | 405 | #ifdef __cplusplus 406 | } 407 | #endif 408 | 409 | #endif 410 | 411 | 412 | -------------------------------------------------------------------------------- /openmsvbvm/vba_objManipulation.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include "vba_internal.h" 3 | 4 | 5 | typedef struct 6 | { 7 | IUnknown *piunkPtr; 8 | LPGUID lpguidCoClass; 9 | LPGUID lpguidInterface; 10 | unsigned int dummy2; 11 | } vba_new_data_arg_t; 12 | 13 | EXPORT void __stdcall __vbaHresultCheckObj( 14 | int a1, int a2, struct _GUID *a3, __int16 a4 15 | ); 16 | 17 | /** 18 | * @brief Frees a list of COM Objects (IUnknowns) via their pointers, and nulls them. 19 | * @param argCount Count of elements. 20 | * @param ... Pointers to objects to free and null them. 21 | */ 22 | EXPORT void __cdecl __vbaFreeObjList( 23 | unsigned int argCount, 24 | ... 25 | ); 26 | 27 | /** 28 | * @brief TBD 29 | * @param TBD 30 | * @returns TBD 31 | */ 32 | EXPORT IUnknown * __fastcall __vbaFreeObj( 33 | IUnknown ** punkObj 34 | ); 35 | 36 | /** 37 | * @brief TBD 38 | * @param TBD TBD 39 | * @returns TBD 40 | */ 41 | EXPORT VARIANTARG * __cdecl __vbaVarLateMemCallLd( 42 | VARIANTARG * pvargRet, 43 | VARIANTARG * pvarObject, 44 | BSTR bstrMethodName, 45 | int argCount, 46 | ... 47 | ); 48 | 49 | /** 50 | * @brief TBD 51 | * @param TBD TBD 52 | * @returns TBD 53 | */ 54 | EXPORT VARIANTARG * __cdecl __vbaVarLateMemCallLdRf( 55 | VARIANTARG * pvargRet, 56 | VARIANTARG * pvarObject, 57 | BSTR bstrMethodName, 58 | int argCount, 59 | ... 60 | ); 61 | /** 62 | * @brief TBD 63 | * @param TBD TBD 64 | * @returns TBD 65 | */ 66 | EXPORT void __cdecl __vbaLateMemCall( 67 | IDispatch * pidObject, 68 | BSTR bstrMethodName, 69 | int argCount, 70 | ... 71 | ); 72 | /** 73 | * @brief Returns a pointer to an IDispatch from a VARIANTARG. 74 | * @param pvargIn Pointer to the VARIANTARG where the IDispatch will be extracted from. 75 | * @returns plVal from the VARIANTARG argument, only if the object type is VT_DISPATCH. 76 | */ 77 | EXPORT IDispatch * __stdcall __vbaObjVar( 78 | VARIANTARG * pvargIn 79 | ); 80 | /** 81 | * @brief TBD 82 | * @param TBD 83 | * @returns TBD 84 | */ 85 | EXPORT HRESULT __stdcall rtcCreateObject2( 86 | VARIANTARG *pvargObject, 87 | BSTR bstrClassName, 88 | BSTR bstrServerName 89 | ); 90 | /** 91 | * @brief TBD 92 | * @param TBD 93 | * @returns TBD 94 | */ 95 | EXPORT HRESULT __stdcall __vbaNew2( 96 | vba_new_data_arg_t *pvbNewData, 97 | struct IUnknown **ppv 98 | ); 99 | 100 | HRESULT objIDispatchGetDefaultValue( 101 | IDispatch * pidObject, 102 | VARIANTARG * pvargValueOut 103 | ); -------------------------------------------------------------------------------- /openmsvbvm/vba_objVBGlobal.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_objVBGlobal.h" 2 | 3 | #include "vba_internal.h" 4 | #include "vba_exception.h" 5 | 6 | HRESULT _stdcall CVBGlobal::Load(IDispatch * object) 7 | { 8 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 9 | 10 | DEBUG_WIDE_OBJ("object %.8x", (unsigned int)object); 11 | return E_NOTIMPL; 12 | } 13 | 14 | HRESULT _stdcall CVBGlobal::Unload(IDispatch * object) 15 | { 16 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 17 | 18 | DEBUG_WIDE_OBJ("object %.8x", (unsigned int)object); 19 | 20 | return E_NOTIMPL; 21 | } 22 | 23 | HRESULT _stdcall CVBGlobal::get_App(IApp ** pdispRetVal) 24 | { 25 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 26 | 27 | DEBUG_WIDE_OBJ("pdispRetVal %.8x", (unsigned int)pdispRetVal); 28 | 29 | *pdispRetVal = new CApp(); 30 | return S_OK; 31 | } 32 | 33 | 34 | HRESULT __stdcall CVBGlobal::QueryInterface( 35 | REFIID riid, 36 | void **ppObj 37 | ) 38 | { 39 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 40 | 41 | DEBUG_WIDE_OBJ( 42 | "ppObj %.8x", 43 | (unsigned int)ppObj 44 | ); 45 | 46 | DEBUG_WIDE_GUID(riid, "riid"); 47 | 48 | if (riid == IID_IUnknown) 49 | { 50 | *ppObj = static_cast(this); 51 | AddRef(); 52 | return S_OK; 53 | } 54 | if (riid == IID_IVBGlobal) 55 | { 56 | *ppObj = static_cast(this); 57 | AddRef(); 58 | return S_OK; 59 | } 60 | 61 | *ppObj = NULL; 62 | return E_NOINTERFACE; 63 | } 64 | 65 | ULONG __stdcall CVBGlobal::AddRef() 66 | { 67 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 68 | 69 | DEBUG_WIDE_OBJ(""); 70 | 71 | return InterlockedIncrement(&m_nRefCount); 72 | } 73 | 74 | ULONG __stdcall CVBGlobal::Release() 75 | { 76 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 77 | 78 | DEBUG_WIDE_OBJ(""); 79 | 80 | long nRefCount = 0; 81 | nRefCount = InterlockedDecrement(&m_nRefCount); 82 | if (nRefCount == 0) delete this; 83 | return nRefCount; 84 | } 85 | 86 | extern ULONG g_Components; /* from DllObjectInterface.cpp */ 87 | 88 | CVBGlobal::CVBGlobal() : m_nRefCount(1) 89 | { 90 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 91 | 92 | DEBUG_WIDE_OBJ(""); 93 | 94 | InterlockedIncrement((LONG*)&g_Components); 95 | } 96 | 97 | CVBGlobal::~CVBGlobal() 98 | { 99 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 100 | 101 | DEBUG_WIDE_OBJ(""); 102 | 103 | InterlockedDecrement((LONG*)&g_Components); 104 | } -------------------------------------------------------------------------------- /openmsvbvm/vba_objVBGlobal.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include "vba_objVBGlobal_h.h" // Generated by MIDL compiler 3 | #include "vba_objApp.h" 4 | 5 | class CVBGlobal : public IVBGlobal 6 | { 7 | public: 8 | CVBGlobal(); 9 | ~CVBGlobal(); 10 | 11 | // IUnknown interface 12 | HRESULT __stdcall QueryInterface( 13 | REFIID riid, 14 | void **ppObj); 15 | ULONG __stdcall AddRef(); 16 | ULONG __stdcall Release(); 17 | 18 | // IVBGlobal interface 19 | HRESULT _stdcall Load(IDispatch* object); 20 | HRESULT _stdcall Unload(IDispatch* object); 21 | HRESULT _stdcall get_App(IApp ** pdispRetVal); 22 | 23 | private: 24 | long m_nRefCount; // for managing the reference count 25 | }; 26 | 27 | -------------------------------------------------------------------------------- /openmsvbvm/vba_objVBGlobal.idl: -------------------------------------------------------------------------------- 1 | import "oaidl.idl"; 2 | import "ocidl.idl"; 3 | 4 | import "vba_objApp.idl"; 5 | 6 | [ 7 | uuid(fcfb3d22-a0fa-1068-a738-08002b3371b5), /* Original */ 8 | //uuid(40A859D6-F54A-4651-B6F0-A12A346EEC17), /* New */ 9 | helpstring("Open VBVM VB Global"), 10 | helpcontext(0x000df65a) 11 | ] 12 | interface IVBGlobal : IUnknown 13 | { 14 | [helpstring("Loads a form or control into memory."), helpcontext(0x000df65b)] 15 | HRESULT _stdcall Load([in] IDispatch* object); 16 | [helpstring("Unloads a form or control from memory."), helpcontext(0x000df65c)] 17 | HRESULT _stdcall Unload([in] IDispatch* object); 18 | [propget, helpstring("Contains general information about an application."), helpcontext(0x000df65d)] 19 | HRESULT _stdcall App([out, retval] IApp ** pdispRetVal); 20 | /*[propget, helpstring("Manipulates forms according to their placement on the screen and controls the mouse pointer."), helpcontext(0x000df65e)] 21 | HRESULT _stdcall Screen([out, retval] Screen#i** pdispRetVal); 22 | [propget, helpstring("Provides access to the system Clipboard."), helpcontext(0x000df65f)] 23 | HRESULT _stdcall Clipboard([out, retval] Clipboard#i** pdispRetVal); 24 | [propget, helpstring("Enables you to communicate with a system printer (initially the default printer)."), helpcontext(0x000df660)] 25 | HRESULT _stdcall Printer([out, retval] Printer#i** pdispRetVal); 26 | [propputref, helpstring("Enables you to communicate with a system printer (initially the default printer)."), helpcontext(0x000df660)] 27 | HRESULT _stdcall Printer([in] Printer#i* pdispRetVal); 28 | [propget, helpstring("All loaded forms in an application."), helpcontext(0x000df661)] 29 | HRESULT _stdcall Forms([out, retval] IDispatch** pdispRetVal); 30 | [propget, helpstring("Enables you to gather information about all available printers on the system."), helpcontext(0x000df662)] 31 | HRESULT _stdcall Printers([out, retval] IDispatch** pdispRetVal); 32 | [restricted, hidden, helpstring("Loads a string from a resource (.RES) file and returns it as a property of a control."), helpcontext(0x000df663)] 33 | HRESULT _stdcall LoadResStringOld( 34 | [in] short id, 35 | [out, retval] BSTR* pbstrRetVal 36 | ); 37 | [helpstring("Loads a bitmap, icon, or cursor from a resource (.RES) file and returns it to the appropriate control."), helpcontext(0x000df664)] 38 | HRESULT _stdcall LoadResPicture( 39 | [in] VARIANT id, 40 | [in] short restype, 41 | [out, retval] IPictureDisp#i** retval 42 | ); 43 | [helpstring("Loads data of several possible types from a resource file (.RES) and returns a Byte array."), helpcontext(0x000df665)] 44 | HRESULT _stdcall LoadResData( 45 | [in] VARIANT id, 46 | [in] VARIANT type, 47 | [out, retval] VARIANT* pbstrRetVal 48 | ); 49 | [restricted, hidden, helpstring("Loads a graphic into a Form, PictureBox, or Image control."), helpcontext(0x000df666)] 50 | HRESULT _stdcall LoadPictureOld( 51 | [in, optional] VARIANT FileName, 52 | [out, retval] IPictureDisp#i** retval 53 | ); 54 | [helpstring("Saves a graphic from a Form, PictureBox, or Image control to a file."), helpcontext(0x000df667)] 55 | HRESULT _stdcall SavePicture( 56 | [in] IPictureDisp#i* Picture, 57 | [in] BSTR FileName 58 | ); 59 | [helpstring("Loads a graphic into a Form, PictureBox, or Image control."), helpcontext(0x000df666)] 60 | HRESULT _stdcall LoadPicture( 61 | [in, optional] VARIANT FileName, 62 | [in, optional] VARIANT Size, 63 | [in, optional] VARIANT ColorDepth, 64 | [in, optional] VARIANT X, 65 | [in, optional] VARIANT Y, 66 | [out, retval] IPictureDisp#i** retval 67 | ); 68 | [helpstring("Loads a string from a resource (.RES) file and returns it as a property of a control."), helpcontext(0x000df663)] 69 | HRESULT _stdcall LoadResString( 70 | [in] long id, 71 | [out, retval] BSTR* pbstrRetVal 72 | ); 73 | [propget, helpstring("Manipulates a collection of control licenses for use with Controls.Add."), helpcontext(0x000df95e)] 74 | HRESULT _stdcall Licenses([out, retval] Licenses#i** ppRetVal);*/ 75 | 76 | }; 77 | -------------------------------------------------------------------------------- /openmsvbvm/vba_objVBGlobal_h.h: -------------------------------------------------------------------------------- 1 | 2 | 3 | /* this ALWAYS GENERATED file contains the definitions for the interfaces */ 4 | 5 | 6 | /* File created by MIDL compiler version 8.01.0622 */ 7 | /* at Tue Jan 19 00:14:07 2038 8 | */ 9 | /* Compiler settings for vba_objVBGlobal.idl: 10 | Oicf, W1, Zp8, env=Win32 (32b run), target_arch=X86 8.01.0622 11 | protocol : dce , ms_ext, c_ext, robust 12 | error checks: allocation ref bounds_check enum stub_data 13 | VC __declspec() decoration level: 14 | __declspec(uuid()), __declspec(selectany), __declspec(novtable) 15 | DECLSPEC_UUID(), MIDL_INTERFACE() 16 | */ 17 | /* @@MIDL_FILE_HEADING( ) */ 18 | 19 | 20 | 21 | /* verify that the version is high enough to compile this file*/ 22 | #ifndef __REQUIRED_RPCNDR_H_VERSION__ 23 | #define __REQUIRED_RPCNDR_H_VERSION__ 500 24 | #endif 25 | 26 | #include "rpc.h" 27 | #include "rpcndr.h" 28 | 29 | #ifndef __RPCNDR_H_VERSION__ 30 | #error this stub requires an updated version of 31 | #endif /* __RPCNDR_H_VERSION__ */ 32 | 33 | #ifndef COM_NO_WINDOWS_H 34 | #include "windows.h" 35 | #include "ole2.h" 36 | #endif /*COM_NO_WINDOWS_H*/ 37 | 38 | #ifndef __vba_objVBGlobal_h_h__ 39 | #define __vba_objVBGlobal_h_h__ 40 | 41 | #if defined(_MSC_VER) && (_MSC_VER >= 1020) 42 | #pragma once 43 | #endif 44 | 45 | /* Forward Declarations */ 46 | 47 | #ifndef __IVBGlobal_FWD_DEFINED__ 48 | #define __IVBGlobal_FWD_DEFINED__ 49 | typedef interface IVBGlobal IVBGlobal; 50 | 51 | #endif /* __IVBGlobal_FWD_DEFINED__ */ 52 | 53 | 54 | /* header files for imported files */ 55 | #include "oaidl.h" 56 | #include "ocidl.h" 57 | #include "vba_objApp.h" 58 | 59 | #ifdef __cplusplus 60 | extern "C"{ 61 | #endif 62 | 63 | 64 | #ifndef __IVBGlobal_INTERFACE_DEFINED__ 65 | #define __IVBGlobal_INTERFACE_DEFINED__ 66 | 67 | /* interface IVBGlobal */ 68 | /* [object][helpcontext][helpstring][uuid] */ 69 | 70 | 71 | EXTERN_C const IID IID_IVBGlobal; 72 | 73 | #if defined(__cplusplus) && !defined(CINTERFACE) 74 | 75 | MIDL_INTERFACE("fcfb3d22-a0fa-1068-a738-08002b3371b5") 76 | IVBGlobal : public IUnknown 77 | { 78 | public: 79 | virtual /* [helpcontext][helpstring] */ HRESULT __stdcall Load( 80 | /* [in] */ IDispatch *object) = 0; 81 | 82 | virtual /* [helpcontext][helpstring] */ HRESULT __stdcall Unload( 83 | /* [in] */ IDispatch *object) = 0; 84 | 85 | virtual /* [helpcontext][helpstring][propget] */ HRESULT __stdcall get_App( 86 | /* [retval][out] */ IApp **pdispRetVal) = 0; 87 | 88 | }; 89 | 90 | 91 | #else /* C style interface */ 92 | 93 | typedef struct IVBGlobalVtbl 94 | { 95 | BEGIN_INTERFACE 96 | 97 | HRESULT ( STDMETHODCALLTYPE *QueryInterface )( 98 | IVBGlobal * This, 99 | /* [in] */ REFIID riid, 100 | /* [annotation][iid_is][out] */ 101 | _COM_Outptr_ void **ppvObject); 102 | 103 | ULONG ( STDMETHODCALLTYPE *AddRef )( 104 | IVBGlobal * This); 105 | 106 | ULONG ( STDMETHODCALLTYPE *Release )( 107 | IVBGlobal * This); 108 | 109 | /* [helpcontext][helpstring] */ HRESULT ( __stdcall *Load )( 110 | IVBGlobal * This, 111 | /* [in] */ IDispatch *object); 112 | 113 | /* [helpcontext][helpstring] */ HRESULT ( __stdcall *Unload )( 114 | IVBGlobal * This, 115 | /* [in] */ IDispatch *object); 116 | 117 | /* [helpcontext][helpstring][propget] */ HRESULT ( __stdcall *get_App )( 118 | IVBGlobal * This, 119 | /* [retval][out] */ IApp **pdispRetVal); 120 | 121 | END_INTERFACE 122 | } IVBGlobalVtbl; 123 | 124 | interface IVBGlobal 125 | { 126 | CONST_VTBL struct IVBGlobalVtbl *lpVtbl; 127 | }; 128 | 129 | 130 | 131 | #ifdef COBJMACROS 132 | 133 | 134 | #define IVBGlobal_QueryInterface(This,riid,ppvObject) \ 135 | ( (This)->lpVtbl -> QueryInterface(This,riid,ppvObject) ) 136 | 137 | #define IVBGlobal_AddRef(This) \ 138 | ( (This)->lpVtbl -> AddRef(This) ) 139 | 140 | #define IVBGlobal_Release(This) \ 141 | ( (This)->lpVtbl -> Release(This) ) 142 | 143 | 144 | #define IVBGlobal_Load(This,object) \ 145 | ( (This)->lpVtbl -> Load(This,object) ) 146 | 147 | #define IVBGlobal_Unload(This,object) \ 148 | ( (This)->lpVtbl -> Unload(This,object) ) 149 | 150 | #define IVBGlobal_get_App(This,pdispRetVal) \ 151 | ( (This)->lpVtbl -> get_App(This,pdispRetVal) ) 152 | 153 | #endif /* COBJMACROS */ 154 | 155 | 156 | #endif /* C style interface */ 157 | 158 | 159 | 160 | 161 | #endif /* __IVBGlobal_INTERFACE_DEFINED__ */ 162 | 163 | 164 | /* Additional Prototypes for ALL interfaces */ 165 | 166 | /* end of Additional Prototypes */ 167 | 168 | #ifdef __cplusplus 169 | } 170 | #endif 171 | 172 | #endif 173 | 174 | 175 | -------------------------------------------------------------------------------- /openmsvbvm/vba_ole_bridge_macros.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | 4 | 5 | #define DECLARE_VBA_CONVERSION_BRIDGE_TO_OLE_CONVERSION(outType, inType, exportedName, oleAPI, flg, debugInParams) \ 6 | EXPORT outType __stdcall exportedName( \ 7 | inType unkVal \ 8 | ) \ 9 | { \ 10 | HRESULT result; \ 11 | outType unkLocalCopy; \ 12 | \ 13 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); \ 14 | \ 15 | DEBUG_WIDE(debugInParams, unkVal); \ 16 | \ 17 | result = oleAPI( \ 18 | unkVal, \ 19 | getUserLocale(), \ 20 | flg, \ 21 | &unkLocalCopy \ 22 | ); \ 23 | \ 24 | if (result < 0) \ 25 | { \ 26 | DEBUG_WIDE("result = %.8x", result); \ 27 | vbaRaiseException(vbaErrorFromHRESULT(result)); \ 28 | return NULL; \ 29 | } \ 30 | \ 31 | return unkLocalCopy; \ 32 | } 33 | 34 | #define DECLARE_VBA_VARIANT_MANIPULATION_BRIDGE_TO_OLE_MANIPULATION(exportedName, oleAPI) \ 35 | EXPORT LPVARIANT __stdcall exportedName( \ 36 | LPVARIANT pvarResult, \ 37 | LPVARIANT pvarRight, \ 38 | LPVARIANT pvarLeft \ 39 | ) \ 40 | { \ 41 | HRESULT result; \ 42 | \ 43 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); \ 44 | \ 45 | DEBUG_WIDE( \ 46 | "pvarResult %.8x, pvarRight %.8x, pvarLeft %.8x", \ 47 | (unsigned int)pvarResult, \ 48 | (unsigned int)pvarRight, \ 49 | (unsigned int)pvarLeft \ 50 | ); \ 51 | \ 52 | result = oleAPI( \ 53 | pvarLeft, \ 54 | pvarRight, \ 55 | pvarResult \ 56 | ); \ 57 | \ 58 | if (result < 0) \ 59 | { \ 60 | DEBUG_WIDE("result = %.8x", result); \ 61 | vbaRaiseException(vbaErrorFromHRESULT(result)); \ 62 | return NULL; \ 63 | } \ 64 | \ 65 | return pvarResult; \ 66 | } -------------------------------------------------------------------------------- /openmsvbvm/vba_strComparation.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | 4 | /** 5 | * @brief Compares two BSTRs using OLE's VarBstrCmp . 6 | * @param compare_method Compare method (vbBinaryCompare, vbTextCompare, etc) 7 | * @param bstrRight First string. 8 | * @param bstrLeft Second string. 9 | * @returns Returns -1 if bstrLeft is less than bstrRight, 0 if they're equal, and 1 if bstrLeft is greater than bstrRight. 10 | */ 11 | EXPORT int __stdcall __vbaStrComp( 12 | int compare_method, 13 | BSTR bstrRight, 14 | BSTR bstrLeft 15 | ) 16 | { 17 | HRESULT result; 18 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 19 | 20 | if (bstrRight && bstrLeft) 21 | { 22 | DEBUG_WIDE( 23 | "compare_method, %.8x, bstrRight %.8x '%ls', bstrLeft %.8x '%ls'", 24 | (unsigned int)compare_method, 25 | (unsigned int)bstrRight, 26 | bstrRight, 27 | (unsigned int)bstrLeft, 28 | bstrLeft 29 | ); 30 | } 31 | else 32 | { 33 | DEBUG_WIDE( 34 | "compare_method, %.8x, bstrRight %.8x, bstrLeft %.8x", 35 | (unsigned int)compare_method, 36 | (unsigned int)bstrRight, 37 | (unsigned int)bstrLeft 38 | ); 39 | } 40 | 41 | if (compare_method == NORM_IGNORENONSPACE) 42 | { 43 | vbaRaiseException(VBA_EXCEPTION_INVALID_PROCEDURE_CALL); 44 | return 0; 45 | } 46 | 47 | result = VarBstrCmp( 48 | bstrLeft, 49 | bstrRight, 50 | 0x30001, 51 | compare_method 52 | ); 53 | 54 | if (result >= 0) 55 | { 56 | /* Convert the VARCMP_ values to -1, 0 and 1 (as VB expects) */ 57 | return result - 1; 58 | } 59 | 60 | vbaRaiseException(vbaErrorFromHRESULT(result)); 61 | 62 | return 0; 63 | } /* __vbaStrComp */ 64 | -------------------------------------------------------------------------------- /openmsvbvm/vba_strConversion.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | #include "vba_Locale.h" 4 | 5 | #include "vba_strManipulation.h" 6 | 7 | #include "vba_ole_bridge_macros.h" 8 | 9 | #define BUNCH_OF_BSTR_CONVERSIONS(declr) \ 10 | declr(BSTR, double, __vbaStrR8, VarBstrFromR8, 0, "in '%lf'") /* double -> BSTR */ \ 11 | declr(BSTR, float, __vbaStrR4, VarBstrFromR4, 0, "in '%f'") /* float -> BSTR */ \ 12 | declr(BSTR, LONG, __vbaStrI4, VarBstrFromI4, 0, "in '%d'") /* long -> BSTR */ \ 13 | declr(BSTR, SHORT, __vbaStrI2, VarBstrFromI2, 0, "in '%d'") /* SHORT -> BSTR */ \ 14 | declr(BSTR, BYTE, __vbaStrUI1, VarBstrFromI2, 0, "in '%d'") /* BYTE -> BSTR */ \ 15 | declr(BSTR, SHORT, __vbaStrBool, VarBstrFromBool, VAR_LOCALBOOL, "in '%d'") /* SHORT -> BSTR */ \ 16 | declr(BSTR, CY, __vbaStrCy, VarBstrFromCy , 0, "in '%ld'") /* CY -> BSTR */ \ 17 | declr(BSTR, DATE, __vbaStrDate, VarBstrFromDate , 0, "in '%ld'") /* DATE -> BSTR */ \ 18 | 19 | #pragma warning (disable : 4477) /* This warning is created by converting types in sprintf */ 20 | 21 | BUNCH_OF_BSTR_CONVERSIONS(DECLARE_VBA_CONVERSION_BRIDGE_TO_OLE_CONVERSION); 22 | 23 | /** 24 | * @brief Converts a BSTR to an ANSI string. 25 | * @param pbstrOut Pointer to a BSTR (weird, but assume it as a storage). 26 | * This function will set the pointer to the ANSI buffer there. 27 | * @param bstrSrc Source BSTR. 28 | * @return *pbstrOut always. 29 | */ 30 | EXPORT BSTR __stdcall __vbaStrToAnsi( 31 | BSTR * pbstrOut, 32 | BSTR bstrSrc 33 | ) 34 | { 35 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 36 | 37 | DEBUG_WIDE( 38 | "pbstrOut %.8x, pbstrOut %.8x", 39 | (unsigned int)pbstrOut, 40 | (unsigned int)bstrSrc 41 | ); 42 | 43 | if (!pbstrOut) 44 | { 45 | vbaRaiseException(VBA_EXCEPTION_INTERNAL_ERROR); 46 | return *pbstrOut; 47 | } 48 | 49 | int iWideStrSize = 0; 50 | 51 | if (bstrSrc) 52 | { 53 | iWideStrSize = strSafeGetLength(bstrSrc); 54 | } 55 | 56 | /* Get how many bytes we'll need to allocate */ 57 | int size_needed = WideCharToMultiByte( 58 | CP_ACP, 59 | 0, 60 | (LPCWCH)bstrSrc, 61 | iWideStrSize, 62 | NULL, 63 | 0, 64 | 0, 65 | 0 66 | ); 67 | 68 | DEBUG_WIDE( 69 | "size_needed = %.8x", 70 | size_needed 71 | ); 72 | 73 | /* This is really weird, but VB uses a BSTR as storage for an ANSI string */ 74 | *pbstrOut = SysAllocStringByteLen( 75 | 0, 76 | size_needed 77 | ); 78 | 79 | if (!*pbstrOut) 80 | { 81 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 82 | return *pbstrOut; 83 | } 84 | 85 | int iChars = WideCharToMultiByte( 86 | CP_ACP, 87 | 0, 88 | (LPCWCH)bstrSrc, 89 | iWideStrSize + 1, 90 | (LPSTR)*pbstrOut, 91 | size_needed + 1, 92 | 0, 93 | 0 94 | ); 95 | 96 | DEBUG_WIDE( 97 | "MultiByteToWideChar %.8x", 98 | iChars 99 | ); 100 | 101 | return *pbstrOut; 102 | } /* __vbaStrToAnsi */ -------------------------------------------------------------------------------- /openmsvbvm/vba_strManipulation.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | 4 | #include 5 | #include 6 | 7 | #include "vba_objManipulation.h" 8 | #include "vba_varManipulation.h" 9 | 10 | /** 11 | * @brief Gets the string length of a BSTR. 12 | * @param bstrIn Input string. 13 | * @returns Size of the string if the BSTR is valid, 0 otherwise. 14 | */ 15 | unsigned int __stdcall strSafeGetLength( 16 | BSTR bstrIn 17 | ) 18 | { 19 | if (bstrIn) 20 | { 21 | // The string length is stored in the previous 4 bytes 22 | // of the starting character of the BSTR. It's weird. 23 | uint32_t *puintSize = (uint32_t *)bstrIn - 1; 24 | 25 | // Check if we're going to create an exception if we read the size. 26 | if (IsBadReadPtr(puintSize, sizeof(uint32_t))) 27 | { 28 | return 0; 29 | } 30 | 31 | // Size is in bytes, not in wide-chars, so divide by two. 32 | return *puintSize / 2; 33 | } 34 | 35 | return 0; 36 | } /* strSafeGetLength */ 37 | 38 | /** 39 | * @brief Copies a BSTR and converts their characters to uppercase. 40 | * @param strIn String to convert. 41 | * @returns Converted BSTR, NULL on error (not exactly as VB, but safer). 42 | */ 43 | EXPORT BSTR __stdcall rtcReplace( 44 | BSTR bstrExpression, 45 | BSTR bstrFind, 46 | BSTR bstrReplace, 47 | int iStart, 48 | int iCount, 49 | int iCompareMethod 50 | ) 51 | { 52 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 53 | 54 | DEBUG_WIDE( 55 | "bstrExpression %.8x '%ls', bstrFind %.8x '%ls', bstrReplace %.8x '%ls', iStart %.8x, iCount %.8x, iCompareMethod %.8x", 56 | (unsigned int)bstrExpression, 57 | (wchar_t*)bstrExpression, 58 | (unsigned int)bstrFind, 59 | (wchar_t*)bstrFind, 60 | (unsigned int)bstrReplace, 61 | (wchar_t*)bstrReplace, 62 | iStart, 63 | iCount, 64 | iCompareMethod 65 | ); 66 | return bstrExpression; 67 | } /* rtcReplace */ 68 | 69 | /** 70 | * @brief Copies a BSTR and converts their characters to uppercase. 71 | * @param strIn BSTR String to convert. 72 | * @returns Converted BSTR, NULL on error (not exactly as VB, but safer). 73 | */ 74 | EXPORT BSTR __stdcall rtcUpperCaseBstr( 75 | BSTR strIn 76 | ) 77 | { 78 | UINT uStrSize = strSafeGetLength(strIn); 79 | BSTR bstrRet; 80 | 81 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 82 | 83 | DEBUG_WIDE( 84 | "strIn %.8x, size %.8x", 85 | (unsigned int)strIn, 86 | uStrSize 87 | ); 88 | 89 | bstrRet = SysAllocStringLen( 90 | strIn, 91 | uStrSize 92 | ); 93 | 94 | if (!bstrRet) 95 | { 96 | DEBUG_WIDE( 97 | "SysAllocStringLen failed, err = %.8x", 98 | GetLastError() 99 | ); 100 | 101 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 102 | return nullptr; 103 | } 104 | 105 | CharUpperBuffW(bstrRet, uStrSize + 1); 106 | 107 | DEBUG_WIDE("ret = '%ls'", bstrRet); 108 | 109 | return bstrRet; 110 | } /* rtcUpperCaseBstr */ 111 | 112 | /** 113 | * @brief Copies a BSTR and converts their characters to lowercase. 114 | * @param strIn String to convert. 115 | * @returns Converted BSTR, NULL on error (not exactly as VB, but safer). 116 | */ 117 | EXPORT BSTR __stdcall rtcLowerCaseBstr( 118 | BSTR strIn 119 | ) 120 | { 121 | UINT uStrSize = strSafeGetLength(strIn); 122 | BSTR bstrRet; 123 | 124 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 125 | 126 | DEBUG_WIDE( 127 | "strIn %.8x, size %.8x", 128 | (unsigned int)strIn, 129 | uStrSize); 130 | 131 | bstrRet = SysAllocStringLen( 132 | strIn, 133 | uStrSize 134 | ); 135 | 136 | if (!bstrRet) 137 | { 138 | DEBUG_WIDE( 139 | "SysAllocStringLen failed, err = %.8x", 140 | (unsigned int)GetLastError() 141 | ); 142 | 143 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 144 | return NULL; 145 | } 146 | 147 | CharLowerBuffW(bstrRet, uStrSize + 1); 148 | 149 | DEBUG_WIDE("ret = '%ls'", bstrRet); 150 | 151 | return bstrRet; 152 | } /* rtcLowerCaseBstr */ 153 | 154 | /** 155 | * @brief Concatenates two BSTRs. 156 | * @param bstrRight Right operand for the concatenation. 157 | * @param bstrLeft Left operand for the concatenation. 158 | * @returns Concatenated BSTR on success, NULL on error (not exactly as VB, but safer). 159 | */ 160 | EXPORT BSTR __stdcall __vbaStrCat( 161 | BSTR bstrLeft, 162 | BSTR bstrRight 163 | ) 164 | { 165 | HRESULT result; 166 | 167 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 168 | 169 | DEBUG_WIDE( 170 | "bstrRight %.8x, bstrLeft %.8x", 171 | (unsigned int)bstrRight, 172 | (unsigned int)bstrLeft 173 | ); 174 | 175 | if (bstrRight && bstrLeft) 176 | { 177 | DEBUG_WIDE( 178 | "bstrRight '%ls', bstrLeft '%ls'", 179 | (wchar_t*)bstrRight, 180 | (wchar_t*)bstrLeft 181 | ); 182 | } 183 | 184 | BSTR ret; 185 | 186 | result = VarBstrCat( 187 | bstrRight, 188 | bstrLeft, 189 | &ret 190 | ); 191 | 192 | if (result < 0) 193 | { 194 | DEBUG_WIDE("result %.8x", result); 195 | vbaRaiseException(vbaErrorFromHRESULT(result)); 196 | return NULL; 197 | } 198 | 199 | DEBUG_WIDE( 200 | "result %.8x, '%ls'", 201 | result, 202 | (wchar_t*)&ret 203 | ); 204 | 205 | return ret; 206 | } /* __vbaStrCat */ 207 | 208 | /** 209 | * @brief Moves one BSTR to the pointer of another (previously freed if needed) BSTR. 210 | * @param pbstrDest Where the source BSTR value will be copied to. Freed if not zero. 211 | * @param bstrSrc Source BSTR. 212 | * @returns Same value as pbstrSrc. 213 | */ 214 | EXPORT BSTR __fastcall __vbaStrMove( 215 | BSTR * pbstrDest, 216 | BSTR bstrSrc 217 | ) 218 | { 219 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 220 | 221 | DEBUG_WIDE( 222 | "pbstrDest %.8x, bstrSrc %.8x", 223 | (unsigned int)pbstrDest, 224 | (unsigned int)bstrSrc 225 | ); 226 | 227 | if (*pbstrDest) 228 | { 229 | DEBUG_WIDE( 230 | "pbstrDest contained '%ls'", 231 | (wchar_t*)pbstrDest 232 | ); 233 | 234 | SysFreeString(*pbstrDest); 235 | } 236 | 237 | if (bstrSrc) 238 | { 239 | DEBUG_WIDE( 240 | "bstrSrc '%ls'", 241 | (wchar_t*)bstrSrc 242 | ); 243 | } 244 | 245 | *pbstrDest = bstrSrc; 246 | return bstrSrc; 247 | } /* __vbaStrMove */ 248 | 249 | /** 250 | * @brief Converts a Variant (including VT_ERROR) to a BSTR using OLE's VariantChangeType. 251 | * @param pvargIn Value to convert. 252 | * @returns Result BSTR, NULL on error (not exactly as VB, but safer). 253 | */ 254 | EXPORT BSTR __stdcall __vbaStrErrVarCopy( 255 | VARIANTARG *pvargIn 256 | ) 257 | { 258 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 259 | 260 | VARIANT vargRet; 261 | VariantInit(&vargRet); 262 | 263 | if (!pvargIn) 264 | { 265 | return nullptr; 266 | } 267 | 268 | DEBUG_WIDE( 269 | "pvargIn %.8x, pvargIn->vt %.8x", 270 | (unsigned int)pvargIn, 271 | (unsigned int)pvargIn->vt 272 | ); 273 | 274 | HRESULT hr = VariantChangeType( 275 | &vargRet, 276 | pvargIn, 277 | VARIANT_ALPHABOOL | VARIANT_LOCALBOOL, 278 | VT_BSTR 279 | ); 280 | 281 | if (hr != S_OK) 282 | { 283 | return nullptr; 284 | } 285 | 286 | UINT uStrSize = strSafeGetLength(vargRet.bstrVal); 287 | 288 | DEBUG_WIDE( 289 | "vargRet.bstrVal %.8x, size %.8x", 290 | (unsigned int)vargRet.bstrVal, 291 | uStrSize 292 | ); 293 | 294 | BSTR bstrRet = SysAllocStringLen( 295 | vargRet.bstrVal, 296 | uStrSize 297 | ); 298 | 299 | __vbaFreeVar(&vargRet); 300 | 301 | if (!bstrRet) 302 | { 303 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 304 | } 305 | 306 | return bstrRet; 307 | } /* __vbaStrErrVarCopy */ 308 | 309 | /** 310 | * @brief Copies one BSTR to the pointer of another (previously freed if needed) BSTR. 311 | * @param strOut Where the source BSTR value will be copied to. Freed if not zero. 312 | * @param strIn Source BSTR. 313 | * @returns Contents of strOut. 314 | */ 315 | EXPORT BSTR __fastcall __vbaStrCopy( 316 | BSTR * strOut, 317 | BSTR strIn 318 | ) 319 | { 320 | BSTR bstrRet = nullptr; 321 | UINT uStrSize = 0; 322 | 323 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 324 | 325 | if (strIn) 326 | { 327 | uStrSize = strSafeGetLength(strIn); 328 | 329 | bstrRet = SysAllocStringLen( 330 | strIn, 331 | uStrSize 332 | ); 333 | 334 | if (!bstrRet) 335 | { 336 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 337 | } 338 | } 339 | 340 | DEBUG_WIDE( 341 | "strIn %.8x, strOut %.8x, *strOut %.8x, size %.8x, ret %.8x", 342 | (unsigned int)strIn, 343 | (unsigned int)strOut, 344 | (unsigned int)*strOut, 345 | uStrSize, 346 | (unsigned int)bstrRet 347 | ); 348 | 349 | if (*strOut) 350 | { 351 | SysFreeString(*strOut); 352 | } 353 | 354 | *strOut = bstrRet; 355 | 356 | DEBUG_WIDE( 357 | "ret = %.8x", 358 | (unsigned int)bstrRet 359 | ); 360 | 361 | return bstrRet; 362 | } /* __vbaStrCopy */ 363 | 364 | /** 365 | * @brief Converts a Variant (non including errors) to a BSTR. 366 | * @param pvargIn Value to convert. 367 | * @returns Result BSTR, NULL on error (not exactly as VB, but safer). 368 | */ 369 | EXPORT BSTR __stdcall __vbaStrVarCopy( 370 | VARIANTARG * pvargIn 371 | ) 372 | { 373 | return __vbaStrErrVarCopy(pvargIn); 374 | } /* __vbaStrVarCopy */ 375 | 376 | /** 377 | * @brief Frees a BSTR via its pointer, and nulls it. 378 | * @param pbstrIn Pointer to a BSTR to free and null it. 379 | */ 380 | EXPORT void __fastcall __vbaFreeStr( 381 | BSTR *pbstrIn 382 | ) 383 | { 384 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 385 | 386 | if (pbstrIn) 387 | { 388 | DEBUG_WIDE( 389 | "*pbstrIn %.8x", 390 | (unsigned int)*pbstrIn 391 | ); 392 | 393 | if (*pbstrIn) 394 | { 395 | DEBUG_WIDE( 396 | "*pbstrIn '%ls'", 397 | (wchar_t*)*pbstrIn 398 | ); 399 | 400 | SysFreeString(*pbstrIn); 401 | *pbstrIn = 0; 402 | } 403 | } 404 | } /* __vbaFreeStr */ 405 | 406 | /** 407 | * @brief Frees a list of BSTRs via their pointers, and nulls them. 408 | * @param argCount Count of elements. 409 | * @param ... Pointers to BSTRs to free and null them. 410 | */ 411 | EXPORT void __cdecl __vbaFreeStrList( 412 | unsigned int argCount, 413 | ... 414 | ) 415 | { 416 | BSTR *pbstrElement; 417 | 418 | va_list args; 419 | va_start(args, argCount); 420 | 421 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 422 | 423 | while (argCount--) 424 | { 425 | pbstrElement = va_arg(args, BSTR*); 426 | DEBUG_WIDE( 427 | "arg() %.8x, argsRemaining %.8x", 428 | (unsigned int)pbstrElement, 429 | argCount 430 | ); 431 | 432 | __vbaFreeStr(pbstrElement); 433 | } 434 | 435 | va_end(args); 436 | } /* __vbaFreeStrList */ -------------------------------------------------------------------------------- /openmsvbvm/vba_strManipulation.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include "vba_internal.h" 3 | 4 | /** 5 | * @brief Gets the BSTR string length. 6 | * @param bstrIn Input string. 7 | * @returns Size of the string if the BSTR is valid, 0 otherwise. 8 | */ 9 | unsigned int __stdcall strSafeGetLength( 10 | BSTR bstrIn 11 | ); 12 | 13 | /** 14 | * @brief Converts a Variant (including errors) to a BSTR. 15 | * @param pvargIn Value to convert. 16 | * @returns Result BSTR, NULL on error (not exactly as VB, but safer). 17 | */ 18 | EXPORT BSTR __stdcall __vbaStrErrVarCopy( 19 | VARIANTARG *pvargIn 20 | ); 21 | 22 | /** 23 | * @brief Converts a Variant (non including errors) to a BSTR. 24 | * @param pvargIn Value to convert. 25 | * @returns Result BSTR, NULL on error (not exactly as VB, but safer). 26 | */ 27 | EXPORT BSTR __stdcall __vbaStrVarCopy( 28 | VARIANTARG *pvargIn 29 | ); 30 | 31 | /** 32 | * @brief Frees a list of BSTRs via their pointers, and nulls them. 33 | * @param argCount Count of elements. 34 | * @param ... Pointers to BSTRs to free and null them. 35 | */ 36 | EXPORT void __cdecl __vbaFreeStrList( 37 | unsigned int argCount, 38 | ... 39 | ); 40 | 41 | /** 42 | * @brief Frees a BSTR via its pointer, and nulls it. 43 | * @param pbstrIn Pointer to a BSTR to free and null it. 44 | */ 45 | EXPORT void __fastcall __vbaFreeStr( 46 | BSTR *pbstrIn 47 | ); 48 | 49 | /** 50 | * @brief Moves one BSTR to the pointer of another (previously freed if needed) BSTR. 51 | * @param pbstrDest Where the source BSTR value will be copied to. Freed if not zero. 52 | * @param bstrSrc Source BSTR. 53 | * @returns Same value as pbstrSrc. 54 | */ 55 | EXPORT BSTR __fastcall __vbaStrMove( 56 | BSTR *pbstrDest, 57 | BSTR bstrSrc 58 | ); 59 | 60 | /** 61 | * @brief Concatenates two BSTRs. 62 | * @param bstrRight Right operand for the concatenation. 63 | * @param bstrLeft Left operand for the concatenation. 64 | * @returns Same value as bstrLeft on success, NULL on error (not exactly as VB, but safer). 65 | */ 66 | EXPORT BSTR __stdcall __vbaStrCat( 67 | BSTR bstrLeft, 68 | BSTR bstrRight 69 | ); 70 | 71 | /** 72 | * @brief Copies a BSTR and converts their characters to lowercase. 73 | * @param strIn String to convert. 74 | * @returns Converted BSTR, NULL on error (not exactly as VB, but safer). 75 | */ 76 | EXPORT BSTR __stdcall rtcLowerCaseBstr( 77 | OLECHAR *strIn 78 | ); 79 | 80 | /** 81 | * @brief Copies a BSTR and converts their characters to uppercase. 82 | * @param strIn String to convert. 83 | * @returns Converted BSTR, NULL on error (not exactly as VB, but safer). 84 | */ 85 | EXPORT BSTR __stdcall rtcUpperCaseBstr( 86 | BSTR strIn 87 | ); 88 | 89 | /** 90 | * @brief Copies a BSTR and converts their characters to uppercase. 91 | * @param strIn String to convert. 92 | * @returns Converted BSTR, NULL on error (not exactly as VB, but safer). 93 | */ 94 | EXPORT BSTR __stdcall rtcReplace( 95 | BSTR bstrExpression, 96 | BSTR bstrFind, 97 | BSTR bstrReplace, 98 | int iStart, 99 | int iCount, 100 | int iCompareMethod 101 | ); -------------------------------------------------------------------------------- /openmsvbvm/vba_structures.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | //#include 4 | 5 | 6 | 7 | 8 | struct TObjectInfo 9 | { 10 | __int16 iConst1; 11 | __int16 iObjectIndex; 12 | struct ObjectTable * aObjectTable; 13 | int lNull1; 14 | int aObjectDescriptor; 15 | int lConst2; 16 | int lNull2; 17 | struct TObject * aObjectHeader; 18 | int aObjectData; 19 | int lMethodCount; 20 | int aProcTable; 21 | __int16 iConstantsCount; 22 | __int16 iMaxConstants; 23 | int Flag5; 24 | __int16 Flag6; 25 | __int16 Flag7; 26 | int aConstantPool; 27 | }; 28 | 29 | 30 | struct MethodLinkNative 31 | { 32 | char jmpOpCode; 33 | int jmpOffset; 34 | }; 35 | 36 | struct TObjectInfoWithOptionals 37 | { 38 | TObjectInfo hdr; 39 | 40 | int fDesigner; 41 | CLSID *clsidObjectClass; 42 | CLSID *clsidObjectInterface; 43 | int aGuidObjectGUI; 44 | int lObjectDefaultIIDCount; 45 | int aObjectEventsIIDTable; 46 | int lObjectEventsIIDCount; 47 | int aObjectDefaultIIDTable; 48 | int lControlCount; 49 | int aControlArray; 50 | __int16 iEventCount; 51 | __int16 iPCodeCount; 52 | __int16 oInitializeEvent; 53 | __int16 oTerminateEvent; 54 | void * aEventLinkArray; 55 | int aBasicClassObject; 56 | int lNull3; 57 | int lFlag2; 58 | /* 59 | fDesigner As Long ' 0x00 (0d) If this value is 2 then this object is a designer 60 | aObjectCLSID As Long ' 0x04 61 | Null1 As Long ' 0x08 62 | aGuidObjectGUI As Long ' 0x0C 63 | lObjectDefaultIIDCount As Long ' 0x10 01 00 00 00 64 | aObjectEventsIIDTable As Long ' 0x14 65 | lObjectEventsIIDCount As Long ' 0x18 66 | aObjectDefaultIIDTable As Long ' 0x1C 67 | ControlCount As Long ' 0x20 68 | aControlArray As Long ' 0x24 69 | iEventCount As Integer ' 0x28 (40d) Number of Events 70 | iPCodeCount As Integer ' 0x2C 71 | oInitializeEvent As Integer ' 0x2C (44d) Offset to Initialize Event from aMethodLinkTable 72 | oTerminateEvent As Integer ' 0x2E (46d) Offset to Terminate Event from aMethodLinkTable 73 | aEventLinkArray As Long ' 0x30 Pointer to pointers of MethodLink 74 | aBasicClassObject As Long ' 0x34 Pointer to an in-memory 75 | Null3 As Long ' 0x38 76 | Flag2 As Long ' 0x3C usually null 77 | */ 78 | }; 79 | 80 | 81 | 82 | struct variableSizeInfo 83 | { 84 | unsigned __int16 iConst1; 85 | unsigned __int16 iSize; 86 | }; 87 | 88 | struct TObject 89 | { 90 | struct TObjectInfo * aObjectInfo; /* pointer to TObjectInfo */ 91 | int lConst1; 92 | struct variableSizeInfo * aPublicBytes; 93 | struct variableSizeInfo * aStaticBytes; 94 | int aModulePublic; 95 | int aModuleStatic; 96 | int aNTSObjectName; 97 | int lMethodCount; 98 | int aMethodNameTable; 99 | int oStaticVars; 100 | int lObjectType; 101 | int lNull2; 102 | }; 103 | 104 | struct ObjectTable 105 | { 106 | int lNull1; 107 | int aExecProj; 108 | int aProjectInfo2; 109 | int lConst1; 110 | int lNull2; 111 | int aProjectObject; 112 | int uuidObjectTable; 113 | int Flag2; 114 | int Flag3; 115 | int Flag4; 116 | __int16 fCompileType; 117 | __int16 iObjectsCount; 118 | __int16 iCompiledObjects; 119 | __int16 iObjectsInUse; 120 | int aObjectsArray; /* pointer to TObject */ 121 | int lNull3; 122 | int lNull4; 123 | int lNull5; 124 | int aNTSProjectName; 125 | int lLcID1; 126 | int lLcID2; 127 | int lNull6; 128 | int lTemplateVersion; 129 | }; 130 | 131 | struct ProjectInfo 132 | { 133 | int lTemplateVersion; 134 | int aObjectTable; /* pointer to ObjectTable */ 135 | int lNull1; 136 | int aStartOfCode; 137 | int aEndOfCode; 138 | int lDataBufferSize; 139 | int aThreadSpace; 140 | int aVBAExceptionhandler; 141 | int aNativeCode; 142 | char uIncludeID[527]; 143 | int aExternalTable; 144 | int lExternalCount; 145 | }; 146 | 147 | struct VBHeader 148 | { 149 | char szVbMagic[4]; 150 | __int16 wRuntimeBuild; 151 | char szLangDll[14]; 152 | char szSecLangDll[14]; 153 | __int16 wRuntimeRevision; 154 | int dwLCID; 155 | int dwSecLCID; 156 | int lpSubMain; 157 | int lpProjectData; /* pointer to ProjectInfo */ 158 | int fMdlIntCtls; 159 | int fMdlIntCtls2; 160 | int dwThreadFlags; 161 | int dwThreadCount; 162 | __int16 wFormCount; 163 | __int16 wExternalCount; 164 | int dwThunkCount; 165 | int lpGuiTable; 166 | int lpExternalTable; 167 | int lpComRegisterData; 168 | int bSZProjectDescription; 169 | int bSZProjectExeName; 170 | int bSZProjectHelpFile; 171 | int bSZProjectName; 172 | }; 173 | 174 | struct __declspec(align(4)) struct_v5 175 | { 176 | int field_0; 177 | HMODULE hInstance; 178 | int field_8; 179 | }; 180 | 181 | 182 | struct serDllTemplate 183 | { 184 | char *lpLibraryNameA; 185 | char *lpProcAddressA; 186 | char *lpProcAddressW; 187 | struct struct_v5 *ptrStruct_v5; 188 | }; 189 | 190 | -------------------------------------------------------------------------------- /openmsvbvm/vba_varManipulation.cpp: -------------------------------------------------------------------------------- 1 | #include "vba_internal.h" 2 | #include "vba_exception.h" 3 | #include "vba_Locale.h" 4 | 5 | #include "vba_varManipulation.h" 6 | #include "vba_strManipulation.h" 7 | #include "vba_objManipulation.h" 8 | 9 | #include "vba_ole_bridge_macros.h" 10 | 11 | #define BUNCH_OF_VAR_MANIPULATIONS(declr) \ 12 | declr(__vbaVarAdd, VarAdd) \ 13 | declr(__vbaVarAnd, VarAnd) \ 14 | declr(__vbaVarCat, VarCat) \ 15 | declr(__vbaVarDiv, VarDiv) \ 16 | declr(__vbaVarEqv, VarEqv) \ 17 | declr(__vbaVarIdiv, VarIdiv) \ 18 | declr(__vbaVarImp, VarImp) \ 19 | declr(__vbaVarMod, VarMod) \ 20 | declr(__vbaVarMul, VarMul) \ 21 | declr(__vbaVarOr, VarOr) \ 22 | declr(__vbaVarPow, VarPow) \ 23 | declr(__vbaVarSub, VarSub) \ 24 | declr(__vbaVarXor, VarXor) \ 25 | 26 | #pragma warning (disable : 4477) /* This warning is created by converting types in sprintf */ 27 | 28 | BUNCH_OF_VAR_MANIPULATIONS(DECLARE_VBA_VARIANT_MANIPULATION_BRIDGE_TO_OLE_MANIPULATION); 29 | 30 | 31 | /** 32 | * @brief Gets the value of a VT_BYREF Variant to another Variant. 33 | * @param pvargDest The destination variant. 34 | * @param pvargSource The source variant. 35 | * @returns pvargDest always. 36 | */ 37 | VARIANTARG * __stdcall VarDerefByref( 38 | VARIANTARG *pvargDest, 39 | VARIANTARG *pvargSrc 40 | ) 41 | { 42 | // Remove (mask) VT_BYREF 43 | pvargDest->vt = pvargSrc->vt & ~VT_BYREF; 44 | 45 | switch (pvargDest->vt) 46 | { 47 | case VT_I2: 48 | case VT_BOOL: 49 | { 50 | pvargDest->iVal = *pvargSrc->piVal; 51 | break; 52 | } /* VT_I2, VT_BOOL */ 53 | 54 | case VT_I4: 55 | case VT_R4: 56 | case VT_BSTR: 57 | case VT_ERROR: 58 | { 59 | pvargDest->lVal = *pvargSrc->plVal; 60 | break; 61 | } /* VT_I4, VT_R4, VT_BSTR, VT_ERROR */ 62 | 63 | case VT_R8: 64 | case VT_CY: 65 | case VT_DATE: 66 | { 67 | pvargDest->cyVal = *pvargSrc->pcyVal; 68 | break; 69 | } /* VT_R8, VT_CY, VT_DATE */ 70 | 71 | case VT_VARIANT: 72 | case VT_DECIMAL: 73 | { 74 | pvargDest->decVal = *pvargSrc->pdecVal; 75 | break; 76 | } /* VT_VARIANT, VT_DECIMAL */ 77 | 78 | case VT_UI1: 79 | { 80 | pvargDest->bVal = *pvargSrc->pbVal; 81 | break; 82 | } /* VT_UI1 */ 83 | 84 | case VT_RECORD: 85 | { 86 | pvargDest->pvRecord = pvargSrc->pvRecord; 87 | pvargDest->pRecInfo = pvargSrc->pRecInfo; 88 | break; 89 | } /* VT_RECORD */ 90 | 91 | case VT_DISPATCH: 92 | case VT_UNKNOWN: 93 | { 94 | pvargDest->plVal = (LONG*)*pvargSrc->plVal; 95 | break; 96 | } /* VT_DISPATCH, VT_UNKNOWN */ 97 | 98 | default: 99 | { 100 | if (!(pvargSrc->vt & VT_ARRAY)) 101 | { 102 | vbaRaiseException(VBA_EXCEPTION_VARIABLE_USES_A_TYPE_NOT_SUPPORTED_IN_VISUAL_BASIC); 103 | } 104 | 105 | pvargDest->lVal = *pvargSrc->plVal; 106 | } /* default */ 107 | } /* switch (pvargSrc->vt) */ 108 | 109 | return pvargDest; 110 | } /* VarDerefByref */ 111 | 112 | /** 113 | * @brief Returns a BSTR in a Variant with the hexadecimal representation of a Variant argument. 114 | * @param pvargOut Output variant variable (will be set to VT_BSTR). 115 | * @param pvargIn Input variant to convert. 116 | */ 117 | EXPORT void __stdcall rtcHexVarFromVar( 118 | VARIANTARG *pvargOut, 119 | VARIANTARG *pvargIn 120 | ) 121 | { 122 | VARIANTARG vargLocalDeRef; 123 | 124 | /* 125 | TODO: List of types: 126 | VT_CY = 6, 127 | VT_DATE = 7, 128 | VT_BSTR = 8, 129 | VT_DISPATCH = 9, 130 | VT_ERROR = 10, 131 | VT_BOOL = 11, 132 | VT_VARIANT = 12, 133 | VT_UNKNOWN = 13, 134 | VT_DECIMAL = 14, 135 | VT_INT = 22, 136 | VT_UINT = 23, 137 | */ 138 | 139 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 140 | 141 | wchar_t lpszwBuffer[20]; 142 | 143 | // De-Ref if necessary 144 | if (pvargIn->vt & VT_BYREF) 145 | { 146 | VarDerefByref(&vargLocalDeRef, pvargIn); 147 | pvargIn = &vargLocalDeRef; 148 | DEBUG_WIDE( 149 | "pvargIn->vt & VT_BYREF => deref" 150 | ); 151 | } 152 | 153 | // For each size of variant, format a different string 154 | switch (pvargIn->vt) 155 | { 156 | case VT_I1: 157 | case VT_UI1: 158 | { 159 | swprintf(lpszwBuffer, 19, L"%.2X", pvargIn->iVal); 160 | 161 | DEBUG_WIDE( 162 | " 1 byte input '%ls'", 163 | lpszwBuffer 164 | ); 165 | 166 | break; 167 | } /* VT_I1, VT_UI1 */ 168 | 169 | case VT_I2: 170 | case VT_UI2: 171 | { 172 | swprintf(lpszwBuffer, 19, L"%.4X", pvargIn->iVal); 173 | 174 | DEBUG_WIDE( 175 | " 2 bytes input '%ls'", 176 | lpszwBuffer 177 | ); 178 | 179 | break; 180 | } /* VT_I2, VT_UI2 */ 181 | 182 | case VT_I4: 183 | case VT_R4: 184 | case VT_UI4: 185 | { 186 | swprintf(lpszwBuffer, 19, L"%.8X", pvargIn->lVal); 187 | 188 | DEBUG_WIDE( 189 | " 4 bytes input '%ls'", 190 | lpszwBuffer 191 | ); 192 | 193 | break; 194 | } /* VT_I4, VT_R4, VT_UI4 */ 195 | 196 | case VT_R8: 197 | case VT_I8: 198 | case VT_UI8: 199 | { 200 | swprintf(lpszwBuffer, 19, L"%.16X", pvargIn->ulVal); 201 | 202 | DEBUG_WIDE( 203 | " 8 bytes input '%ls'", 204 | lpszwBuffer 205 | ); 206 | 207 | break; 208 | } /* VT_I8, VT_R8, VT_UI8 */ 209 | 210 | default: 211 | { 212 | DEBUG_WIDE( 213 | "vt type not handled %.8x", 214 | (unsigned int)pvargIn->vt 215 | ); 216 | 217 | swprintf(lpszwBuffer, 19, L"00??"); 218 | } /* default */ 219 | } /* switch (pvargIn->vt) */ 220 | 221 | pvargOut->vt = VT_BSTR; 222 | pvargOut->bstrVal = SysAllocString(lpszwBuffer); 223 | 224 | if (!pvargOut->bstrVal) 225 | { 226 | vbaRaiseException(VBA_EXCEPTION_OUT_OF_STRING_SPACE); 227 | } 228 | } /* rtcHexVarFromVar */ 229 | 230 | /** 231 | * @brief Returns a BSTR in a Variant with the hexadecimal representation of a Variant argument. 232 | * @param pvargOut Output variant variable (will be set to VT_BSTR). 233 | * @param pvargIn Input variant to convert. 234 | * @returns pvargOut always. 235 | */ 236 | EXPORT BSTR __stdcall rtcHexBstrFromVar( 237 | VARIANTARG *pvargIn 238 | ) 239 | { 240 | VARIANTARG v; 241 | rtcHexVarFromVar(&v, pvargIn); 242 | return v.bstrVal; 243 | } /* rtcHexBstrFromVar */ 244 | 245 | /** 246 | * @brief Frees the destination variant and makes a copy of the source variant. 247 | * @param pvargDest The destination variant. 248 | * @param pvargSource The source variant. 249 | * @returns pvargDest on success, 0 on error. 250 | */ 251 | EXPORT VARIANTARG * __fastcall __vbaVarCopy( 252 | VARIANTARG *pvargDest, 253 | VARIANTARG *pvargSource 254 | ) 255 | { 256 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 257 | 258 | HRESULT result = VariantCopy(pvargDest, pvargSource); 259 | 260 | DEBUG_WIDE( 261 | "pvargDest %.8x, pvargSource %.8x, VariantCopy = %.8x", 262 | (unsigned int)pvargDest, 263 | (unsigned int)pvargSource, 264 | (unsigned int)result 265 | ); 266 | 267 | if (result != S_OK) 268 | { 269 | vbaRaiseException(vbaErrorFromHRESULT(result)); 270 | return nullptr; 271 | } 272 | 273 | return pvargDest; 274 | } /* __vbaVarCopy */ 275 | 276 | /** 277 | * @brief Duplicates the contents of a Variant variable to another Variant. 278 | * @param pvargDest The destination variant. 279 | * @param pvargSource The source variant. 280 | * @returns pvargDest always. 281 | * @remark It will try to de-ref the value of VT_BYREF variants. It will call AddRef() 282 | * if it's a VT_DISPATCH or VT_UNKNOWN. 283 | */ 284 | EXPORT VARIANTARG * __fastcall __vbaVarDup( 285 | VARIANTARG *pvargDest, 286 | VARIANTARG *pvargSrc 287 | ) 288 | { 289 | VARIANTARG vargLocalDeRef; 290 | 291 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 292 | 293 | if (pvargSrc->vt & VT_BYREF) 294 | { 295 | DEBUG_WIDE( 296 | "pvargDest %.8x, pvargSrc %.8x, VT_BYREF set, so pvargSrc is now %.8x, pvargSrc->vt %.8x", 297 | (unsigned int)pvargDest, 298 | (unsigned int)pvargSrc, 299 | (unsigned int)&vargLocalDeRef, 300 | (unsigned int)pvargSrc->vt 301 | ); 302 | 303 | VarDerefByref(&vargLocalDeRef, pvargSrc); 304 | pvargSrc = &vargLocalDeRef; 305 | } 306 | else 307 | { 308 | DEBUG_WIDE( 309 | "pvargDest %.8x, pvargSrc %.8x, pvargSrc->vt %.8x", 310 | (unsigned int)pvargDest, 311 | (unsigned int)pvargSrc, 312 | (unsigned int)pvargSrc->vt 313 | ); 314 | } 315 | 316 | switch (pvargSrc->vt) 317 | { 318 | case VT_DISPATCH: 319 | case VT_UNKNOWN: 320 | { 321 | if (pvargSrc->pdispVal) 322 | { 323 | pvargSrc->pdispVal->AddRef(); 324 | } 325 | // Fall-thru 326 | } /* VT_DISPATCH, VT_UNKNOWN */ 327 | 328 | case VT_EMPTY: 329 | case VT_NULL: 330 | case VT_I2: 331 | case VT_I4: 332 | case VT_R4: 333 | case VT_R8: 334 | case VT_CY: 335 | case VT_DATE: 336 | case VT_ERROR: 337 | case VT_BOOL: 338 | case VT_DECIMAL: 339 | case VT_UI1: 340 | case VT_I1: 341 | { 342 | memcpy( 343 | pvargDest, 344 | pvargSrc, 345 | sizeof(VARIANTARG) 346 | ); 347 | break; 348 | } 349 | 350 | default: 351 | { 352 | __vbaVarCopy(pvargDest, pvargSrc); 353 | break; 354 | } /* default */ 355 | } /* switch (pvargSrc->vt) */ 356 | 357 | return pvargDest; 358 | } /* __vbaVarDup */ 359 | 360 | 361 | EXPORT VARIANTARG * __fastcall __vbaVarMove ( 362 | VARIANTARG *pvargDest, 363 | VARIANTARG *pvargSrc 364 | ) 365 | { 366 | DEBUG_DECLARE_ASCII_BUFFER_IF_NEEDED(); 367 | 368 | /* Free the destination VARIANTARG */ 369 | __vbaFreeVar(pvargDest); 370 | 371 | if (pvargSrc->vt == VT_DISPATCH) 372 | { 373 | HRESULT hr = objIDispatchGetDefaultValue(pvargSrc->pdispVal, pvargDest); 374 | if (hr == S_OK) 375 | { 376 | __vbaFreeVar(pvargSrc); 377 | } 378 | else 379 | { 380 | vbaRaiseException(VBA_EXCEPTION_INTERNAL_ERROR); 381 | } 382 | } 383 | else 384 | { 385 | __vbaVarDup(pvargDest, pvargSrc); 386 | } 387 | 388 | return pvargDest; 389 | } /* __vbaVarMove */ 390 | 391 | /** 392 | * @brief Frees a variant variable (including an array) 393 | * @param pvargVariant Pointer to a VARIANTARG that will be freed. 394 | * @returns none. 395 | */ 396 | EXPORT void __fastcall __vbaFreeVar( 397 | VARIANTARG *pvargVariant 398 | ) 399 | { 400 | DEBUG_DECLARE_ASCII_BUFFER_IF_NEEDED(); 401 | 402 | if (!pvargVariant) 403 | { 404 | DEBUG_ASCII( 405 | "pvargVariant %.8x -- NULL", 406 | pvargVariant 407 | ); 408 | return; 409 | } 410 | 411 | DEBUG_ASCII( 412 | "pvargVariant %.8x, pvargVariant->vt %.8x", 413 | pvargVariant, 414 | pvargVariant->vt 415 | ); 416 | 417 | if (!(pvargVariant->vt & VT_BYREF)) 418 | { 419 | switch (pvargVariant->vt & VT_TYPEMASK) 420 | { 421 | case VT_BSTR: 422 | { 423 | if (pvargVariant->lVal) 424 | { 425 | SysFreeString(pvargVariant->bstrVal); 426 | } 427 | break; 428 | } /* VT_BSTR */ 429 | 430 | case VT_DISPATCH: 431 | case VT_UNKNOWN: 432 | { 433 | if (pvargVariant->pdispVal) 434 | { 435 | pvargVariant->pdispVal->Release(); 436 | } 437 | break; 438 | } /* VT_DISPATCH, VT_UNKNOWN */ 439 | 440 | default: 441 | { 442 | /* Do we have an array? */ 443 | if (!(pvargVariant->vt & VT_ARRAY)) 444 | { 445 | /** 446 | * Nope, so fall back to the VariantClear 447 | * (this is stated in the MSDN if we don't know what to do with it) 448 | */ 449 | VariantClear(pvargVariant); 450 | } 451 | else 452 | { 453 | /* Handle the case for an array */ 454 | if (pvargVariant->pvarVal) 455 | { 456 | if (pvargVariant->pvarVal->lVal) 457 | { 458 | // TODO: Check this condition 459 | DEBUG_ASCII( 460 | "pvargVariant->vt VT ???, but pvargVariant->pvarVal (%.8x) is not null, and pvarVal->lVal (%.8x) isn't either", 461 | pvargVariant->pvarVal, 462 | pvargVariant->pvarVal->lVal 463 | ); 464 | 465 | vbaRaiseException(VBA_EXCEPTION_ARRAY_FIXED_OR_TEMPORARILY_LOCKED); 466 | } 467 | } 468 | 469 | if (pvargVariant->parray) 470 | { 471 | pvargVariant->parray->fFeatures &= 0xFFEFu; 472 | SafeArrayDestroy(pvargVariant->parray); 473 | } 474 | } 475 | } /* default */ 476 | } /* switch (pvargVariant->vt & 0x7F) */ 477 | } 478 | else 479 | { 480 | DEBUG_ASCII("pvargVariant->vt & VT_BYREF => calling VariantClear"); 481 | VariantClear(pvargVariant); 482 | } 483 | 484 | pvargVariant->vt = VT_EMPTY; 485 | } /* __vbaFreeVar */ 486 | 487 | /** 488 | * @brief Frees an array of variant variables (including a arrays) 489 | * @param dwCount Count of elements. 490 | * @param pvargVariant Pointer to the first VARIANTARG element that will be freed. 491 | * @returns none. 492 | */ 493 | EXPORT void __cdecl __vbaFreeVarList( 494 | unsigned int argCount, 495 | ... 496 | ) 497 | { 498 | VARIANTARG *pvargVariant; 499 | 500 | va_list args; 501 | va_start(args, argCount); 502 | 503 | DEBUG_DECLARE_WIDE_BUFFER_IF_NEEDED(); 504 | 505 | while (argCount--) 506 | { 507 | pvargVariant = va_arg(args, VARIANTARG*); 508 | DEBUG_WIDE( 509 | "arg() %.8x, argsRemaining %.8x", 510 | (unsigned int)pvargVariant, 511 | argCount 512 | ); 513 | 514 | __vbaFreeVar(pvargVariant); 515 | } 516 | 517 | va_end(args); 518 | } /* __vbaFreeVarList */ -------------------------------------------------------------------------------- /openmsvbvm/vba_varManipulation.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include "vba_internal.h" 3 | 4 | EXPORT void __cdecl __vbaFreeVarList( 5 | unsigned int argCount, 6 | ... 7 | ); 8 | 9 | EXPORT void __fastcall __vbaFreeVar( 10 | VARIANTARG *pvargVariant 11 | ); 12 | 13 | EXPORT VARIANTARG * __fastcall __vbaVarDup( 14 | VARIANTARG *pvarg, 15 | VARIANTARG *pvargSrc 16 | ); 17 | 18 | EXPORT VARIANTARG * __fastcall __vbaVarCopy(VARIANTARG *pvarDest, VARIANTARG *pvargSource); 19 | 20 | VARIANTARG * __stdcall VarDerefByref( 21 | VARIANTARG *pvargDest, 22 | VARIANTARG *pvargSrc 23 | ); --------------------------------------------------------------------------------