diff --git a/BUGS-TO-REPORT.md b/BUGS-TO-REPORT.md index e9cc9724..cd0d659e 100644 --- a/BUGS-TO-REPORT.md +++ b/BUGS-TO-REPORT.md @@ -7244,7 +7244,7 @@ What does not reproduce it: an interval that does not use *firstweekofyear* (`Da --- -## Refused arguments raise -2147467259, *Unspecified error*, where VB6 and VBA raise 5, 6, 9, 13 or 438 +## Refused arguments raise -2147467259, *Unspecified error*, or -2147352567, *Exception occurred.*, where VB6 and VBA raise 5, 6, 9, 13, 53, 94 or 438 **Describe the bug** Given an argument they refuse, several runtime procedures raise -2147467259 (`&H80004005`), *Unspecified error*, where VB6 and 64-bit VBA raise one of VB's own numbers: @@ -7255,13 +7255,17 @@ Given an argument they refuse, several runtime procedures raise -2147467259 (`&H - `GetObject()` with no arguments: 13. - `CallByName` with a *calltype* that is not a `VbCallType` value: 438, *Object doesn't support this property or method*; with an object of `Nothing`: 5. - `SaveSetting`, `GetSetting`, `GetAllSettings` and `DeleteSetting` with a zero-length application, section or key name, and `DeleteSetting` of an application, section or key that does not exist: 5. +- `AppActivate` with a title or task ID that no window has: 5. +- `Shell` with a zero-length path, spaces, a folder, a file that is not a program, or a path longer than 32,767 characters: 5; with a program or folder that does not exist, or an unclosed quotation mark: 53, *File not found*; with a *windowstyle* less than 0 or greater than 10: 5. +- `MsgBox` and `InputBox` with a *helpfile* and no *context*: 5. +- `SendKeys` raises -2147352567 (`&H80020009`), *Exception occurred.*, instead: for an unknown key code (`{INS}` and `{F17}` included), an unclosed brace, a count in braces that is not a whole number from 0 to 8,175, unbalanced parentheses or `++`, VB raises 5; for a *wait* of `Null`, 94; for a *wait* string that is not a `Boolean`, 13. It is the pattern of #2544 (`ReDim` with inverted bounds raises -2147467259 where VB6 raises 9). Observed in the compiler's test mode and in built exes, 32-bit and 64-bit. **To Reproduce** Steps to reproduce the behavior: 1. Open `argument-errors-unspecified-error.twinproj` (attached as `argument-errors-unspecified-error.zip`). -2. Run its test cases, the module below. On BETA 1010 the three controls pass and the other seventeen fail, each with `Err.Number` -2147467259. +2. Run its test cases, the module below. On BETA 1010 the three controls pass and the other twenty-five fail, each with `Err.Number` -2147467259, or -2147352567 for the two `SendKeys` cases. The module is meant to be adapted as a regression test. Each case asserts VB6's number, which the attached VB6 project (`argument-errors-unspecified-error-vb6.zip`) prints; 64-bit VBA raises the same numbers. No case writes to the registry: the registry procedures are given names that do not exist. ```vb @@ -7440,6 +7444,69 @@ Module RegressionTests Assert.Strict.AreEqual 5&, Err.Number End Sub + ' Batch 6b: the interactive procedures. Each raises before a box, a key or a program. + [TestCase] + Public Sub AppActivate_NoSuchWindow_Raises5() + On Error Resume Next + AppActivate "No such window: argument-errors-unspecified-error" + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub Shell_EmptyPath_Raises5() + Dim V As Variant + On Error Resume Next + V = Shell("") + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub Shell_MissingProgram_Raises53() + Dim V As Variant + On Error Resume Next + V = Shell("no-such-program-argument-errors-unspecified-error.exe") + Assert.Strict.AreEqual 53&, Err.Number + End Sub + + [TestCase] + Public Sub Shell_WindowStyle11_Raises5() + Dim V As Variant + On Error Resume Next + V = Shell("cmd.exe /c exit", 11) + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub MsgBox_HelpFileWithoutContext_Raises5() + Dim V As Variant + On Error Resume Next + V = MsgBox("x", , , "help.hlp") + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_HelpFileWithoutContext_Raises5() + Dim V As Variant + On Error Resume Next + V = InputBox("x", , , , , "help.hlp") + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + ' SendKeys raises -2147352567, Exception occurred, where the others raise -2147467259. + [TestCase] + Public Sub SendKeys_UnknownKeyCode_Raises5() + On Error Resume Next + SendKeys "{BAD}" + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub SendKeys_WaitNull_Raises94() + On Error Resume Next + SendKeys "", Null + Assert.Strict.AreEqual 94&, Err.Number + End Sub + End Module ``` @@ -7457,7 +7524,7 @@ A 64-bit build gives the same results. 64-bit VBA here is VBA 7.1 (VBE7.DLL 7.01 What does not reproduce it: the errors these procedures already raise with VB's numbers, such as `LBound` of an array not yet sized (9), `QBColor` outside 0 to 15 (5), `RGB` with a negative component (5), and `Null` for any of the arguments above (94). - + --- @@ -8045,3 +8112,384 @@ A 64-bit build gives the same results. Reported independently on BETA 1024 (docs What does not reproduce it: an expression of constants, literals and operators alone, such as `#If Win64 = 0`, `#If Win64 <> 1` or `#If Not (Win64 = 1)`, each true in a 32-bit build only, as it should be. + +--- + +## `AppActivate`, `InputBox`, `MsgBox` and `Shell` accept arguments VB6 and VBA refuse, and `MsgBox` shows no box for a style Windows refuses + +**Describe the bug** +Given an argument VB6 and 64-bit VBA refuse, these procedures go on as if it were valid: +- `Shell` with a *windowstyle* of 10 (`SW_SHOWDEFAULT`) starts the program; VB raises 5, *Invalid procedure call or argument*. `STARTUPINFO.wShowWindow` may hold any `ShowWindow` value but `SW_SHOWDEFAULT`, and `CreateProcessW` does not check it. VB6 and VBA take 0 to 9 after rounding; twinBASIC takes 0 to 10, and raises -2147467259 above (the entry on refused arguments). +- `InputBox` with an *xpos* or *ypos* outside -32,768 to 32,767 after rounding shows the box; VB raises 6, *Overflow*. twinBASIC raises 6 only outside the `Long` range. +- `MsgBox` and `InputBox` with a *context* and no *helpfile* show the box; VB raises 5. +- `MsgBox` and `InputBox` with a *helpfile* of `Null` raise 94, *Invalid use of Null*; VB raises 5. +- `AppActivate` of a hidden window raises nothing and leaves it hidden; VB raises 5. With a *wait* of `Null` or a string that is not a `Boolean` it raises nothing; VB raises 94 and 13. +- `MsgBox` passes *buttons* to Windows as it is, and when Windows refuses the style (a button group of 7 to 15, such as 7, 15 or -1) it shows no box, returns 0 and raises nothing. It should raise 5. (VB6 and VBA show an OK box for any style they do not know and return 1; passing every style Windows accepts to it is a welcome extension, `vbCancelTryAgainContinue` among them, but a style Windows refuses should not pass silently.) A style of -1 also carries `MB_SERVICE_NOTIFICATION`, which twinBASIC hands to Windows as well; Windows refuses it for its button group before it would show anything. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `interaction-missing-argument-checks.twinproj` (attached as `interaction-missing-argument-checks.zip`). +2. Run its test cases, the module below. On BETA 1010 the three controls pass and the other twelve fail. + +The module is meant to be adapted as a regression test. Each case asserts VB6's number, which the attached VB6 project (`interaction-missing-argument-checks-vb6.zip`) prints, with how many boxes it showed; 64-bit VBA raises the same numbers. Every case runs under a copy of a dialog harness that answers each box `MsgBox` or `InputBox` shows at once (a `WH_CBT` hook that sends the box `WM_COMMAND` from Cancel, else its first button), and refuses a box for another desktop (it patches `MessageBoxIndirectA/W`), so no case waits for a person. That is also why `MsgBox_StyleMinus1_Raises5` reports 1002 today: the harness refuses the service-notification style twinBASIC passes on. The harness and a window helper are in the attached project, left out below. +```vb +' Regression tests: AppActivate, InputBox, MsgBox and Shell refuse the arguments VB6 and 64-bit +' VBA refuse, with the numbers they raise (the VB6 project beside this one prints them), and +' MsgBox raises 5 for a style Windows refuses, where it now shows no box and returns 0. +' The dialog harness answers every box a case shows, so no case waits for a person, and no +' box can open on another desktop. tbrun --tests runs each case and prints PASS or FAIL. +[TestFixture] +Module RegressionTests + ' ... the copies of the dialog and window harnesses: in the attached project ... + + ' A control: twinBASIC already does this. + [TestCase] + Public Sub Shell_WindowStyle9_Runs() + Dim V As Variant + On Error Resume Next + V = Shell("cmd.exe /c exit", 9) + Assert.Strict.AreEqual 0&, Err.Number + End Sub + + ' A control: twinBASIC already does this. + [TestCase] + Public Sub MsgBox_HelpFileAndContext_ShowsBox() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", , , "help.hlp", 5) + dialog_End + Assert.Strict.AreEqual 0&, Err.Number + End Sub + + ' A control: twinBASIC already does this. + [TestCase] + Public Sub AppActivate_VisibleWindow_Activates() + Dim V As Variant + On Error Resume Next + window_Begin + AppActivate window_Title() + window_End + Assert.Strict.AreEqual 0&, Err.Number + End Sub + + [TestCase] + Public Sub Shell_WindowStyle10_Raises5() + Dim V As Variant + On Error Resume Next + V = Shell("cmd.exe /c exit", 10) + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_XPos32768_Raises6() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = InputBox("x", , , 32768, 0) + dialog_End + Assert.Strict.AreEqual 6&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_YPosMinus32769_Raises6() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = InputBox("x", , , 0, -32769) + dialog_End + Assert.Strict.AreEqual 6&, Err.Number + End Sub + + [TestCase] + Public Sub MsgBox_ContextWithoutHelpFile_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", , , , 5) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_ContextWithoutHelpFile_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = InputBox("x", , , , , , 5) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub MsgBox_HelpFileNull_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", 0, "t", Null) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_HelpFileNull_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = InputBox("x", , , , , Null) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub AppActivate_HiddenWindow_Raises5() + Dim V As Variant + On Error Resume Next + window_Begin + window_Hide + AppActivate window_Title() + window_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub AppActivate_WaitNull_Raises94() + Dim V As Variant + On Error Resume Next + window_Begin + AppActivate window_Title(), Null + window_End + Assert.Strict.AreEqual 94&, Err.Number + End Sub + + [TestCase] + Public Sub AppActivate_WaitString_Raises13() + Dim V As Variant + On Error Resume Next + window_Begin + AppActivate window_Title(), "x" + window_End + Assert.Strict.AreEqual 13&, Err.Number + End Sub + + [TestCase] + Public Sub MsgBox_ButtonGroup7_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", 7) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + ' -1 has MB_SERVICE_NOTIFICATION too, which twinBASIC passes to Windows: the dialog + ' harness refuses that call, so the case reports 1002 until twinBASIC raises 5 first. + [TestCase] + Public Sub MsgBox_StyleMinus1_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", -1) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + +End Module +``` + +**Expected behavior** +The numbers VB6 and 64-bit VBA raise: 5 for `Shell`'s *windowstyle* 10, for *context* without *helpfile*, for a *helpfile* of `Null` and for a hidden window; 6 for *xpos* and *ypos* outside the `Integer` range; 94 and 13 for `AppActivate`'s *wait*. And 5 from `MsgBox` for a style Windows refuses. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045), system locale 1033 + - twinBASIC compiler version: BETA 1010 + +**Additional context** +Severity: medium for `MsgBox`, whose answer to a style Windows refuses is 0, which no `VbMsgBoxResult` is: a program that tests the answer takes a wrong branch, silently. Low for the rest, each of which lets a mistake in an argument go unreported. + +A 64-bit build gives the same results. 64-bit VBA here is VBA 7.1 (VBE7.DLL 7.01.1158) in 64-bit Microsoft 365 Access. + +What does not reproduce it: a *windowstyle* of 0 to 9; *xpos* and *ypos* inside the `Integer` range; a *helpfile* with a *context*; a visible or a minimized window (which none of the runtimes restores); a `Boolean` *wait*; a style Windows accepts. + + + +--- + +## `SendKeys` sends the wrong key for a character the keyboard layout has no key for + +**Describe the bug** +`SendKeys` converts its string to the ANSI code page first, and then sends each character by its key. A character the keyboard layout has no key for therefore goes wrong, silently: +- a character outside the ANSI code page becomes its nearest ANSI character: `Ā` (U+0100) is sent as Shift+A, `☺` (U+263A) as `?` (Shift and `&HBF`); +- a character in the ANSI code page that the layout has no key for is sent as a virtual key whose number is its ANSI code: `é` on a US layout is sent as virtual key `&HE9`, an OEM key, which types nothing or another character. + +VB6 and 64-bit VBA send each such character as the character itself (`SendInput` with `KEYEVENTF_UNICODE`), so it is typed correctly in any window. Text in any language other than English is mistyped. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `sendkeys-non-ascii.twinproj` (attached as `sendkeys-non-ascii.zip`). +2. Run its test cases, the module below. On BETA 1010, with a US keyboard layout, the two controls pass and the three other cases fail. + +The module is meant to be adapted as a regression test. Each case asserts the events VB6 sends, which the attached VB6 project (`sendkeys-non-ascii-vb6.zip`) prints. Every case runs under a copy of a keys harness that patches `keybd_event` (what twinBASIC calls) and `SendInput` (what VB6 calls) with fakes that record each event and send nothing, so no key reaches any window; it is in the attached project, left out below. +```vb +' Regression tests: SendKeys sends a character the keyboard layout has no key for as the +' character itself (a KEYEVENTF_UNICODE event), as VB6 and 64-bit VBA do, not as the virtual key +' of its ANSI code or as its nearest ANSI character. A copy of a keys harness records the events +' and sends none: `d` and `u` for a key down and up, `Ud` and `u` for a +' character. The expected events are for a US keyboard layout, which has no key for é. +' tbrun --tests runs each case and prints PASS or FAIL. +[TestFixture] +Module RegressionTests + ' ... the copy of the keys harness: in the attached project ... + + ' A control: a character the layout has a key for. + [TestCase] + Public Sub SendKeys_LowerA_SendsA() + keys_Begin + SendKeys "a" + keys_End + Assert.Strict.AreEqual "41d 41u", keys_Sent + End Sub + + ' A control: with Shift. + [TestCase] + Public Sub SendKeys_UpperA_SendsShiftA() + keys_Begin + SendKeys "A" + keys_End + Assert.Strict.AreEqual "10d 41d 41u 10u", keys_Sent + End Sub + + ' é: in the ANSI code page, with no key on a US layout. + [TestCase] + Public Sub SendKeys_EAcute_SendsTheCharacter() + keys_Begin + SendKeys ChrW(&HE9) + keys_End + Assert.Strict.AreEqual "UE9d UE9u", keys_Sent + End Sub + + ' ☺ (U+263A): outside the ANSI code page. + [TestCase] + Public Sub SendKeys_WhiteSmilingFace_SendsTheCharacter() + keys_Begin + SendKeys ChrW(&H263A) + keys_End + Assert.Strict.AreEqual "U263Ad U263Au", keys_Sent + End Sub + + ' Ā (U+0100): outside the ANSI code page, whose nearest character is A. + [TestCase] + Public Sub SendKeys_AMacron_SendsTheCharacter() + keys_Begin + SendKeys ChrW(&H100) + keys_End + Assert.Strict.AreEqual "U100d U100u", keys_Sent + End Sub + +End Module +``` + +**Expected behavior** +Each character sent as the character itself, a `KEYEVENTF_UNICODE` key down and up, as VB6 and 64-bit VBA send it, when the keyboard layout has no key for it. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045), system locale 1033, US keyboard layout + - twinBASIC compiler version: BETA 1010 + +**Additional context** +Severity: medium. The wrong characters are typed into another program, and nothing reports it. + +A 64-bit build gives the same results. 64-bit VBA here is VBA 7.1 (VBE7.DLL 7.01.1158) in 64-bit Microsoft 365 Access, and sends what VB6 sends. + +What does not reproduce it: a character the layout has a key for, with or without Shift; the codes in braces, such as `{ENTER}` and `{F1}`, and the modifiers, which send the same events as VB6. On a layout with a key for `é` (French, for instance), both send that key. + + + +--- + +## In an exe on a desktop that is not the input desktop, showing or activating a new top-level window takes 2 s from the third on + +**Describe the bug** +A twinBASIC exe that runs on a desktop other than the input desktop (one made with `CreateDesktop` and named in `STARTUPINFO.lpDesktop`, as test harnesses do to keep windows off the user's screen) waits 2 s each time a new top-level window of its own is activated, from the third window it shows on: in `CreateWindowEx` for a window created `WS_VISIBLE`, or in `AppActivate` for one shown without activation. The same program built in VB6 takes no time there, and the same twinBASIC program takes none in the IDE's run after the build, or as an exe on the input desktop (0.02 s a window). `DoEvents` before or after the call changes nothing. + +It costs a program that opens windows in a loop 2 s a window, which makes automated tests of twinBASIC programs on a private desktop slow and timing-dependent. + +**To Reproduce** +Steps to reproduce the behavior: +1. Open `private-desktop-window-activation-delay.twinproj` (attached as `private-desktop-window-activation-delay.zip`). +2. Build the exe and start it on a desktop that is not the input desktop (`CreateDesktopW`, then `CreateProcessW` with `lpDesktop` naming it). It writes to `out.txt` beside itself; on BETA 1010 windows 2 to 4 each take 2 s to make. + +```vb +' Makes four top-level windows one after another, each shown at creation (WS_VISIBLE, which +' activates it) and destroyed after AppActivate, and writes how long each step took to out.txt +' beside the exe (or to the file TBRUN_OUT names). A throwaway window comes first, since the +' first window a program shows takes the show command it was started with (hidden, for a +' program started hidden). Run as an exe on a desktop that is not the input desktop, as +' bug_repro.mjs run --exe and tbrun --exe do, it takes 2 s to create each window from the third +' it shows (window 2 below) on. In the IDE's run after the build there is no delay; on the +' input desktop each takes 0.02 s; and the VB6 project beside this one takes none on either. +Module Startup + Private Declare PtrSafe Function CreateWindowExA Lib "user32" (ByVal Ex As Long, ByVal Cls As String, ByVal Title As String, ByVal Style As Long, ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long, ByVal Parent As LongPtr, ByVal Menu As LongPtr, ByVal Inst As LongPtr, ByVal P As LongPtr) As LongPtr + Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal H As LongPtr) As Long + Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long + + Private Sub Out(ByVal Text As String) + If App.IsInIDE Then + Debug.Print Text + Exit Sub + End If + Dim file As String = Environ$("TBRUN_OUT") + If Len(file) = 0 Then file = App.Path & "\out.txt" + Dim f As Integer = FreeFile + Open file For Append As #f + Print #f, Text + Close #f + End Sub + + Public Sub Main() + Dim I As Long, H As LongPtr, T0 As Double, T1 As Double, T2 As Double, Title As String + Title = "WindowActivationDelay" & GetCurrentProcessId() + DestroyWindow CreateWindowExA(0, "STATIC", "first", &H10CF0000, 0, 0, 100, 50, 0, 0, 0, 0) + On Error Resume Next + For I = 1 To 4 + T0 = Timer + H = CreateWindowExA(0, "STATIC", Title, &H10CF0000, 100 + I * 30, 100 + I * 30, 300, 100, 0, 0, 0, 0) + T1 = Timer + AppActivate Title + T2 = Timer + Out I & " made " & Format$(T1 - T0, "0.00") & " activated " & Format$(T2 - T1, "0.00") & " error " & Err.Number + Err.Clear + DestroyWindow H + Next + End Sub + + ' The IDE's run after the build: the same windows, in the IDE, where there is no delay. + [RunAfterBuild] + Private Sub Built() + Debug.Cls + Main + End Sub +End Module +``` + +Output of the exe on a private desktop: +``` +1 made 0.00 activated 0.00 error 0 +2 made 2.01 activated 0.00 error 0 +3 made 2.02 activated 0.00 error 0 +4 made 2.02 activated 0.00 error 0 +``` + +**Expected behavior** +No wait, as in VB6 (the attached `private-desktop-window-activation-delay-vb6.zip` prints 0.00 for every step on the same desktop) and as in twinBASIC itself on the input desktop. + +**Desktop:** + - OS: Windows 10 Pro 22H2 (build 19045) + - twinBASIC compiler version: BETA 1010 + +**Additional context** +Severity: low. Programs on the user's own desktop are not affected. + +When the window is created hidden and shown with `SW_SHOWNA`, the 2 s moves from `CreateWindowEx` into `AppActivate`; so the wait belongs to the activation of a new window, whichever call makes it. The program never calls `GetForegroundWindow` during it. On a private desktop no window becomes the foreground window; something in the twinBASIC runtime apparently waits for that, with a 2 s limit. + + diff --git a/WIP.Broker.md b/WIP.Broker.md index 7b52cd2d..80258628 100644 --- a/WIP.Broker.md +++ b/WIP.Broker.md @@ -171,7 +171,10 @@ dropped. A lease with `port` that finds no port fails `no-port` at once rather t the socket while no request is in flight, so it never keeps Node alive by itself.) 2. **If the pipe cannot be opened** (it does not exist, or is busy), run `tbbroker.exe start` --- `TBBROKER_EXE`, else `%LOCALAPPDATA%\tbbroker\tbbroker.exe` --- wait for it to exit (0 means - the broker answers), and connect again. Send `hello` and check `protocol` is 1. + the broker answers), and connect again: on ENOENT or EBUSY, again at a random 50 to 150 ms + for up to 5 s, since clients that start the broker at once can find the pipe with no + instance waiting for a moment (seen on 2026-10-22: four clients, all ENOENT). Send `hello` + and check `protocol` is 1. 3. **Before starting a program**: `lease` with a `tag` that says what it is (`"tbbuild 9333"`, `"lane help-2"`). Start the program on `desktop`, and name its folders and ids by `slot`. 4. **Hand the lease to the process that lives as long as the program**: `hold` the launcher's pid diff --git a/WIP.Errors.md b/WIP.Errors.md index 6c1e731b..30fd8e94 100644 --- a/WIP.Errors.md +++ b/WIP.Errors.md @@ -64,8 +64,13 @@ of the re-check is left. applied; four new entries queued in BUGS-TO-REPORT.md, and `DISP_E_NOTACOLLECTION` added to `latebound-hresult-mapping` (*Batch 6a findings*). No row is `bug: pending`. -**Next: batch 6b**, `Interaction`'s interactive procedures (the batch table's row says what a -probe may and may not call). +**Batch 6b is done** (2026-10-27), `Interaction`'s interactive procedures, under three new +harnesses (`dialog`, `keys`, `window`): 164 cases, all agreeing in all four runtimes (the whole +`VBA.Interaction.yml`, 355 cases, too); sections on AppActivate, InputBox, MsgBox, SendKeys and +Shell; DoEvents quiet; Beep nothing (D3). `argument-errors-unspecified-error` extended, three +entries queued (*Batch 6b findings*). No row is `bug: pending`, and no question is open. + +**Next: batch 7**, VBA `FileSystem`. ## Owner's decisions @@ -349,6 +354,28 @@ Windows refuses). `check_errors.mjs` reports a harness the data names and has no the case's error (raised again with its description once the key is gone), so nothing a case writes stays in the user's registry. A case's `setup` may save what it reads. Check after a run that no `tbdocsErrorsProbe*` key is left. +- **`dialog`** (batch 6b) --- `MsgBox`, `InputBox`. A `WH_CBT` hook on the probe's thread notes + each top-level `#32770` it creates and, as it is activated, hides it and **sends** + `WM_COMMAND` from Cancel, else the first push button that is not Help (a posted one never + reaches the box in Access; `EndDialog` skips the dialog procedure, and twinBASIC's InputBox + then faults in OLEAUT32). A guard patches `MessageBoxIndirectA/W` (twinBASIC calls the W form, + VB6 and VBA the A form) and refuses a style with any of &H260000 (another desktop: service + notification, its NT 3.x form, default desktop only), which `dialog_End` reports as 1002; the + six other MessageBox entry points are refused outright. `dialog_Expect Count` raises 1001; + `dialog_Count`, `dialog_Style`, `dialog_Button` record the last box. VB6 builds a probe with + `dialog` cases without Unattended Execution (`ATTENDED_HARNESSES`), and `VbaSession` ends + Access only at a box seen at two polls. +- **`keys`** (batch 6b) --- `SendKeys`. Patches `keybd_event` (twinBASIC's way) and `SendInput` + (VB6's and VBA's) with fakes that record each event and succeed, and `SetWindowsHookExA/W` + with one that refuses a journal-playback hook as Windows does without UIAccess (VB6 and VBA + then use `SendInput`). `keys_Expect "10d 41d 41u 10u"` raises 1001 for other events + (``, or `U` for a Unicode one). +- **`window`** (batch 6b) --- `AppActivate`. A `STATIC` top-level window titled `window_Title` + (with the process id), shown without activation; `window_Pid`, `window_Hide`, + `window_Minimize`, `window_Visible`, `window_Minimized`. On the private desktop no window + becomes the foreground one, and AppActivate raises nothing for that; in twinBASIC, activating a + new window there takes 2 s from the third on (not on the user's desktop), so `errors.mjs` + gives a twinBASIC probe 120 s. **YAML pitfalls**, each met in batch 2: @@ -403,8 +430,9 @@ What the probes must respect (BETA 1010; `errors.mjs` already does all of it): variable (bug `module-init-reads-other-module-ide`), and may differ in other ways. - **A `tbrun --exe` probe brings its own `Sub Main`**, without the console template's `tbxMain.twin`; two `Main`s make the build fail with *'Main' is ambiguous*. -- **Never `MsgBox`, `InputBox` or an unhandled error** in a probe: each opens a modal box on a - private desktop. Every case runs under `On Error Resume Next`. +- **Never an unhandled error** in a probe, and **`MsgBox` and `InputBox` only under the `dialog` + harness**, `SendKeys` only under `keys`: otherwise each opens a modal box on a private desktop, + or sends keys. Every case runs under `On Error Resume Next`. - **Keep the generated code plain.** A module-level or class-field initializer cannot call a procedure of the project, and a class field that reads another field fails the build (bug `class-field-init-reads-field`). @@ -675,6 +703,167 @@ one key (a VB6 case failed when another runtime's cleanup removed its section). in VB (32,768 raises 6 in all four): state the type on the page, and the 6 is then the conversion, not listed. +## Batch 6b design (2026-10-22; D1 to D4 answered by the owner) + +The pages: AppActivate, Beep, DoEvents, InputBox, MsgBox, SendKeys and Shell. Each of them +acts outside the probe --- a box, a key, a window's focus, a process, a sound --- so the +question for each is what the probe may let happen, and what it must intercept. + +**The problem with the rule as it stands.** The batch row allows MsgBox and InputBox never, +and SendKeys only with strings refused before a key is sent. That leaves MsgBox and InputBox +with no quiet cases at all, so no row could be written either: a case such as +`MsgBox("x", 7)` cannot be tried without the risk that it succeeds and opens a box. And which +SendKeys strings are refused before a key is sent is just what the probe has to find out. The +design therefore makes each effect safe *in the probe's own process*, as the clock harness +does for the system clock, so that every case can be tried. + +### Three harnesses + +Each is one `errors/harnesses/.bas` for all four runtimes, `#If VBA7` for the +declarations and the callback's signature, a pointer kept in a `Variant` (*Harnesses*). + +- **`dialog`** (MsgBox, InputBox) --- two parts. + - *The answer.* `dialog_Begin` installs a `WH_CBT` hook on the probe's own thread + (`SetWindowsHookEx(5, AddressOf dialog_Hook, 0, GetCurrentThreadId())`), and `dialog_End` + removes it. The hook notes each window of class `#32770` it sees created + (`HCBT_CREATEWND`), and when one of those is activated (`HCBT_ACTIVATE`) it hides it and + posts `WM_COMMAND` for one of its buttons: Cancel (2) when the box has one, else its first + button that is not Help (9). It records each box it answered: its title, its text (the + static control 65535 in a message box) and the button pressed, so that + `dialog_Expect Count` can raise 1001 when a quiet case did not show the box it should (a + call that silently does nothing is told apart from one that showed and returned). Windows + the hook did not see created --- Access's own --- are left alone. The real MessageBox and + the real dialog run: what they refuse is what the probe measures. + - *The guard.* A box can be shown on a desktop other than the probe's: + `MB_SERVICE_NOTIFICATION` (&H200000), its NT 3.x form (&H40000) and + `MB_DEFAULT_DESKTOP_ONLY` (&H20000) put it on the **input desktop**, the user's, where no + thread hook sees it, and a *buttons* of -1 or 2147483647 has those bits. So `dialog_Begin` + also patches every MessageBox entry point of user32 (`MessageBoxA/W`, `MessageBoxExA/W`, + `MessageBoxIndirectA/W`, `MessageBoxTimeoutA/W`) with a jump to a guard, as `clock_Patch` + does: a style with any of the bits &H260000 is refused (the guard returns 0, sets + `ERROR_INVALID_PARAMETER` and counts a *guarded* call, which `dialog_End` reports as + error 1002 so that the case can never pass silently); any other style is passed to the + real function (bytes put back, the call made, the patch put again; the probe has one + thread). VB6's MSVBVM60 imports `MessageBoxIndirectA` and `MessageBoxA`; what twinBASIC + and VBE7 call is the first thing step 1 of the plan finds out, and **no case with those + bits runs in a runtime until a guard is shown to catch that runtime's calls**. +- **`keys`** (SendKeys) --- a jump patch, as the clock's, of the calls that inject input: + `SendInput` and `keybd_event` in user32, and `SetWindowsHookExA/W` for a journal-playback + hook (`idHook` 1), which MSVBVM60 imports and may be how VB6 sends keys. The fakes record + each key event (virtual key, up or down) and report success; nothing is injected. A + journal-playback hook is recorded and its callback driven by the harness until it reports + the end (`HC_GETNEXT`, `HC_SKIP`), as Windows would; whether this part is needed at all is + step 1's answer for VB6. `keys_Expect ""` raises 1001 when the recorded events are + not the ones given (`"a{ENTER}"` written as the harness's own short form, the plan's step + 4). So a quiet case checks what a string *sends*, and a row can say whether keys before a + bad token are sent first (`"a{BAD}"`). The private desktop is not the input desktop, so a + key that slipped past the patch could not reach the user's desktop either; the patch is + what makes the result independent of that. +- **`window`** (AppActivate) --- `window_Begin` creates a visible top-level window of the + probe's own thread titled `window_Title` (`tbdocsErrorsProbe` and the process id, as + `registry_App`), and `window_End` destroys it, so that a case has something to activate + by title, by a prefix of it, and by task id (`window_Pid`, the probe's own process id). A + private desktop is never the input desktop, so Windows may refuse to bring a window to the + foreground there; if step 1 shows that it does, the harness also patches the activation + call each runtime makes (`SetForegroundWindow`, MSVBVM60 imports it) with a fake that + refuses what the real one refuses (`IsWindow` false) and records the window, so that no + error of the private desktop reaches the data (the owner's rule: an error only the test + setup raises is not listed). + +**Shell** needs no harness: the batch row's limit stays (a program that does not exist, +`cmd.exe /c exit`, and files that are not programs, such as `win.ini` of the Windows folder). +A process it starts inherits the probe's private desktop and its kill-on-close job. No case +names a `.bat`, `.cmd` or anything else CreateProcess would run. + +**DoEvents** gets quiet cases and no section. **Beep** has no arguments and nothing to raise: +no case (it would sound in the owner's room four times a run) and no section. + +### What changes in the tooling + +- **VB6 is built without Unattended Execution for a page under the `dialog` harness.** With + `Unattended=-1`, VB6's MsgBox writes to the event log and shows nothing, so the probe would + measure the log. `runRepro` takes an option for it, and `errors.mjs` passes it when a case + of the probe uses `dialog`. A box the exe opens is still closed by the launcher; under the + hook there should be none. +- **`VbaSession` ends Access at a box only when it has stayed for two polls.** Today any + visible `#32770` of Access ends it (*Tooling*), and the hook's box exists for an instant + before it hides it. A compile error's box stays until answered, so nothing it catches is + lost. +- **`tbrun`** needs nothing: a box the launcher sees and closes is reported in `dialogs`, + which `errors.mjs` reads only when the probe stopped. +- `check_errors.mjs` needs nothing new: the three harnesses are files it already checks for. +- **WIP.Errors.md**: *What the probes must respect* says MsgBox and InputBox only under the + `dialog` harness, and the batch row is rewritten. + +### The owner's decisions + +- **D1.** May a probe call MsgBox and InputBox under the `dialog` harness (hook and guard)? + Without it the two pages get at most their Null rows, and only where a Null is refused + before a box opens, which cannot be known without trying. +- **D2.** May SendKeys be given strings that send keys, under the `keys` harness, once step 1 + shows the patch catches every runtime's calls (the first such run with the owner's OK, + since it is the one that would send a key if the patch missed)? +- **D3.** Beep: no case and no section, as above, or a guard (`MessageBeep` and `Beep` + patched) and quiet cases? +- **D4.** If VB6 (or 64-bit VBA) raises an error for SendKeys or AppActivate on the user's + own desktop because of Windows itself (VB6's SendKeys is known to raise 70 *Permission + denied* on Windows Vista and later when its journal hook is refused), is that a row, a + NOTE, or nothing? It is the runtime's behaviour on a current Windows, not the test setup's, + so the 2026-10-22 rule does not settle it. The harness hides it, so step 1 checks it once + on the user's desktop only with the owner's OK, or the owner answers from what is known. + +Owner's answers (2026-10-22): **D1 yes** (MsgBox and InputBox under `dialog`). **D2 yes** +(SendKeys strings that send keys, under `keys`, once step 1 shows the patch catches every +runtime's calls). **D4 nothing**: no row and no NOTE, since the documentation does not +document VB6, and such an error is a VB6 bug for practical purposes; it is not checked on +the user's desktop either. **D3 left for now**: Beep takes no arguments and either works or +does not, so it gets no case, no harness and no section. + +## Batch 6b findings (VBA `Interaction`, interactive procedures, BETA 1010, 2026-10-27) + +**What each runtime calls** (a temporary trace harness that patched each candidate export with a +refusing fake): MsgBox `MessageBoxIndirectW` (twinBASIC) and `MessageBoxIndirectA` (VB6, VBA); +InputBox `DialogBoxIndirectParamW` (twinBASIC), `DialogBoxParamA` template &HFBF (VB6, VBA); +SendKeys `keybd_event` (twinBASIC), and in VB6 and VBA a journal-playback hook, refused on +Windows 10, then `SendInput` one event at a time; AppActivate `SetForegroundWindow` and `SetFocus` +in all; Shell `CreateProcessW` with `STARTF_USESHOWWINDOW` and *windowstyle* as `wShowWindow` in +all. The harnesses (*Harnesses*) cover exactly these. + +**Owner's decisions (2026-10-27)**: +- **Bugs**, queued: SendKeys' -2147352567 and AppActivate's, Shell's, MsgBox's and InputBox's + -2147467259 join `argument-errors-unspecified-error`. `interaction-missing-argument-checks`: + Shell *windowstyle* 10 (`SW_SHOWDEFAULT`, the one value `STARTUPINFO` may not hold; VB takes + 0 to 9 after rounding and nothing done first changes it), InputBox *xpos*/*ypos* outside the + `Integer` range (VB 6), *context* without *helpfile* (VB 5), *helpfile* **Null** raising 94 + (VB 5), AppActivate of a hidden window (twinBASIC leaves it hidden; VB 5) and an unchecked + *wait*, and MsgBox styles Windows refuses (button group 7 to 15: no box, 0 returned; should + raise 5; VB shows an OK box). `sendkeys-non-ascii`: a character the layout has no key for is + converted to ANSI and sent as a key (é as virtual key &HE9, ☺ as `?`, Ā as Shift+A); VB sends + the character (KEYEVENTF_UNICODE). `private-desktop-window-activation-delay`: in an exe on a + private desktop, activating a new window takes 2 s from the third (none on the user's desktop, + run there once with the owner's agreement, none in VB6). +- **Extensions**: AppActivate `""` (64-bit VBA agrees; VB6 5); SendKeys *wait* `"True"` (VB 13); + MsgBox passing every style Windows accepts (VB shows an OK box for a style it does not know: + 6, two icons, &H400, -1). NOTEs on the pages. +- **Nothing documented**: VB's `"((a))"` (Shift left down), its doubled Shift for `"+"`, and its + keeping the keys of a refused string for the next SendKeys (arguably a VB bug; twinBASIC drops + the string, which is right). D4: no error Windows makes VB raise on the user's desktop. +- **Unguarded MsgBox -1 and &H7FFFFFFF** (owner's agreement): Windows refuses them for their + button group before any box, so the service-notification bit never shows a box. + +**Pages**: MsgBox and InputBox lose "If *helpfile* is supplied, *context* must also be supplied" +(the tables carry it); Shell's "or zero if the program could not be started" is a `` +comment (all four raise); SendKeys' `{INS}` is a `` comment (all four refuse it), its +PRINT SCREEN NOTE says why (`{PRTSC}` sends `VK_PRINT`, &H2A), and a count in braces is at most +8,175 in all four; AppActivate matches a title's end as well as its beginning. + +**Tooling** found on the way: VB6 and VBA refuse a declaration after a procedure, so a probe +with two harnesses puts all their declarations first (`splitHarness`); Access never delivers a +posted WM_COMMAND to a box, so the dialog harness sends it; `EndDialog` from outside makes +twinBASIC's InputBox fault (a string it never set); a reproducer's VB6 project may call MsgBox and +InputBox when it carries the dialog harness (`reproAnswersBoxes`). The broker's startup race +(four clients, all ENOENT) is fixed on both sides (WIP.Broker.md). + ## The 64-bit VBA re-check (BETA 1010, Office 365 x64, VBA 7.1 VBE7.DLL 7.01.1158, 2026-10-22) Batches 2 to 5 and `Core.yml` in all four runtimes. Every runtime agreed with the data as it @@ -754,8 +943,8 @@ each can be run when there is budget. Status is kept here. | 4 | VBA `Math` | 17 | done: 15 sections, 132 cases; 2026-10-22 | | 2--5 | Re-check of batches 2 to 5 and Core in four runtimes (64-bit VBA added) | --- | done: all agree; committed 2026-10-22, see *The 64-bit VBA re-check* | | 5 | VBA `DateTime` | 20 | done: 17 sections, 328 cases; owner's questions answered 2026-10-22 | -| 6a | VBA `Information`, and `Interaction`'s non-interactive procedures: `CallByName`, `CallByDispId`, `Choose`, `Command`, `CreateObject`, `GetObject`, `Environ`, `IIf`, `If`, `Partition`, `Switch`, `RaiseEventByName`, `RaiseEventByName2`, `SaveSetting`, `GetSetting`, `GetAllSettings`, `DeleteSetting` (owner split batch 6, 2026-10-22) | 45 | in progress | -| 6b | `Interaction`'s interactive procedures: `AppActivate`, `Beep`, `DoEvents`, `InputBox`, `MsgBox`, `SendKeys`, `Shell` (a probe never calls `MsgBox` or `InputBox`; `SendKeys` only with strings refused before a key is sent; `Shell` only with a missing program or `cmd.exe /c exit`) | 7 | not started | +| 6a | VBA `Information`, and `Interaction`'s non-interactive procedures: `CallByName`, `CallByDispId`, `Choose`, `Command`, `CreateObject`, `GetObject`, `Environ`, `IIf`, `If`, `Partition`, `Switch`, `RaiseEventByName`, `RaiseEventByName2`, `SaveSetting`, `GetSetting`, `GetAllSettings`, `DeleteSetting` (owner split batch 6, 2026-10-22) | 45 | done: 27 sections, 302 cases; four entries queued 2026-10-22 | +| 6b | `Interaction`'s interactive procedures: `AppActivate`, `Beep`, `DoEvents`, `InputBox`, `MsgBox`, `SendKeys`, `Shell`, under the `dialog`, `keys` and `window` harnesses (`Shell` only with programs that do not exist or `cmd.exe /c exit`) | 7 | done: 5 sections, 164 cases; three entries queued 2026-10-27 | | 7 | VBA `FileSystem` | 23 | not started | | 8 | VBA `Collection` and `ErrObject` (and the `Err.Raise` differences under *The central page*) | 22 | not started | | 9 | VBA `Financial` | 14 | not started | diff --git a/bugs/argument-errors-unspecified-error/argument-errors-unspecified-error.twinproj b/bugs/argument-errors-unspecified-error/argument-errors-unspecified-error.twinproj index ead45fc1..aa20aba3 100644 Binary files a/bugs/argument-errors-unspecified-error/argument-errors-unspecified-error.twinproj and b/bugs/argument-errors-unspecified-error/argument-errors-unspecified-error.twinproj differ diff --git a/bugs/argument-errors-unspecified-error/repro.json b/bugs/argument-errors-unspecified-error/repro.json index f979b0c5..9617c615 100644 --- a/bugs/argument-errors-unspecified-error/repro.json +++ b/bugs/argument-errors-unspecified-error/repro.json @@ -22,7 +22,15 @@ "^FAIL RegressionTests.CallByName_CallTypeZero_Raises438: .*Actual: -2147467259 ", "^FAIL RegressionTests.CallByName_Nothing_Raises5: .*Actual: -2147467259 ", "^FAIL RegressionTests.GetSetting_EmptyAppName_Raises5: .*Actual: -2147467259 ", - "^FAIL RegressionTests.DeleteSetting_MissingApplication_Raises5: .*Actual: -2147467259 " + "^FAIL RegressionTests.DeleteSetting_MissingApplication_Raises5: .*Actual: -2147467259 ", + "^FAIL RegressionTests.AppActivate_NoSuchWindow_Raises5: .*Actual: -2147467259 ", + "^FAIL RegressionTests.Shell_EmptyPath_Raises5: .*Actual: -2147467259 ", + "^FAIL RegressionTests.Shell_MissingProgram_Raises53: .*Actual: -2147467259 ", + "^FAIL RegressionTests.Shell_WindowStyle11_Raises5: .*Actual: -2147467259 ", + "^FAIL RegressionTests.MsgBox_HelpFileWithoutContext_Raises5: .*Actual: -2147467259 ", + "^FAIL RegressionTests.InputBox_HelpFileWithoutContext_Raises5: .*Actual: -2147467259 ", + "^FAIL RegressionTests.SendKeys_UnknownKeyCode_Raises5: .*Actual: -2147352567 ", + "^FAIL RegressionTests.SendKeys_WaitNull_Raises94: .*Actual: -2147352567 " ] } } diff --git a/bugs/argument-errors-unspecified-error/src/Sources/RegressionTests.twin b/bugs/argument-errors-unspecified-error/src/Sources/RegressionTests.twin index 6cff6054..e266f8e4 100644 --- a/bugs/argument-errors-unspecified-error/src/Sources/RegressionTests.twin +++ b/bugs/argument-errors-unspecified-error/src/Sources/RegressionTests.twin @@ -173,4 +173,67 @@ Module RegressionTests Assert.Strict.AreEqual 5&, Err.Number End Sub + ' Batch 6b: the interactive procedures. Each raises before a box, a key or a program. + [TestCase] + Public Sub AppActivate_NoSuchWindow_Raises5() + On Error Resume Next + AppActivate "No such window: argument-errors-unspecified-error" + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub Shell_EmptyPath_Raises5() + Dim V As Variant + On Error Resume Next + V = Shell("") + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub Shell_MissingProgram_Raises53() + Dim V As Variant + On Error Resume Next + V = Shell("no-such-program-argument-errors-unspecified-error.exe") + Assert.Strict.AreEqual 53&, Err.Number + End Sub + + [TestCase] + Public Sub Shell_WindowStyle11_Raises5() + Dim V As Variant + On Error Resume Next + V = Shell("cmd.exe /c exit", 11) + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub MsgBox_HelpFileWithoutContext_Raises5() + Dim V As Variant + On Error Resume Next + V = MsgBox("x", , , "help.hlp") + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_HelpFileWithoutContext_Raises5() + Dim V As Variant + On Error Resume Next + V = InputBox("x", , , , , "help.hlp") + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + ' SendKeys raises -2147352567, Exception occurred, where the others raise -2147467259. + [TestCase] + Public Sub SendKeys_UnknownKeyCode_Raises5() + On Error Resume Next + SendKeys "{BAD}" + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub SendKeys_WaitNull_Raises94() + On Error Resume Next + SendKeys "", Null + Assert.Strict.AreEqual 94&, Err.Number + End Sub + End Module diff --git a/bugs/argument-errors-unspecified-error/vb6/Module1.bas b/bugs/argument-errors-unspecified-error/vb6/Module1.bas index ceb50577..c488ae46 100644 --- a/bugs/argument-errors-unspecified-error/vb6/Module1.bas +++ b/bugs/argument-errors-unspecified-error/vb6/Module1.bas @@ -1,6 +1,338 @@ Attribute VB_Name = "Module1" Option Explicit +' ---- the dialog harness, a copy of errors/harnesses/dialog.bas: it answers any box MsgBox or InputBox shows +' The dialog harness, for twinBASIC, VB6 and VBA alike: a case that calls MsgBox or InputBox +' runs with the box answered as soon as it is shown, so the real MessageBox and the real +' dialog run, and what they refuse is what the probe measures. dialog_Begin installs a WH_CBT +' hook on the probe's own thread: each top-level #32770 window the thread creates is noted, and +' when it is activated the hook hides it and sends it WM_COMMAND from a button, as a click +' does: Cancel (2) when it has a Cancel button, else its first push button that is not Help +' (9). It is sent, not posted: in Access a posted WM_COMMAND never reaches the box. Nor is the +' box ended with EndDialog, which skips the dialog procedure: twinBASIC's InputBox then +' returns a string it never set, and faults in OLEAUT32 (BETA 1010). Windows the hook did +' not see created (Access's own) are left alone. Each box answered is counted, with its +' title, its text and the button, for dialog_Expect. +' A style with MB_SERVICE_NOTIFICATION (&H200000), its NT 3.x form (&H40000) or +' MB_DEFAULT_DESKTOP_ONLY (&H20000) puts a message box on the user's desktop, where no thread +' hook sees it. So dialog_Begin also patches MessageBoxIndirectA and MessageBoxIndirectW, the +' ones the runtimes call (twinBASIC the W form, VB6 and VBA the A form), with a guard that +' refuses such a style, and passes any other to the real function (its bytes put back for the +' call); the six other MessageBox entry points, which no runtime calls, are refused whatever +' the style. dialog_End raises 1002 when the guard refused a box, so such a case never passes. +' dialog_End puts the bytes back and removes the hook. VBA7 is true in twinBASIC and in VBA 7; +' VB6 compiles only the #Else branches, so they hold what it cannot parse. + +#If VBA7 Then +Private Declare PtrSafe Function dialog_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As LongPtr +Private Declare PtrSafe Function dialog_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As LongPtr, ByVal Name As String) As LongPtr +Private Declare PtrSafe Function dialog_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As LongPtr, ByVal S As LongPtr, ByVal P As Long, ByRef Old As Long) As Long +Private Declare PtrSafe Sub dialog_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As LongPtr) +Private Declare PtrSafe Sub dialog_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare PtrSafe Function dialog_GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Long +Private Declare PtrSafe Function dialog_SetWindowsHookExA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr +Private Declare PtrSafe Function dialog_UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function dialog_CallNextHookEx Lib "user32" Alias "CallNextHookEx" (ByVal H As LongPtr, ByVal Code As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr +Private Declare PtrSafe Function dialog_GetClassNameA Lib "user32" Alias "GetClassNameA" (ByVal H As LongPtr, ByVal S As String, ByVal N As Long) As Long +Private Declare PtrSafe Function dialog_GetWindowTextA Lib "user32" Alias "GetWindowTextA" (ByVal H As LongPtr, ByVal S As String, ByVal N As Long) As Long +Private Declare PtrSafe Function dialog_GetDlgItem Lib "user32" Alias "GetDlgItem" (ByVal H As LongPtr, ByVal Id As Long) As LongPtr +Private Declare PtrSafe Function dialog_GetDlgCtrlID Lib "user32" Alias "GetDlgCtrlID" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function dialog_GetWindow Lib "user32" Alias "GetWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As LongPtr +Private Declare PtrSafe Function dialog_GetWindowLongA Lib "user32" Alias "GetWindowLongA" (ByVal H As LongPtr, ByVal I As Long) As Long +Private Declare PtrSafe Function dialog_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As Long +Private Declare PtrSafe Function dialog_SendMessageA Lib "user32" Alias "SendMessageA" (ByVal H As LongPtr, ByVal M As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr +Private Declare PtrSafe Function dialog_RealIndirectA Lib "user32" Alias "MessageBoxIndirectA" (ByVal P As LongPtr) As Long +Private Declare PtrSafe Function dialog_RealIndirectW Lib "user32" Alias "MessageBoxIndirectW" (ByVal P As LongPtr) As Long +#Else +Private Declare Function dialog_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As Long +Private Declare Function dialog_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As Long, ByVal Name As String) As Long +Private Declare Function dialog_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As Long, ByVal S As Long, ByVal P As Long, ByRef Old As Long) As Long +Private Declare Sub dialog_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As Long) +Private Declare Sub dialog_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare Function dialog_GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Long +Private Declare Function dialog_SetWindowsHookExA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long +Private Declare Function dialog_UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal H As Long) As Long +Private Declare Function dialog_CallNextHookEx Lib "user32" Alias "CallNextHookEx" (ByVal H As Long, ByVal Code As Long, ByVal W As Long, ByVal L As Long) As Long +Private Declare Function dialog_GetClassNameA Lib "user32" Alias "GetClassNameA" (ByVal H As Long, ByVal S As String, ByVal N As Long) As Long +Private Declare Function dialog_GetWindowTextA Lib "user32" Alias "GetWindowTextA" (ByVal H As Long, ByVal S As String, ByVal N As Long) As Long +Private Declare Function dialog_GetDlgItem Lib "user32" Alias "GetDlgItem" (ByVal H As Long, ByVal Id As Long) As Long +Private Declare Function dialog_GetDlgCtrlID Lib "user32" Alias "GetDlgCtrlID" (ByVal H As Long) As Long +Private Declare Function dialog_GetWindow Lib "user32" Alias "GetWindow" (ByVal H As Long, ByVal Cmd As Long) As Long +Private Declare Function dialog_GetWindowLongA Lib "user32" Alias "GetWindowLongA" (ByVal H As Long, ByVal I As Long) As Long +Private Declare Function dialog_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As Long, ByVal Cmd As Long) As Long +Private Declare Function dialog_SendMessageA Lib "user32" Alias "SendMessageA" (ByVal H As Long, ByVal M As Long, ByVal W As Long, ByVal L As Long) As Long +Private Declare Function dialog_RealIndirectA Lib "user32" Alias "MessageBoxIndirectA" (ByVal P As Long) As Long +Private Declare Function dialog_RealIndirectW Lib "user32" Alias "MessageBoxIndirectW" (ByVal P As Long) As Long +#End If + +' Each address and window is kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. +' Targets 0 and 1 are MessageBoxIndirectA and W, the guarded ones; 2 to 7 are refused. +Private dialog_Targets(7) As Variant +Private dialog_Saved(95) As Byte +Private dialog_Hook As Variant +Private dialog_Noted(7) As Variant +Private dialog_Guarded As Long +' The boxes answered, and the last one's title, text and button. +Private dialog_Count As Long +Private dialog_Title As String +Private dialog_Text As String +Private dialog_Button As Long +' The style the last MessageBoxIndirect call was given. +Private dialog_Style As Long + +Private Function dialog_WindowText(ByVal H As Variant) As String + Dim S As String, N As Long + S = String$(1024, 0) + N = dialog_GetWindowTextA(H, S, 1024) + dialog_WindowText = Left$(S, N) +End Function + +' Notes a top-level window of class #32770 that the thread creates. +Private Sub dialog_Created(ByVal H As Variant, ByVal Style As Long) + Dim S As String, N As Long, I As Long + If (Style And &H40000000) <> 0 Then Exit Sub + S = String$(64, 0) + N = dialog_GetClassNameA(H, S, 64) + If Left$(S, N) <> "#32770" Then Exit Sub + For I = 0 To 7 + If IsEmpty(dialog_Noted(I)) Then + dialog_Noted(I) = H + Exit Sub + End If + Next +End Sub + +' Answers a noted window as it is activated: hides it, then ends it as the button. +Private Sub dialog_Activated(ByVal H As Variant) + Dim I As Long, C As Variant, Id As Long, T As Long + For I = 0 To 7 + If Not IsEmpty(dialog_Noted(I)) Then + If dialog_Noted(I) = H Then Exit For + End If + Next + If I > 7 Then Exit Sub + dialog_Noted(I) = Empty + If dialog_GetDlgItem(H, 2) <> 0 Then + Id = 2 + Else + C = dialog_GetWindow(H, 5) + Do While C <> 0 + T = dialog_GetWindowLongA(C, -16) And &HF& + If dialog_GetDlgCtrlID(C) <> 9 And (T = 0 Or T = 1) Then + If dialog_ClassOf(C) = "Button" Then + Id = dialog_GetDlgCtrlID(C) + Exit Do + End If + End If + C = dialog_GetWindow(C, 2) + Loop + End If + dialog_Count = dialog_Count + 1 + dialog_Title = dialog_WindowText(H) + C = dialog_GetDlgItem(H, 65535) + If C <> 0 Then dialog_Text = dialog_WindowText(C) Else dialog_Text = "" + dialog_Button = Id + dialog_ShowWindow H, 0 + dialog_SendMessageA H, &H111, Id, dialog_GetDlgItem(H, Id) +End Sub + +Private Function dialog_ClassOf(ByVal H As Variant) As String + Dim S As String, N As Long + S = String$(64, 0) + N = dialog_GetClassNameA(H, S, 64) + dialog_ClassOf = Left$(S, N) +End Function + +' A style the guard refuses: one that shows the box on another desktop. +Private Function dialog_Refused(ByVal Style As Long) As Boolean + dialog_Style = Style + If (Style And &H260000) = 0 Then Exit Function + dialog_Guarded = dialog_Guarded + 1 + dialog_SetLastError 87 + dialog_Refused = True +End Function + +' The six MessageBox entry points no runtime calls: refused, whatever the style. +Private Function dialog_Box4(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long) As Long + dialog_Refused &H200000 +End Function +Private Function dialog_Box5(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long, ByVal E As Long) As Long + dialog_Refused &H200000 +End Function +Private Function dialog_Box6(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long, ByVal E As Long, ByVal F As Long) As Long + dialog_Refused &H200000 +End Function + +#If VBA7 Then +Private Function dialog_Address(ByVal A As LongPtr) As Variant + dialog_Address = A +End Function + +Private Function dialog_Cbt(ByVal Code As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr + Dim Cs As LongPtr, Style As Long + If Code = 3 Then + dialog_CopyMemory Cs, ByVal L, LenB(Cs) + dialog_CopyMemory Style, ByVal Cs + 4 * LenB(Cs) + 16, 4 + dialog_Created W, Style + ElseIf Code = 5 Then + dialog_Activated W + End If + dialog_Cbt = dialog_CallNextHookEx(0, Code, W, L) +End Function + +' MSGBOXPARAMS: cbSize, then hwndOwner, hInstance, lpszText and lpszCaption, then dwStyle. +Private Function dialog_GuardA(ByVal P As LongPtr) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 4 * LenB(P) + LenB(P), 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 0, False + dialog_GuardA = dialog_RealIndirectA(P) + dialog_Put 0, True +End Function + +Private Function dialog_GuardW(ByVal P As LongPtr) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 4 * LenB(P) + LenB(P), 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 1, False + dialog_GuardW = dialog_RealIndirectW(P) + dialog_Put 1, True +End Function +#Else +Private Function dialog_Address(ByVal A As Long) As Variant + dialog_Address = A +End Function + +Private Function dialog_Cbt(ByVal Code As Long, ByVal W As Long, ByVal L As Long) As Long + Dim Cs As Long, Style As Long + If Code = 3 Then + dialog_CopyMemory Cs, ByVal L, 4 + dialog_CopyMemory Style, ByVal Cs + 32, 4 + dialog_Created W, Style + ElseIf Code = 5 Then + dialog_Activated W + End If + dialog_Cbt = dialog_CallNextHookEx(0, Code, W, L) +End Function + +Private Function dialog_GuardA(ByVal P As Long) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 20, 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 0, False + dialog_GuardA = dialog_RealIndirectA(P) + dialog_Put 0, True +End Function + +Private Function dialog_GuardW(ByVal P As Long) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 20, 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 1, False + dialog_GuardW = dialog_RealIndirectW(P) + dialog_Put 1, True +End Function +#End If + +' Writes target I's jump (On) or its original bytes back (not On). +Private Sub dialog_Put(ByVal I As Long, ByVal IsOn As Boolean) + Static Jumps(95) As Byte + Dim N As Long, Old As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If IsEmpty(dialog_Targets(I)) Then Exit Sub + P = dialog_Targets(I) + If IsOn Then + dialog_CopyMemory ByVal P, Jumps(I * 12), N + Else + dialog_CopyMemory Jumps(I * 12), ByVal P, N + dialog_CopyMemory ByVal P, dialog_Saved(I * 12), N + End If +End Sub + +' The jump to Fn: mov eax, Fn; jmp eax, or in 64-bit code mov rax, Fn; jmp rax. +Private Sub dialog_Patch(ByVal I As Long, ByVal Name As String, ByVal Fn As Variant) + Dim B(11) As Byte, N As Long, Old As Long, Target As Variant + Target = dialog_GetProcAddress(dialog_GetModuleHandleA("user32"), Name) + If Target = 0 Then Exit Sub + #If Win64 Then + Dim F As LongPtr, P As LongPtr + F = Fn + B(0) = &H48: B(1) = &HB8 + dialog_CopyMemory B(2), F, 8 + B(10) = &HFF: B(11) = &HE0 + N = 12 + #Else + Dim F As Long, P As Long + F = Fn + B(0) = &HB8 + dialog_CopyMemory B(1), F, 4 + B(5) = &HFF: B(6) = &HE0 + N = 7 + #End If + P = Target + dialog_VirtualProtect P, N, &H40, Old + dialog_CopyMemory dialog_Saved(I * 12), ByVal P, N + dialog_CopyMemory ByVal P, B(0), N + dialog_Targets(I) = Target +End Sub + +Private Sub dialog_Begin() + Dim I As Long + dialog_Count = 0 + dialog_Guarded = 0 + dialog_Title = "" + dialog_Text = "" + dialog_Button = 0 + dialog_Style = 0 + For I = 0 To 7 + dialog_Noted(I) = Empty + dialog_Targets(I) = Empty + Next + dialog_Patch 0, "MessageBoxIndirectA", dialog_Address(AddressOf dialog_GuardA) + dialog_Patch 1, "MessageBoxIndirectW", dialog_Address(AddressOf dialog_GuardW) + dialog_Patch 2, "MessageBoxA", dialog_Address(AddressOf dialog_Box4) + dialog_Patch 3, "MessageBoxW", dialog_Address(AddressOf dialog_Box4) + dialog_Patch 4, "MessageBoxExA", dialog_Address(AddressOf dialog_Box5) + dialog_Patch 5, "MessageBoxExW", dialog_Address(AddressOf dialog_Box5) + dialog_Patch 6, "MessageBoxTimeoutA", dialog_Address(AddressOf dialog_Box6) + dialog_Patch 7, "MessageBoxTimeoutW", dialog_Address(AddressOf dialog_Box6) + dialog_Hook = dialog_SetWindowsHookExA(5, dialog_Address(AddressOf dialog_Cbt), 0, dialog_GetCurrentThreadId()) +End Sub + +Private Sub dialog_End() + Dim I As Long, N As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If dialog_Hook <> 0 Then dialog_UnhookWindowsHookEx dialog_Hook + dialog_Hook = 0 + For I = 7 To 0 Step -1 + If Not IsEmpty(dialog_Targets(I)) Then + P = dialog_Targets(I) + dialog_CopyMemory ByVal P, dialog_Saved(I * 12), N + dialog_Targets(I) = Empty + End If + Next + If dialog_Guarded <> 0 Then Err.Raise 1002, , "the guard refused a box for another desktop" +End Sub + +' Raises 1001 when the case did not show Count boxes. Does nothing when it has already raised. +Private Sub dialog_Expect(ByVal Count As Long) + If Err.Number <> 0 Then Exit Sub + If dialog_Count <> Count Then Err.Raise 1001, , dialog_Count & " boxes shown, not " & Count +End Sub + + ' What VB6 raises for each argument the twinBASIC test cases give, in the same order. ' Build and run it with: node scripts/bug_repro.mjs vb6 argument-errors-unspecified-error ' No case writes to the registry: GetSetting and DeleteSetting are given names that do not exist. @@ -37,5 +369,15 @@ Sub Main() V = CallByName(D, "Count", VbGet): Report "CallByName_Nothing" S = GetSetting("", "Section", "Key"): Report "GetSetting_EmptyAppName" DeleteSetting "NoSuchApplication-argument-errors-unspecified-error": Report "DeleteSetting_MissingApplication" + AppActivate "No such window: argument-errors-unspecified-error": Report "AppActivate_NoSuchWindow" + V = Shell(""): Report "Shell_EmptyPath" + V = Shell("no-such-program-argument-errors-unspecified-error.exe"): Report "Shell_MissingProgram" + V = Shell("cmd.exe /c exit", 11): Report "Shell_WindowStyle11" + dialog_Begin + V = MsgBox("x", , , "help.hlp"): Report "MsgBox_HelpFileWithoutContext" + V = InputBox("x", , , , , "help.hlp"): Report "InputBox_HelpFileWithoutContext" + dialog_End + SendKeys "{BAD}": Report "SendKeys_UnknownKeyCode" + SendKeys "", Null: Report "SendKeys_WaitNull" Close #9 End Sub diff --git a/bugs/interaction-missing-argument-checks/interaction-missing-argument-checks.twinproj b/bugs/interaction-missing-argument-checks/interaction-missing-argument-checks.twinproj new file mode 100644 index 00000000..0e9e1b89 Binary files /dev/null and b/bugs/interaction-missing-argument-checks/interaction-missing-argument-checks.twinproj differ diff --git a/bugs/interaction-missing-argument-checks/repro.json b/bugs/interaction-missing-argument-checks/repro.json new file mode 100644 index 00000000..8eb6369f --- /dev/null +++ b/bugs/interaction-missing-argument-checks/repro.json @@ -0,0 +1,23 @@ +{ + "mode": "test", + "expect": { + "exit": 7, + "output": [ + "^PASS RegressionTests.Shell_WindowStyle9_Runs$", + "^PASS RegressionTests.MsgBox_HelpFileAndContext_ShowsBox$", + "^PASS RegressionTests.AppActivate_VisibleWindow_Activates$", + "^FAIL RegressionTests.Shell_WindowStyle10_Raises5: .*Actual: 0 ", + "^FAIL RegressionTests.InputBox_XPos32768_Raises6: .*Actual: 0 ", + "^FAIL RegressionTests.InputBox_YPosMinus32769_Raises6: .*Actual: 0 ", + "^FAIL RegressionTests.MsgBox_ContextWithoutHelpFile_Raises5: .*Actual: 0 ", + "^FAIL RegressionTests.InputBox_ContextWithoutHelpFile_Raises5: .*Actual: 0 ", + "^FAIL RegressionTests.MsgBox_HelpFileNull_Raises5: .*Actual: 94 ", + "^FAIL RegressionTests.InputBox_HelpFileNull_Raises5: .*Actual: 94 ", + "^FAIL RegressionTests.AppActivate_HiddenWindow_Raises5: .*Actual: 0 ", + "^FAIL RegressionTests.AppActivate_WaitNull_Raises94: .*Actual: 0 ", + "^FAIL RegressionTests.AppActivate_WaitString_Raises13: .*Actual: 0 ", + "^FAIL RegressionTests.MsgBox_ButtonGroup7_Raises5: .*Actual: 0 ", + "^FAIL RegressionTests.MsgBox_StyleMinus1_Raises5: .*Actual: 1002 " + ] + } +} diff --git a/bugs/interaction-missing-argument-checks/src/Settings b/bugs/interaction-missing-argument-checks/src/Settings new file mode 100644 index 00000000..f5be4b61 --- /dev/null +++ b/bugs/interaction-missing-argument-checks/src/Settings @@ -0,0 +1,75 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "InteractionMissingArgumentChecks", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: Interactive procedures accept arguments VB6 and VBA refuse, and MsgBox shows no box for a style Windows refuses", + "project.exportPathIsV2": true, + "project.id": "{6276EDA6-505F-4329-BD9F-1597B1BA553E}", + "project.name": "InteractionMissingArgumentChecks", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + }, + { + "id": "{9847A10D-8987-44B2-8B87-EA77DEF7F1D9}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] Assert", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "Assert", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 24 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/interaction-missing-argument-checks/src/Sources/RegressionTests.twin b/bugs/interaction-missing-argument-checks/src/Sources/RegressionTests.twin new file mode 100644 index 00000000..1c77f7d6 --- /dev/null +++ b/bugs/interaction-missing-argument-checks/src/Sources/RegressionTests.twin @@ -0,0 +1,559 @@ +' Regression tests: AppActivate, InputBox, MsgBox and Shell refuse the arguments VB6 and 64-bit +' VBA refuse, with the numbers they raise (the VB6 project beside this one prints them), and +' MsgBox raises 5 for a style Windows refuses, where it now shows no box and returns 0. +' The dialog harness answers every box a case shows, so no case waits for a person, and no +' box can open on another desktop. tbrun --tests runs each case and prints PASS or FAIL. +[TestFixture] +Module RegressionTests + ' ---- copies of errors/harnesses/dialog.bas and window.bas (twinBASIC documentation): the + ' dialog harness answers each box MsgBox or InputBox shows, and the window harness makes a + ' window to activate. Their declarations first, then their procedures. + ' The dialog harness, for twinBASIC, VB6 and VBA alike: a case that calls MsgBox or InputBox + ' runs with the box answered as soon as it is shown, so the real MessageBox and the real + ' dialog run, and what they refuse is what the probe measures. dialog_Begin installs a WH_CBT + ' hook on the probe's own thread: each top-level #32770 window the thread creates is noted, and + ' when it is activated the hook hides it and sends it WM_COMMAND from a button, as a click + ' does: Cancel (2) when it has a Cancel button, else its first push button that is not Help + ' (9). It is sent, not posted: in Access a posted WM_COMMAND never reaches the box. Nor is the + ' box ended with EndDialog, which skips the dialog procedure: twinBASIC's InputBox then + ' returns a string it never set, and faults in OLEAUT32 (BETA 1010). Windows the hook did + ' not see created (Access's own) are left alone. Each box answered is counted, with its + ' title, its text and the button, for dialog_Expect. + ' A style with MB_SERVICE_NOTIFICATION (&H200000), its NT 3.x form (&H40000) or + ' MB_DEFAULT_DESKTOP_ONLY (&H20000) puts a message box on the user's desktop, where no thread + ' hook sees it. So dialog_Begin also patches MessageBoxIndirectA and MessageBoxIndirectW, the + ' ones the runtimes call (twinBASIC the W form, VB6 and VBA the A form), with a guard that + ' refuses such a style, and passes any other to the real function (its bytes put back for the + ' call); the six other MessageBox entry points, which no runtime calls, are refused whatever + ' the style. dialog_End raises 1002 when the guard refused a box, so such a case never passes. + ' dialog_End puts the bytes back and removes the hook. VBA7 is true in twinBASIC and in VBA 7; + ' VB6 compiles only the #Else branches, so they hold what it cannot parse. + + #If VBA7 Then + Private Declare PtrSafe Function dialog_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As LongPtr + Private Declare PtrSafe Function dialog_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As LongPtr, ByVal Name As String) As LongPtr + Private Declare PtrSafe Function dialog_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As LongPtr, ByVal S As LongPtr, ByVal P As Long, ByRef Old As Long) As Long + Private Declare PtrSafe Sub dialog_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As LongPtr) + Private Declare PtrSafe Sub dialog_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) + Private Declare PtrSafe Function dialog_GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Long + Private Declare PtrSafe Function dialog_SetWindowsHookExA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr + Private Declare PtrSafe Function dialog_UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal H As LongPtr) As Long + Private Declare PtrSafe Function dialog_CallNextHookEx Lib "user32" Alias "CallNextHookEx" (ByVal H As LongPtr, ByVal Code As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr + Private Declare PtrSafe Function dialog_GetClassNameA Lib "user32" Alias "GetClassNameA" (ByVal H As LongPtr, ByVal S As String, ByVal N As Long) As Long + Private Declare PtrSafe Function dialog_GetWindowTextA Lib "user32" Alias "GetWindowTextA" (ByVal H As LongPtr, ByVal S As String, ByVal N As Long) As Long + Private Declare PtrSafe Function dialog_GetDlgItem Lib "user32" Alias "GetDlgItem" (ByVal H As LongPtr, ByVal Id As Long) As LongPtr + Private Declare PtrSafe Function dialog_GetDlgCtrlID Lib "user32" Alias "GetDlgCtrlID" (ByVal H As LongPtr) As Long + Private Declare PtrSafe Function dialog_GetWindow Lib "user32" Alias "GetWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As LongPtr + Private Declare PtrSafe Function dialog_GetWindowLongA Lib "user32" Alias "GetWindowLongA" (ByVal H As LongPtr, ByVal I As Long) As Long + Private Declare PtrSafe Function dialog_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As Long + Private Declare PtrSafe Function dialog_SendMessageA Lib "user32" Alias "SendMessageA" (ByVal H As LongPtr, ByVal M As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr + Private Declare PtrSafe Function dialog_RealIndirectA Lib "user32" Alias "MessageBoxIndirectA" (ByVal P As LongPtr) As Long + Private Declare PtrSafe Function dialog_RealIndirectW Lib "user32" Alias "MessageBoxIndirectW" (ByVal P As LongPtr) As Long + #Else + Private Declare Function dialog_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As Long + Private Declare Function dialog_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As Long, ByVal Name As String) As Long + Private Declare Function dialog_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As Long, ByVal S As Long, ByVal P As Long, ByRef Old As Long) As Long + Private Declare Sub dialog_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As Long) + Private Declare Sub dialog_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) + Private Declare Function dialog_GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Long + Private Declare Function dialog_SetWindowsHookExA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long + Private Declare Function dialog_UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal H As Long) As Long + Private Declare Function dialog_CallNextHookEx Lib "user32" Alias "CallNextHookEx" (ByVal H As Long, ByVal Code As Long, ByVal W As Long, ByVal L As Long) As Long + Private Declare Function dialog_GetClassNameA Lib "user32" Alias "GetClassNameA" (ByVal H As Long, ByVal S As String, ByVal N As Long) As Long + Private Declare Function dialog_GetWindowTextA Lib "user32" Alias "GetWindowTextA" (ByVal H As Long, ByVal S As String, ByVal N As Long) As Long + Private Declare Function dialog_GetDlgItem Lib "user32" Alias "GetDlgItem" (ByVal H As Long, ByVal Id As Long) As Long + Private Declare Function dialog_GetDlgCtrlID Lib "user32" Alias "GetDlgCtrlID" (ByVal H As Long) As Long + Private Declare Function dialog_GetWindow Lib "user32" Alias "GetWindow" (ByVal H As Long, ByVal Cmd As Long) As Long + Private Declare Function dialog_GetWindowLongA Lib "user32" Alias "GetWindowLongA" (ByVal H As Long, ByVal I As Long) As Long + Private Declare Function dialog_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As Long, ByVal Cmd As Long) As Long + Private Declare Function dialog_SendMessageA Lib "user32" Alias "SendMessageA" (ByVal H As Long, ByVal M As Long, ByVal W As Long, ByVal L As Long) As Long + Private Declare Function dialog_RealIndirectA Lib "user32" Alias "MessageBoxIndirectA" (ByVal P As Long) As Long + Private Declare Function dialog_RealIndirectW Lib "user32" Alias "MessageBoxIndirectW" (ByVal P As Long) As Long + #End If + + ' Each address and window is kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. + ' Targets 0 and 1 are MessageBoxIndirectA and W, the guarded ones; 2 to 7 are refused. + Private dialog_Targets(7) As Variant + Private dialog_Saved(95) As Byte + Private dialog_Hook As Variant + Private dialog_Noted(7) As Variant + Private dialog_Guarded As Long + ' The boxes answered, and the last one's title, text and button. + Private dialog_Count As Long + Private dialog_Title As String + Private dialog_Text As String + Private dialog_Button As Long + ' The style the last MessageBoxIndirect call was given. + Private dialog_Style As Long + + ' The window harness, for twinBASIC, VB6 and VBA alike: a case that calls AppActivate has a + ' window to activate. window_Begin creates a visible top-level window of the probe's own + ' thread, titled window_Title (tbdocsErrorsProbe and the process id, so that runtimes run at + ' once never share one), and window_End destroys it. window_Pid is the probe's process id, + ' the task id Shell would return for it; window_Hide hides the window for a case. The real + ' activation runs: on the private desktop the window never becomes the foreground one, and + ' AppActivate raises nothing for that in any runtime (BETA 1010), so nothing is patched. + ' VBA7 is true in twinBASIC and in VBA 7; VB6 compiles only the #Else branch. + + #If VBA7 Then + Private Declare PtrSafe Function window_CreateWindowExA Lib "user32" Alias "CreateWindowExA" (ByVal Ex As Long, ByVal Cls As String, ByVal Title As String, ByVal Style As Long, ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long, ByVal Parent As LongPtr, ByVal Menu As LongPtr, ByVal Inst As LongPtr, ByVal P As LongPtr) As LongPtr + Private Declare PtrSafe Function window_DestroyWindow Lib "user32" Alias "DestroyWindow" (ByVal H As LongPtr) As Long + Private Declare PtrSafe Function window_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As Long + Private Declare PtrSafe Function window_IsWindowVisible Lib "user32" Alias "IsWindowVisible" (ByVal H As LongPtr) As Long + Private Declare PtrSafe Function window_IsIconic Lib "user32" Alias "IsIconic" (ByVal H As LongPtr) As Long + Private Declare PtrSafe Function window_GetCurrentProcessId Lib "kernel32" Alias "GetCurrentProcessId" () As Long + #Else + Private Declare Function window_CreateWindowExA Lib "user32" Alias "CreateWindowExA" (ByVal Ex As Long, ByVal Cls As String, ByVal Title As String, ByVal Style As Long, ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long, ByVal Parent As Long, ByVal Menu As Long, ByVal Inst As Long, ByVal P As Long) As Long + Private Declare Function window_DestroyWindow Lib "user32" Alias "DestroyWindow" (ByVal H As Long) As Long + Private Declare Function window_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As Long, ByVal Cmd As Long) As Long + Private Declare Function window_IsWindowVisible Lib "user32" Alias "IsWindowVisible" (ByVal H As Long) As Long + Private Declare Function window_IsIconic Lib "user32" Alias "IsIconic" (ByVal H As Long) As Long + Private Declare Function window_GetCurrentProcessId Lib "kernel32" Alias "GetCurrentProcessId" () As Long + #End If + + ' The window, kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. + Private window_Handle As Variant + + Private Function dialog_WindowText(ByVal H As Variant) As String + Dim S As String, N As Long + S = String$(1024, 0) + N = dialog_GetWindowTextA(H, S, 1024) + dialog_WindowText = Left$(S, N) + End Function + + ' Notes a top-level window of class #32770 that the thread creates. + Private Sub dialog_Created(ByVal H As Variant, ByVal Style As Long) + Dim S As String, N As Long, I As Long + If (Style And &H40000000) <> 0 Then Exit Sub + S = String$(64, 0) + N = dialog_GetClassNameA(H, S, 64) + If Left$(S, N) <> "#32770" Then Exit Sub + For I = 0 To 7 + If IsEmpty(dialog_Noted(I)) Then + dialog_Noted(I) = H + Exit Sub + End If + Next + End Sub + + ' Answers a noted window as it is activated: hides it, then ends it as the button. + Private Sub dialog_Activated(ByVal H As Variant) + Dim I As Long, C As Variant, Id As Long, T As Long + For I = 0 To 7 + If Not IsEmpty(dialog_Noted(I)) Then + If dialog_Noted(I) = H Then Exit For + End If + Next + If I > 7 Then Exit Sub + dialog_Noted(I) = Empty + If dialog_GetDlgItem(H, 2) <> 0 Then + Id = 2 + Else + C = dialog_GetWindow(H, 5) + Do While C <> 0 + T = dialog_GetWindowLongA(C, -16) And &HF& + If dialog_GetDlgCtrlID(C) <> 9 And (T = 0 Or T = 1) Then + If dialog_ClassOf(C) = "Button" Then + Id = dialog_GetDlgCtrlID(C) + Exit Do + End If + End If + C = dialog_GetWindow(C, 2) + Loop + End If + dialog_Count = dialog_Count + 1 + dialog_Title = dialog_WindowText(H) + C = dialog_GetDlgItem(H, 65535) + If C <> 0 Then dialog_Text = dialog_WindowText(C) Else dialog_Text = "" + dialog_Button = Id + dialog_ShowWindow H, 0 + dialog_SendMessageA H, &H111, Id, dialog_GetDlgItem(H, Id) + End Sub + + Private Function dialog_ClassOf(ByVal H As Variant) As String + Dim S As String, N As Long + S = String$(64, 0) + N = dialog_GetClassNameA(H, S, 64) + dialog_ClassOf = Left$(S, N) + End Function + + ' A style the guard refuses: one that shows the box on another desktop. + Private Function dialog_Refused(ByVal Style As Long) As Boolean + dialog_Style = Style + If (Style And &H260000) = 0 Then Exit Function + dialog_Guarded = dialog_Guarded + 1 + dialog_SetLastError 87 + dialog_Refused = True + End Function + + ' The six MessageBox entry points no runtime calls: refused, whatever the style. + Private Function dialog_Box4(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long) As Long + dialog_Refused &H200000 + End Function + Private Function dialog_Box5(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long, ByVal E As Long) As Long + dialog_Refused &H200000 + End Function + Private Function dialog_Box6(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long, ByVal E As Long, ByVal F As Long) As Long + dialog_Refused &H200000 + End Function + + #If VBA7 Then + Private Function dialog_Address(ByVal A As LongPtr) As Variant + dialog_Address = A + End Function + + Private Function dialog_Cbt(ByVal Code As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr + Dim Cs As LongPtr, Style As Long + If Code = 3 Then + dialog_CopyMemory Cs, ByVal L, LenB(Cs) + dialog_CopyMemory Style, ByVal Cs + 4 * LenB(Cs) + 16, 4 + dialog_Created W, Style + ElseIf Code = 5 Then + dialog_Activated W + End If + dialog_Cbt = dialog_CallNextHookEx(0, Code, W, L) + End Function + + ' MSGBOXPARAMS: cbSize, then hwndOwner, hInstance, lpszText and lpszCaption, then dwStyle. + Private Function dialog_GuardA(ByVal P As LongPtr) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 4 * LenB(P) + LenB(P), 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 0, False + dialog_GuardA = dialog_RealIndirectA(P) + dialog_Put 0, True + End Function + + Private Function dialog_GuardW(ByVal P As LongPtr) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 4 * LenB(P) + LenB(P), 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 1, False + dialog_GuardW = dialog_RealIndirectW(P) + dialog_Put 1, True + End Function + #Else + Private Function dialog_Address(ByVal A As Long) As Variant + dialog_Address = A + End Function + + Private Function dialog_Cbt(ByVal Code As Long, ByVal W As Long, ByVal L As Long) As Long + Dim Cs As Long, Style As Long + If Code = 3 Then + dialog_CopyMemory Cs, ByVal L, 4 + dialog_CopyMemory Style, ByVal Cs + 32, 4 + dialog_Created W, Style + ElseIf Code = 5 Then + dialog_Activated W + End If + dialog_Cbt = dialog_CallNextHookEx(0, Code, W, L) + End Function + + Private Function dialog_GuardA(ByVal P As Long) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 20, 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 0, False + dialog_GuardA = dialog_RealIndirectA(P) + dialog_Put 0, True + End Function + + Private Function dialog_GuardW(ByVal P As Long) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 20, 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 1, False + dialog_GuardW = dialog_RealIndirectW(P) + dialog_Put 1, True + End Function + #End If + + ' Writes target I's jump (On) or its original bytes back (not On). + Private Sub dialog_Put(ByVal I As Long, ByVal IsOn As Boolean) + Static Jumps(95) As Byte + Dim N As Long, Old As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If IsEmpty(dialog_Targets(I)) Then Exit Sub + P = dialog_Targets(I) + If IsOn Then + dialog_CopyMemory ByVal P, Jumps(I * 12), N + Else + dialog_CopyMemory Jumps(I * 12), ByVal P, N + dialog_CopyMemory ByVal P, dialog_Saved(I * 12), N + End If + End Sub + + ' The jump to Fn: mov eax, Fn; jmp eax, or in 64-bit code mov rax, Fn; jmp rax. + Private Sub dialog_Patch(ByVal I As Long, ByVal Name As String, ByVal Fn As Variant) + Dim B(11) As Byte, N As Long, Old As Long, Target As Variant + Target = dialog_GetProcAddress(dialog_GetModuleHandleA("user32"), Name) + If Target = 0 Then Exit Sub + #If Win64 Then + Dim F As LongPtr, P As LongPtr + F = Fn + B(0) = &H48: B(1) = &HB8 + dialog_CopyMemory B(2), F, 8 + B(10) = &HFF: B(11) = &HE0 + N = 12 + #Else + Dim F As Long, P As Long + F = Fn + B(0) = &HB8 + dialog_CopyMemory B(1), F, 4 + B(5) = &HFF: B(6) = &HE0 + N = 7 + #End If + P = Target + dialog_VirtualProtect P, N, &H40, Old + dialog_CopyMemory dialog_Saved(I * 12), ByVal P, N + dialog_CopyMemory ByVal P, B(0), N + dialog_Targets(I) = Target + End Sub + + Private Sub dialog_Begin() + Dim I As Long + dialog_Count = 0 + dialog_Guarded = 0 + dialog_Title = "" + dialog_Text = "" + dialog_Button = 0 + dialog_Style = 0 + For I = 0 To 7 + dialog_Noted(I) = Empty + dialog_Targets(I) = Empty + Next + dialog_Patch 0, "MessageBoxIndirectA", dialog_Address(AddressOf dialog_GuardA) + dialog_Patch 1, "MessageBoxIndirectW", dialog_Address(AddressOf dialog_GuardW) + dialog_Patch 2, "MessageBoxA", dialog_Address(AddressOf dialog_Box4) + dialog_Patch 3, "MessageBoxW", dialog_Address(AddressOf dialog_Box4) + dialog_Patch 4, "MessageBoxExA", dialog_Address(AddressOf dialog_Box5) + dialog_Patch 5, "MessageBoxExW", dialog_Address(AddressOf dialog_Box5) + dialog_Patch 6, "MessageBoxTimeoutA", dialog_Address(AddressOf dialog_Box6) + dialog_Patch 7, "MessageBoxTimeoutW", dialog_Address(AddressOf dialog_Box6) + dialog_Hook = dialog_SetWindowsHookExA(5, dialog_Address(AddressOf dialog_Cbt), 0, dialog_GetCurrentThreadId()) + End Sub + + Private Sub dialog_End() + Dim I As Long, N As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If dialog_Hook <> 0 Then dialog_UnhookWindowsHookEx dialog_Hook + dialog_Hook = 0 + For I = 7 To 0 Step -1 + If Not IsEmpty(dialog_Targets(I)) Then + P = dialog_Targets(I) + dialog_CopyMemory ByVal P, dialog_Saved(I * 12), N + dialog_Targets(I) = Empty + End If + Next + If dialog_Guarded <> 0 Then Err.Raise 1002, , "the guard refused a box for another desktop" + End Sub + + ' Raises 1001 when the case did not show Count boxes. Does nothing when it has already raised. + Private Sub dialog_Expect(ByVal Count As Long) + If Err.Number <> 0 Then Exit Sub + If dialog_Count <> Count Then Err.Raise 1001, , dialog_Count & " boxes shown, not " & Count + End Sub + Private Function window_Title() As String + window_Title = "tbdocsErrorsProbe" & window_GetCurrentProcessId() + End Function + + Private Function window_Pid() As Long + window_Pid = window_GetCurrentProcessId() + End Function + + ' Whether the window is visible now, and whether it is minimized. + Private Function window_Visible() As Boolean + window_Visible = window_IsWindowVisible(window_Handle) <> 0 + End Function + + Private Function window_Minimized() As Boolean + window_Minimized = window_IsIconic(window_Handle) <> 0 + End Function + + Private Sub window_Hide() + window_ShowWindow window_Handle, 0 + End Sub + + ' SW_SHOWMINNOACTIVE: minimized, not activated. + Private Sub window_Minimize() + window_ShowWindow window_Handle, 7 + End Sub + + ' A STATIC window, WS_OVERLAPPEDWINDOW, shown without being activated (SW_SHOWNA): created + ' with WS_VISIBLE, which activates it, it takes 2 s to create from the third case on in + ' twinBASIC (BETA 1010). + Private Sub window_Begin() + window_Handle = window_CreateWindowExA(0, "STATIC", window_Title(), &HCF0000, 0, 0, 300, 100, 0, 0, 0, 0) + window_ShowWindow window_Handle, 8 + End Sub + + Private Sub window_End() + If window_Handle <> 0 Then window_DestroyWindow window_Handle + window_Handle = 0 + End Sub + + ' A control: twinBASIC already does this. + [TestCase] + Public Sub Shell_WindowStyle9_Runs() + Dim V As Variant + On Error Resume Next + V = Shell("cmd.exe /c exit", 9) + Assert.Strict.AreEqual 0&, Err.Number + End Sub + + ' A control: twinBASIC already does this. + [TestCase] + Public Sub MsgBox_HelpFileAndContext_ShowsBox() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", , , "help.hlp", 5) + dialog_End + Assert.Strict.AreEqual 0&, Err.Number + End Sub + + ' A control: twinBASIC already does this. + [TestCase] + Public Sub AppActivate_VisibleWindow_Activates() + Dim V As Variant + On Error Resume Next + window_Begin + AppActivate window_Title() + window_End + Assert.Strict.AreEqual 0&, Err.Number + End Sub + + [TestCase] + Public Sub Shell_WindowStyle10_Raises5() + Dim V As Variant + On Error Resume Next + V = Shell("cmd.exe /c exit", 10) + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_XPos32768_Raises6() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = InputBox("x", , , 32768, 0) + dialog_End + Assert.Strict.AreEqual 6&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_YPosMinus32769_Raises6() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = InputBox("x", , , 0, -32769) + dialog_End + Assert.Strict.AreEqual 6&, Err.Number + End Sub + + [TestCase] + Public Sub MsgBox_ContextWithoutHelpFile_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", , , , 5) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_ContextWithoutHelpFile_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = InputBox("x", , , , , , 5) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub MsgBox_HelpFileNull_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", 0, "t", Null) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub InputBox_HelpFileNull_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = InputBox("x", , , , , Null) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub AppActivate_HiddenWindow_Raises5() + Dim V As Variant + On Error Resume Next + window_Begin + window_Hide + AppActivate window_Title() + window_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + [TestCase] + Public Sub AppActivate_WaitNull_Raises94() + Dim V As Variant + On Error Resume Next + window_Begin + AppActivate window_Title(), Null + window_End + Assert.Strict.AreEqual 94&, Err.Number + End Sub + + [TestCase] + Public Sub AppActivate_WaitString_Raises13() + Dim V As Variant + On Error Resume Next + window_Begin + AppActivate window_Title(), "x" + window_End + Assert.Strict.AreEqual 13&, Err.Number + End Sub + + [TestCase] + Public Sub MsgBox_ButtonGroup7_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", 7) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + + ' -1 has MB_SERVICE_NOTIFICATION too, which twinBASIC passes to Windows: the dialog + ' harness refuses that call, so the case reports 1002 until twinBASIC raises 5 first. + [TestCase] + Public Sub MsgBox_StyleMinus1_Raises5() + Dim V As Variant + On Error Resume Next + dialog_Begin + V = MsgBox("x", -1) + dialog_End + Assert.Strict.AreEqual 5&, Err.Number + End Sub + +End Module diff --git a/bugs/interaction-missing-argument-checks/src/Sources/Startup.twin b/bugs/interaction-missing-argument-checks/src/Sources/Startup.twin new file mode 100644 index 00000000..be8f5c8b --- /dev/null +++ b/bugs/interaction-missing-argument-checks/src/Sources/Startup.twin @@ -0,0 +1,6 @@ +Module Startup + + Public Sub Main() + End Sub + +End Module diff --git a/bugs/interaction-missing-argument-checks/vb6/Module1.bas b/bugs/interaction-missing-argument-checks/vb6/Module1.bas new file mode 100644 index 00000000..cb113500 --- /dev/null +++ b/bugs/interaction-missing-argument-checks/vb6/Module1.bas @@ -0,0 +1,503 @@ +Attribute VB_Name = "Module1" +Option Explicit + +' What VB6 does for each case of the twinBASIC test cases, in the same order: the error it +' raises, and how many boxes it showed. Build and run it with: +' node scripts/bug_repro.mjs vb6 interaction-missing-argument-checks +' ---- copies of errors/harnesses/dialog.bas and window.bas (twinBASIC documentation): the +' dialog harness answers each box MsgBox or InputBox shows, and the window harness makes a +' window to activate. Their declarations first, then their procedures. +' The dialog harness, for twinBASIC, VB6 and VBA alike: a case that calls MsgBox or InputBox +' runs with the box answered as soon as it is shown, so the real MessageBox and the real +' dialog run, and what they refuse is what the probe measures. dialog_Begin installs a WH_CBT +' hook on the probe's own thread: each top-level #32770 window the thread creates is noted, and +' when it is activated the hook hides it and sends it WM_COMMAND from a button, as a click +' does: Cancel (2) when it has a Cancel button, else its first push button that is not Help +' (9). It is sent, not posted: in Access a posted WM_COMMAND never reaches the box. Nor is the +' box ended with EndDialog, which skips the dialog procedure: twinBASIC's InputBox then +' returns a string it never set, and faults in OLEAUT32 (BETA 1010). Windows the hook did +' not see created (Access's own) are left alone. Each box answered is counted, with its +' title, its text and the button, for dialog_Expect. +' A style with MB_SERVICE_NOTIFICATION (&H200000), its NT 3.x form (&H40000) or +' MB_DEFAULT_DESKTOP_ONLY (&H20000) puts a message box on the user's desktop, where no thread +' hook sees it. So dialog_Begin also patches MessageBoxIndirectA and MessageBoxIndirectW, the +' ones the runtimes call (twinBASIC the W form, VB6 and VBA the A form), with a guard that +' refuses such a style, and passes any other to the real function (its bytes put back for the +' call); the six other MessageBox entry points, which no runtime calls, are refused whatever +' the style. dialog_End raises 1002 when the guard refused a box, so such a case never passes. +' dialog_End puts the bytes back and removes the hook. VBA7 is true in twinBASIC and in VBA 7; +' VB6 compiles only the #Else branches, so they hold what it cannot parse. + +#If VBA7 Then +Private Declare PtrSafe Function dialog_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As LongPtr +Private Declare PtrSafe Function dialog_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As LongPtr, ByVal Name As String) As LongPtr +Private Declare PtrSafe Function dialog_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As LongPtr, ByVal S As LongPtr, ByVal P As Long, ByRef Old As Long) As Long +Private Declare PtrSafe Sub dialog_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As LongPtr) +Private Declare PtrSafe Sub dialog_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare PtrSafe Function dialog_GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Long +Private Declare PtrSafe Function dialog_SetWindowsHookExA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr +Private Declare PtrSafe Function dialog_UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function dialog_CallNextHookEx Lib "user32" Alias "CallNextHookEx" (ByVal H As LongPtr, ByVal Code As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr +Private Declare PtrSafe Function dialog_GetClassNameA Lib "user32" Alias "GetClassNameA" (ByVal H As LongPtr, ByVal S As String, ByVal N As Long) As Long +Private Declare PtrSafe Function dialog_GetWindowTextA Lib "user32" Alias "GetWindowTextA" (ByVal H As LongPtr, ByVal S As String, ByVal N As Long) As Long +Private Declare PtrSafe Function dialog_GetDlgItem Lib "user32" Alias "GetDlgItem" (ByVal H As LongPtr, ByVal Id As Long) As LongPtr +Private Declare PtrSafe Function dialog_GetDlgCtrlID Lib "user32" Alias "GetDlgCtrlID" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function dialog_GetWindow Lib "user32" Alias "GetWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As LongPtr +Private Declare PtrSafe Function dialog_GetWindowLongA Lib "user32" Alias "GetWindowLongA" (ByVal H As LongPtr, ByVal I As Long) As Long +Private Declare PtrSafe Function dialog_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As Long +Private Declare PtrSafe Function dialog_SendMessageA Lib "user32" Alias "SendMessageA" (ByVal H As LongPtr, ByVal M As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr +Private Declare PtrSafe Function dialog_RealIndirectA Lib "user32" Alias "MessageBoxIndirectA" (ByVal P As LongPtr) As Long +Private Declare PtrSafe Function dialog_RealIndirectW Lib "user32" Alias "MessageBoxIndirectW" (ByVal P As LongPtr) As Long +#Else +Private Declare Function dialog_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As Long +Private Declare Function dialog_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As Long, ByVal Name As String) As Long +Private Declare Function dialog_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As Long, ByVal S As Long, ByVal P As Long, ByRef Old As Long) As Long +Private Declare Sub dialog_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As Long) +Private Declare Sub dialog_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare Function dialog_GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Long +Private Declare Function dialog_SetWindowsHookExA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long +Private Declare Function dialog_UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal H As Long) As Long +Private Declare Function dialog_CallNextHookEx Lib "user32" Alias "CallNextHookEx" (ByVal H As Long, ByVal Code As Long, ByVal W As Long, ByVal L As Long) As Long +Private Declare Function dialog_GetClassNameA Lib "user32" Alias "GetClassNameA" (ByVal H As Long, ByVal S As String, ByVal N As Long) As Long +Private Declare Function dialog_GetWindowTextA Lib "user32" Alias "GetWindowTextA" (ByVal H As Long, ByVal S As String, ByVal N As Long) As Long +Private Declare Function dialog_GetDlgItem Lib "user32" Alias "GetDlgItem" (ByVal H As Long, ByVal Id As Long) As Long +Private Declare Function dialog_GetDlgCtrlID Lib "user32" Alias "GetDlgCtrlID" (ByVal H As Long) As Long +Private Declare Function dialog_GetWindow Lib "user32" Alias "GetWindow" (ByVal H As Long, ByVal Cmd As Long) As Long +Private Declare Function dialog_GetWindowLongA Lib "user32" Alias "GetWindowLongA" (ByVal H As Long, ByVal I As Long) As Long +Private Declare Function dialog_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As Long, ByVal Cmd As Long) As Long +Private Declare Function dialog_SendMessageA Lib "user32" Alias "SendMessageA" (ByVal H As Long, ByVal M As Long, ByVal W As Long, ByVal L As Long) As Long +Private Declare Function dialog_RealIndirectA Lib "user32" Alias "MessageBoxIndirectA" (ByVal P As Long) As Long +Private Declare Function dialog_RealIndirectW Lib "user32" Alias "MessageBoxIndirectW" (ByVal P As Long) As Long +#End If + +' Each address and window is kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. +' Targets 0 and 1 are MessageBoxIndirectA and W, the guarded ones; 2 to 7 are refused. +Private dialog_Targets(7) As Variant +Private dialog_Saved(95) As Byte +Private dialog_Hook As Variant +Private dialog_Noted(7) As Variant +Private dialog_Guarded As Long +' The boxes answered, and the last one's title, text and button. +Private dialog_Count As Long +Private dialog_Title As String +Private dialog_Text As String +Private dialog_Button As Long +' The style the last MessageBoxIndirect call was given. +Private dialog_Style As Long + +' The window harness, for twinBASIC, VB6 and VBA alike: a case that calls AppActivate has a +' window to activate. window_Begin creates a visible top-level window of the probe's own +' thread, titled window_Title (tbdocsErrorsProbe and the process id, so that runtimes run at +' once never share one), and window_End destroys it. window_Pid is the probe's process id, +' the task id Shell would return for it; window_Hide hides the window for a case. The real +' activation runs: on the private desktop the window never becomes the foreground one, and +' AppActivate raises nothing for that in any runtime (BETA 1010), so nothing is patched. +' VBA7 is true in twinBASIC and in VBA 7; VB6 compiles only the #Else branch. + +#If VBA7 Then +Private Declare PtrSafe Function window_CreateWindowExA Lib "user32" Alias "CreateWindowExA" (ByVal Ex As Long, ByVal Cls As String, ByVal Title As String, ByVal Style As Long, ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long, ByVal Parent As LongPtr, ByVal Menu As LongPtr, ByVal Inst As LongPtr, ByVal P As LongPtr) As LongPtr +Private Declare PtrSafe Function window_DestroyWindow Lib "user32" Alias "DestroyWindow" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function window_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As Long +Private Declare PtrSafe Function window_IsWindowVisible Lib "user32" Alias "IsWindowVisible" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function window_IsIconic Lib "user32" Alias "IsIconic" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function window_GetCurrentProcessId Lib "kernel32" Alias "GetCurrentProcessId" () As Long +#Else +Private Declare Function window_CreateWindowExA Lib "user32" Alias "CreateWindowExA" (ByVal Ex As Long, ByVal Cls As String, ByVal Title As String, ByVal Style As Long, ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long, ByVal Parent As Long, ByVal Menu As Long, ByVal Inst As Long, ByVal P As Long) As Long +Private Declare Function window_DestroyWindow Lib "user32" Alias "DestroyWindow" (ByVal H As Long) As Long +Private Declare Function window_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As Long, ByVal Cmd As Long) As Long +Private Declare Function window_IsWindowVisible Lib "user32" Alias "IsWindowVisible" (ByVal H As Long) As Long +Private Declare Function window_IsIconic Lib "user32" Alias "IsIconic" (ByVal H As Long) As Long +Private Declare Function window_GetCurrentProcessId Lib "kernel32" Alias "GetCurrentProcessId" () As Long +#End If + +' The window, kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. +Private window_Handle As Variant + +Private Function dialog_WindowText(ByVal H As Variant) As String + Dim S As String, N As Long + S = String$(1024, 0) + N = dialog_GetWindowTextA(H, S, 1024) + dialog_WindowText = Left$(S, N) +End Function + +' Notes a top-level window of class #32770 that the thread creates. +Private Sub dialog_Created(ByVal H As Variant, ByVal Style As Long) + Dim S As String, N As Long, I As Long + If (Style And &H40000000) <> 0 Then Exit Sub + S = String$(64, 0) + N = dialog_GetClassNameA(H, S, 64) + If Left$(S, N) <> "#32770" Then Exit Sub + For I = 0 To 7 + If IsEmpty(dialog_Noted(I)) Then + dialog_Noted(I) = H + Exit Sub + End If + Next +End Sub + +' Answers a noted window as it is activated: hides it, then ends it as the button. +Private Sub dialog_Activated(ByVal H As Variant) + Dim I As Long, C As Variant, Id As Long, T As Long + For I = 0 To 7 + If Not IsEmpty(dialog_Noted(I)) Then + If dialog_Noted(I) = H Then Exit For + End If + Next + If I > 7 Then Exit Sub + dialog_Noted(I) = Empty + If dialog_GetDlgItem(H, 2) <> 0 Then + Id = 2 + Else + C = dialog_GetWindow(H, 5) + Do While C <> 0 + T = dialog_GetWindowLongA(C, -16) And &HF& + If dialog_GetDlgCtrlID(C) <> 9 And (T = 0 Or T = 1) Then + If dialog_ClassOf(C) = "Button" Then + Id = dialog_GetDlgCtrlID(C) + Exit Do + End If + End If + C = dialog_GetWindow(C, 2) + Loop + End If + dialog_Count = dialog_Count + 1 + dialog_Title = dialog_WindowText(H) + C = dialog_GetDlgItem(H, 65535) + If C <> 0 Then dialog_Text = dialog_WindowText(C) Else dialog_Text = "" + dialog_Button = Id + dialog_ShowWindow H, 0 + dialog_SendMessageA H, &H111, Id, dialog_GetDlgItem(H, Id) +End Sub + +Private Function dialog_ClassOf(ByVal H As Variant) As String + Dim S As String, N As Long + S = String$(64, 0) + N = dialog_GetClassNameA(H, S, 64) + dialog_ClassOf = Left$(S, N) +End Function + +' A style the guard refuses: one that shows the box on another desktop. +Private Function dialog_Refused(ByVal Style As Long) As Boolean + dialog_Style = Style + If (Style And &H260000) = 0 Then Exit Function + dialog_Guarded = dialog_Guarded + 1 + dialog_SetLastError 87 + dialog_Refused = True +End Function + +' The six MessageBox entry points no runtime calls: refused, whatever the style. +Private Function dialog_Box4(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long) As Long + dialog_Refused &H200000 +End Function +Private Function dialog_Box5(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long, ByVal E As Long) As Long + dialog_Refused &H200000 +End Function +Private Function dialog_Box6(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long, ByVal E As Long, ByVal F As Long) As Long + dialog_Refused &H200000 +End Function + +#If VBA7 Then +Private Function dialog_Address(ByVal A As LongPtr) As Variant + dialog_Address = A +End Function + +Private Function dialog_Cbt(ByVal Code As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr + Dim Cs As LongPtr, Style As Long + If Code = 3 Then + dialog_CopyMemory Cs, ByVal L, LenB(Cs) + dialog_CopyMemory Style, ByVal Cs + 4 * LenB(Cs) + 16, 4 + dialog_Created W, Style + ElseIf Code = 5 Then + dialog_Activated W + End If + dialog_Cbt = dialog_CallNextHookEx(0, Code, W, L) +End Function + +' MSGBOXPARAMS: cbSize, then hwndOwner, hInstance, lpszText and lpszCaption, then dwStyle. +Private Function dialog_GuardA(ByVal P As LongPtr) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 4 * LenB(P) + LenB(P), 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 0, False + dialog_GuardA = dialog_RealIndirectA(P) + dialog_Put 0, True +End Function + +Private Function dialog_GuardW(ByVal P As LongPtr) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 4 * LenB(P) + LenB(P), 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 1, False + dialog_GuardW = dialog_RealIndirectW(P) + dialog_Put 1, True +End Function +#Else +Private Function dialog_Address(ByVal A As Long) As Variant + dialog_Address = A +End Function + +Private Function dialog_Cbt(ByVal Code As Long, ByVal W As Long, ByVal L As Long) As Long + Dim Cs As Long, Style As Long + If Code = 3 Then + dialog_CopyMemory Cs, ByVal L, 4 + dialog_CopyMemory Style, ByVal Cs + 32, 4 + dialog_Created W, Style + ElseIf Code = 5 Then + dialog_Activated W + End If + dialog_Cbt = dialog_CallNextHookEx(0, Code, W, L) +End Function + +Private Function dialog_GuardA(ByVal P As Long) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 20, 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 0, False + dialog_GuardA = dialog_RealIndirectA(P) + dialog_Put 0, True +End Function + +Private Function dialog_GuardW(ByVal P As Long) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 20, 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 1, False + dialog_GuardW = dialog_RealIndirectW(P) + dialog_Put 1, True +End Function +#End If + +' Writes target I's jump (On) or its original bytes back (not On). +Private Sub dialog_Put(ByVal I As Long, ByVal IsOn As Boolean) + Static Jumps(95) As Byte + Dim N As Long, Old As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If IsEmpty(dialog_Targets(I)) Then Exit Sub + P = dialog_Targets(I) + If IsOn Then + dialog_CopyMemory ByVal P, Jumps(I * 12), N + Else + dialog_CopyMemory Jumps(I * 12), ByVal P, N + dialog_CopyMemory ByVal P, dialog_Saved(I * 12), N + End If +End Sub + +' The jump to Fn: mov eax, Fn; jmp eax, or in 64-bit code mov rax, Fn; jmp rax. +Private Sub dialog_Patch(ByVal I As Long, ByVal Name As String, ByVal Fn As Variant) + Dim B(11) As Byte, N As Long, Old As Long, Target As Variant + Target = dialog_GetProcAddress(dialog_GetModuleHandleA("user32"), Name) + If Target = 0 Then Exit Sub + #If Win64 Then + Dim F As LongPtr, P As LongPtr + F = Fn + B(0) = &H48: B(1) = &HB8 + dialog_CopyMemory B(2), F, 8 + B(10) = &HFF: B(11) = &HE0 + N = 12 + #Else + Dim F As Long, P As Long + F = Fn + B(0) = &HB8 + dialog_CopyMemory B(1), F, 4 + B(5) = &HFF: B(6) = &HE0 + N = 7 + #End If + P = Target + dialog_VirtualProtect P, N, &H40, Old + dialog_CopyMemory dialog_Saved(I * 12), ByVal P, N + dialog_CopyMemory ByVal P, B(0), N + dialog_Targets(I) = Target +End Sub + +Private Sub dialog_Begin() + Dim I As Long + dialog_Count = 0 + dialog_Guarded = 0 + dialog_Title = "" + dialog_Text = "" + dialog_Button = 0 + dialog_Style = 0 + For I = 0 To 7 + dialog_Noted(I) = Empty + dialog_Targets(I) = Empty + Next + dialog_Patch 0, "MessageBoxIndirectA", dialog_Address(AddressOf dialog_GuardA) + dialog_Patch 1, "MessageBoxIndirectW", dialog_Address(AddressOf dialog_GuardW) + dialog_Patch 2, "MessageBoxA", dialog_Address(AddressOf dialog_Box4) + dialog_Patch 3, "MessageBoxW", dialog_Address(AddressOf dialog_Box4) + dialog_Patch 4, "MessageBoxExA", dialog_Address(AddressOf dialog_Box5) + dialog_Patch 5, "MessageBoxExW", dialog_Address(AddressOf dialog_Box5) + dialog_Patch 6, "MessageBoxTimeoutA", dialog_Address(AddressOf dialog_Box6) + dialog_Patch 7, "MessageBoxTimeoutW", dialog_Address(AddressOf dialog_Box6) + dialog_Hook = dialog_SetWindowsHookExA(5, dialog_Address(AddressOf dialog_Cbt), 0, dialog_GetCurrentThreadId()) +End Sub + +Private Sub dialog_End() + Dim I As Long, N As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If dialog_Hook <> 0 Then dialog_UnhookWindowsHookEx dialog_Hook + dialog_Hook = 0 + For I = 7 To 0 Step -1 + If Not IsEmpty(dialog_Targets(I)) Then + P = dialog_Targets(I) + dialog_CopyMemory ByVal P, dialog_Saved(I * 12), N + dialog_Targets(I) = Empty + End If + Next + If dialog_Guarded <> 0 Then Err.Raise 1002, , "the guard refused a box for another desktop" +End Sub + +' Raises 1001 when the case did not show Count boxes. Does nothing when it has already raised. +Private Sub dialog_Expect(ByVal Count As Long) + If Err.Number <> 0 Then Exit Sub + If dialog_Count <> Count Then Err.Raise 1001, , dialog_Count & " boxes shown, not " & Count +End Sub +Private Function window_Title() As String + window_Title = "tbdocsErrorsProbe" & window_GetCurrentProcessId() +End Function + +Private Function window_Pid() As Long + window_Pid = window_GetCurrentProcessId() +End Function + +' Whether the window is visible now, and whether it is minimized. +Private Function window_Visible() As Boolean + window_Visible = window_IsWindowVisible(window_Handle) <> 0 +End Function + +Private Function window_Minimized() As Boolean + window_Minimized = window_IsIconic(window_Handle) <> 0 +End Function + +Private Sub window_Hide() + window_ShowWindow window_Handle, 0 +End Sub + +' SW_SHOWMINNOACTIVE: minimized, not activated. +Private Sub window_Minimize() + window_ShowWindow window_Handle, 7 +End Sub + +' A STATIC window, WS_OVERLAPPEDWINDOW, shown without being activated (SW_SHOWNA): created +' with WS_VISIBLE, which activates it, it takes 2 s to create from the third case on in +' twinBASIC (BETA 1010). +Private Sub window_Begin() + window_Handle = window_CreateWindowExA(0, "STATIC", window_Title(), &HCF0000, 0, 0, 300, 100, 0, 0, 0, 0) + window_ShowWindow window_Handle, 8 +End Sub + +Private Sub window_End() + If window_Handle <> 0 Then window_DestroyWindow window_Handle + window_Handle = 0 +End Sub + +Private Sub Report(ByVal Label As String, ByVal Returned As Variant) + Print #9, Label & ": " & Err.Number & " " & Err.Description & ", boxes " & dialog_Count & ", returned " & Returned + Err.Clear +End Sub + +Sub Main() + Dim V As Variant + Open App.Path & "\out.txt" For Output As #9 + On Error Resume Next + dialog_Count = 0 + V = Empty + V = Shell("cmd.exe /c exit", 9) + Report "Shell_WindowStyle9_Runs", V + dialog_Count = 0 + V = Empty + dialog_Begin + V = MsgBox("x", , , "help.hlp", 5) + dialog_End + Report "MsgBox_HelpFileAndContext_ShowsBox", V + dialog_Count = 0 + V = Empty + window_Begin + AppActivate window_Title() + window_End + Report "AppActivate_VisibleWindow_Activates", V + dialog_Count = 0 + V = Empty + V = Shell("cmd.exe /c exit", 10) + Report "Shell_WindowStyle10_Raises5", V + dialog_Count = 0 + V = Empty + dialog_Begin + V = InputBox("x", , , 32768, 0) + dialog_End + Report "InputBox_XPos32768_Raises6", V + dialog_Count = 0 + V = Empty + dialog_Begin + V = InputBox("x", , , 0, -32769) + dialog_End + Report "InputBox_YPosMinus32769_Raises6", V + dialog_Count = 0 + V = Empty + dialog_Begin + V = MsgBox("x", , , , 5) + dialog_End + Report "MsgBox_ContextWithoutHelpFile_Raises5", V + dialog_Count = 0 + V = Empty + dialog_Begin + V = InputBox("x", , , , , , 5) + dialog_End + Report "InputBox_ContextWithoutHelpFile_Raises5", V + dialog_Count = 0 + V = Empty + dialog_Begin + V = MsgBox("x", 0, "t", Null) + dialog_End + Report "MsgBox_HelpFileNull_Raises5", V + dialog_Count = 0 + V = Empty + dialog_Begin + V = InputBox("x", , , , , Null) + dialog_End + Report "InputBox_HelpFileNull_Raises5", V + dialog_Count = 0 + V = Empty + window_Begin + window_Hide + AppActivate window_Title() + window_End + Report "AppActivate_HiddenWindow_Raises5", V + dialog_Count = 0 + V = Empty + window_Begin + AppActivate window_Title(), Null + window_End + Report "AppActivate_WaitNull_Raises94", V + dialog_Count = 0 + V = Empty + window_Begin + AppActivate window_Title(), "x" + window_End + Report "AppActivate_WaitString_Raises13", V + dialog_Count = 0 + V = Empty + dialog_Begin + V = MsgBox("x", 7) + dialog_End + Report "MsgBox_ButtonGroup7_Raises5", V + dialog_Count = 0 + V = Empty + dialog_Begin + V = MsgBox("x", -1) + dialog_End + Report "MsgBox_StyleMinus1_Raises5", V + Close #9 +End Sub diff --git a/bugs/interaction-missing-argument-checks/vb6/Probe.vbp b/bugs/interaction-missing-argument-checks/vb6/Probe.vbp new file mode 100644 index 00000000..4d210b0e --- /dev/null +++ b/bugs/interaction-missing-argument-checks/vb6/Probe.vbp @@ -0,0 +1,7 @@ +Type=Exe +Module=Module1; Module1.bas +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0 diff --git a/bugs/private-desktop-window-activation-delay/private-desktop-window-activation-delay.twinproj b/bugs/private-desktop-window-activation-delay/private-desktop-window-activation-delay.twinproj new file mode 100644 index 00000000..914d3afd Binary files /dev/null and b/bugs/private-desktop-window-activation-delay/private-desktop-window-activation-delay.twinproj differ diff --git a/bugs/private-desktop-window-activation-delay/repro.json b/bugs/private-desktop-window-activation-delay/repro.json new file mode 100644 index 00000000..baf7b79f --- /dev/null +++ b/bugs/private-desktop-window-activation-delay/repro.json @@ -0,0 +1,13 @@ +{ + "mode": "run", + "exe": true, + "expect": { + "exit": 0, + "output": [ + "^--- exe: exit 0$", + "^2 made 2\\.\\d\\d activated 0\\.\\d\\d error 0$", + "^3 made 2\\.\\d\\d activated 0\\.\\d\\d error 0$", + "^4 made 2\\.\\d\\d activated 0\\.\\d\\d error 0$" + ] + } +} diff --git a/bugs/private-desktop-window-activation-delay/src/Settings b/bugs/private-desktop-window-activation-delay/src/Settings new file mode 100644 index 00000000..a5e3fa3e --- /dev/null +++ b/bugs/private-desktop-window-activation-delay/src/Settings @@ -0,0 +1,61 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "PrivateDesktopWindowActivationDelay", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: In an exe on a desktop that is not the input desktop, showing or activating a new top-level window takes 2 s from the third on", + "project.exportPathIsV2": true, + "project.id": "{6C08300A-C206-4B7A-9AAA-35BD04F9B1EB}", + "project.name": "PrivateDesktopWindowActivationDelay", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/private-desktop-window-activation-delay/src/Sources/Startup.twin b/bugs/private-desktop-window-activation-delay/src/Sources/Startup.twin new file mode 100644 index 00000000..6855da6d --- /dev/null +++ b/bugs/private-desktop-window-activation-delay/src/Sources/Startup.twin @@ -0,0 +1,50 @@ +' Makes four top-level windows one after another, each shown at creation (WS_VISIBLE, which +' activates it) and destroyed after AppActivate, and writes how long each step took to out.txt +' beside the exe (or to the file TBRUN_OUT names). A throwaway window comes first, since the +' first window a program shows takes the show command it was started with (hidden, for a +' program started hidden). Run as an exe on a desktop that is not the input desktop, as +' bug_repro.mjs run --exe and tbrun --exe do, it takes 2 s to create each window from the third +' it shows (window 2 below) on. In the IDE's run after the build there is no delay; on the +' input desktop each takes 0.02 s; and the VB6 project beside this one takes none on either. +Module Startup + Private Declare PtrSafe Function CreateWindowExA Lib "user32" (ByVal Ex As Long, ByVal Cls As String, ByVal Title As String, ByVal Style As Long, ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long, ByVal Parent As LongPtr, ByVal Menu As LongPtr, ByVal Inst As LongPtr, ByVal P As LongPtr) As LongPtr + Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal H As LongPtr) As Long + Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long + + Private Sub Out(ByVal Text As String) + If App.IsInIDE Then + Debug.Print Text + Exit Sub + End If + Dim file As String = Environ$("TBRUN_OUT") + If Len(file) = 0 Then file = App.Path & "\out.txt" + Dim f As Integer = FreeFile + Open file For Append As #f + Print #f, Text + Close #f + End Sub + + Public Sub Main() + Dim I As Long, H As LongPtr, T0 As Double, T1 As Double, T2 As Double, Title As String + Title = "WindowActivationDelay" & GetCurrentProcessId() + DestroyWindow CreateWindowExA(0, "STATIC", "first", &H10CF0000, 0, 0, 100, 50, 0, 0, 0, 0) + On Error Resume Next + For I = 1 To 4 + T0 = Timer + H = CreateWindowExA(0, "STATIC", Title, &H10CF0000, 100 + I * 30, 100 + I * 30, 300, 100, 0, 0, 0, 0) + T1 = Timer + AppActivate Title + T2 = Timer + Out I & " made " & Format$(T1 - T0, "0.00") & " activated " & Format$(T2 - T1, "0.00") & " error " & Err.Number + Err.Clear + DestroyWindow H + Next + End Sub + + ' The IDE's run after the build: the same windows, in the IDE, where there is no delay. + [RunAfterBuild] + Private Sub Built() + Debug.Cls + Main + End Sub +End Module diff --git a/bugs/private-desktop-window-activation-delay/vb6/Module1.bas b/bugs/private-desktop-window-activation-delay/vb6/Module1.bas new file mode 100644 index 00000000..33f09947 --- /dev/null +++ b/bugs/private-desktop-window-activation-delay/vb6/Module1.bas @@ -0,0 +1,29 @@ +Attribute VB_Name = "Module1" +Option Explicit + +' The same four windows as the twinBASIC project, in VB6. Build and run it with: +' node scripts/bug_repro.mjs vb6 private-desktop-window-activation-delay +' It runs on a private desktop, as the twinBASIC exe does, and every step takes no time. + +Private Declare Function CreateWindowExA Lib "user32" (ByVal Ex As Long, ByVal Cls As String, ByVal Title As String, ByVal Style As Long, ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long, ByVal Parent As Long, ByVal Menu As Long, ByVal Inst As Long, ByVal P As Long) As Long +Private Declare Function DestroyWindow Lib "user32" (ByVal H As Long) As Long +Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long + +Sub Main() + Dim I As Long, H As Long, T0 As Double, T1 As Double, T2 As Double, Title As String + Open App.Path & "\out.txt" For Output As #9 + Title = "WindowActivationDelay" & GetCurrentProcessId() + DestroyWindow CreateWindowExA(0, "STATIC", "first", &H10CF0000, 0, 0, 100, 50, 0, 0, 0, 0) + On Error Resume Next + For I = 1 To 4 + T0 = Timer + H = CreateWindowExA(0, "STATIC", Title, &H10CF0000, 100 + I * 30, 100 + I * 30, 300, 100, 0, 0, 0, 0) + T1 = Timer + AppActivate Title + T2 = Timer + Print #9, I & " made " & Format$(T1 - T0, "0.00") & " activated " & Format$(T2 - T1, "0.00") & " error " & Err.Number + Err.Clear + DestroyWindow H + Next + Close #9 +End Sub diff --git a/bugs/private-desktop-window-activation-delay/vb6/Probe.vbp b/bugs/private-desktop-window-activation-delay/vb6/Probe.vbp new file mode 100644 index 00000000..4d210b0e --- /dev/null +++ b/bugs/private-desktop-window-activation-delay/vb6/Probe.vbp @@ -0,0 +1,7 @@ +Type=Exe +Module=Module1; Module1.bas +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0 diff --git a/bugs/sendkeys-non-ascii/repro.json b/bugs/sendkeys-non-ascii/repro.json new file mode 100644 index 00000000..c73f145e --- /dev/null +++ b/bugs/sendkeys-non-ascii/repro.json @@ -0,0 +1,13 @@ +{ + "mode": "test", + "expect": { + "exit": 7, + "output": [ + "^PASS RegressionTests.SendKeys_LowerA_SendsA$", + "^PASS RegressionTests.SendKeys_UpperA_SendsShiftA$", + "^FAIL RegressionTests.SendKeys_EAcute_SendsTheCharacter: .*Actual: \"E9d E9u\"", + "^FAIL RegressionTests.SendKeys_WhiteSmilingFace_SendsTheCharacter: .*Actual: \"10d BFd BFu 10u\"", + "^FAIL RegressionTests.SendKeys_AMacron_SendsTheCharacter: .*Actual: \"10d 41d 41u 10u\"" + ] + } +} diff --git a/bugs/sendkeys-non-ascii/sendkeys-non-ascii.twinproj b/bugs/sendkeys-non-ascii/sendkeys-non-ascii.twinproj new file mode 100644 index 00000000..330d4228 Binary files /dev/null and b/bugs/sendkeys-non-ascii/sendkeys-non-ascii.twinproj differ diff --git a/bugs/sendkeys-non-ascii/src/Settings b/bugs/sendkeys-non-ascii/src/Settings new file mode 100644 index 00000000..79119419 --- /dev/null +++ b/bugs/sendkeys-non-ascii/src/Settings @@ -0,0 +1,75 @@ +{ + "configuration.inherits": "Defaults", + "project.appTitle": "SendkeysNonAscii", + "project.buildPath": "${SourcePath}\\Build\\${ProjectName}_${Architecture}.${FileExtension}", + "project.buildType": "Standard EXE", + "project.description": "Reproduces: SendKeys sends the wrong key for a character the keyboard layout has no key for", + "project.exportPathIsV2": true, + "project.id": "{16CBBE09-FA95-412B-9C09-3D657A669DDE}", + "project.name": "SendkeysNonAscii", + "project.optionExplicit": true, + "project.references": [ + { + "id": "{00020430-0000-0000-C000-000000000046}", + "lcid": 0, + "name": "OLE Automation", + "path32": "C:\\Windows\\SysWOW64\\stdole2.tlb", + "path64": "C:\\Windows\\System32\\stdole2.tlb", + "symbolId": "stdole", + "versionMajor": 2, + "versionMinor": 0 + }, + { + "id": "{F50B82D0-DCAB-43FE-9631-11959D4A4728}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - VB Compatibility Package (Forms)", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "VB", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 31 + }, + { + "id": "{C192FB39-64CA-4D9B-B477-A5502F48EFCC}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] twinBASIC - App global class object", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "AppGlobalClassProject", + "versionBuild": 0, + "versionMajor": 1, + "versionMinor": 0, + "versionRevision": 0 + }, + { + "id": "{9847A10D-8987-44B2-8B87-EA77DEF7F1D9}", + "isCompilerPackage": true, + "licence": "MIT", + "name": "[COMPILER PACKAGE] Assert", + "path32": "", + "path64": "", + "publisher": "TWINBASIC-COMPILER", + "symbolId": "Assert", + "versionBuild": 0, + "versionMajor": 0, + "versionMinor": 0, + "versionRevision": 24 + } + ], + "project.settingsVersion": 1, + "project.startupObject": "Sub Main", + "project.warnings": { + "errors": [], + "hints": [], + "ignored": [], + "info": [], + "warnings": [] + }, + "runtime.useUnicodeStandardLibrary": true +} diff --git a/bugs/sendkeys-non-ascii/src/Sources/RegressionTests.twin b/bugs/sendkeys-non-ascii/src/Sources/RegressionTests.twin new file mode 100644 index 00000000..2be5e10f --- /dev/null +++ b/bugs/sendkeys-non-ascii/src/Sources/RegressionTests.twin @@ -0,0 +1,265 @@ +' Regression tests: SendKeys sends a character the keyboard layout has no key for as the +' character itself (a KEYEVENTF_UNICODE event), as VB6 and 64-bit VBA do, not as the virtual key +' of its ANSI code or as its nearest ANSI character. A copy of a keys harness records the events +' and sends none: `d` and `u` for a key down and up, `Ud` and `u` for a +' character. The expected events are for a US keyboard layout, which has no key for é. +' tbrun --tests runs each case and prints PASS or FAIL. +[TestFixture] +Module RegressionTests + ' ---- a copy of errors/harnesses/keys.bas (twinBASIC documentation): it records the key + ' events SendKeys would send, and sends none. + ' The keys harness, for twinBASIC, VB6 and VBA alike: a case that calls SendKeys runs with + ' the calls that inject input replaced, so that the key events are recorded and none is sent. + ' twinBASIC sends each key down and up with keybd_event; VB6 and VBA first set a journal + ' playback hook (SetWindowsHookExW, WH_JOURNALPLAYBACK), which Windows refuses to a process + ' without UIAccess, and then send one event at a time with SendInput. keys_Begin patches + ' keybd_event and SendInput with fakes that record each event and succeed, and + ' SetWindowsHookExA and W with one that refuses a journal playback hook (ERROR_ACCESS_DENIED, + ' as Windows does) and passes any other hook to the real function (its bytes put back for + ' the call). keys_End puts the bytes back. keys_Expect raises 1001 when the events recorded + ' are not the ones given: each ``, down or up, space-separated + ' ("10d 41d 41u 10u" for "+a"), or `U` for one SendInput sends + ' as a character (KEYEVENTF_UNICODE). VBA7 is true in twinBASIC and in VBA 7; VB6 compiles + ' only the #Else branches, so they hold what it cannot parse. + + #If VBA7 Then + Private Declare PtrSafe Function keys_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As LongPtr + Private Declare PtrSafe Function keys_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As LongPtr, ByVal Name As String) As LongPtr + Private Declare PtrSafe Function keys_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As LongPtr, ByVal S As LongPtr, ByVal P As Long, ByRef Old As Long) As Long + Private Declare PtrSafe Sub keys_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As LongPtr) + Private Declare PtrSafe Sub keys_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) + Private Declare PtrSafe Function keys_RealHookA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr + Private Declare PtrSafe Function keys_RealHookW Lib "user32" Alias "SetWindowsHookExW" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr + #Else + Private Declare Function keys_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As Long + Private Declare Function keys_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As Long, ByVal Name As String) As Long + Private Declare Function keys_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As Long, ByVal S As Long, ByVal P As Long, ByRef Old As Long) As Long + Private Declare Sub keys_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As Long) + Private Declare Sub keys_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) + Private Declare Function keys_RealHookA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long + Private Declare Function keys_RealHookW Lib "user32" Alias "SetWindowsHookExW" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long + #End If + + ' Each address is kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. + ' Targets: 0 keybd_event, 1 SendInput, 2 SetWindowsHookExA, 3 SetWindowsHookExW. + Private keys_Targets(3) As Variant + Private keys_Saved(47) As Byte + Private keys_Jumps(47) As Byte + Private keys_Sent As String + + Private Sub keys_Record(ByVal Text As String) + If Len(keys_Sent) Then keys_Sent = keys_Sent & " " + keys_Sent = keys_Sent & Text + End Sub + + Private Sub keys_FakeEvent(ByVal Vk As Long, ByVal Scan As Long, ByVal Flags As Long, ByVal Extra As Long) + keys_Record Hex$(Vk And &HFF&) & IIf((Flags And 2) <> 0, "u", "d") + End Sub + + #If VBA7 Then + Private Function keys_Address(ByVal A As LongPtr) As Variant + keys_Address = A + End Function + + ' INPUT: type, then (aligned to a pointer in 64-bit code) KEYBDINPUT: wVk, wScan, dwFlags. + Private Function keys_FakeInput(ByVal N As Long, ByVal P As LongPtr, ByVal Size As Long) As Long + Dim I As Long, Kind As Long, Vk As Integer, Scan As Integer, Flags As Long, At As LongPtr + For I = 0 To N - 1 + At = P + I * Size + keys_CopyMemory Kind, ByVal At, 4 + If Kind = 1 Then + At = At + LenB(P) + keys_CopyMemory Vk, ByVal At, 2 + keys_CopyMemory Scan, ByVal At + 2, 2 + keys_CopyMemory Flags, ByVal At + 4, 4 + keys_RecordInput Vk, Scan, Flags + End If + Next + keys_FakeInput = N + End Function + + Private Function keys_FakeHookA(ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 2, False + keys_FakeHookA = keys_RealHookA(Id, Fn, M, T) + keys_Put 2, True + End Function + + Private Function keys_FakeHookW(ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 3, False + keys_FakeHookW = keys_RealHookW(Id, Fn, M, T) + keys_Put 3, True + End Function + #Else + Private Function keys_Address(ByVal A As Long) As Variant + keys_Address = A + End Function + + Private Function keys_FakeInput(ByVal N As Long, ByVal P As Long, ByVal Size As Long) As Long + Dim I As Long, Kind As Long, Vk As Integer, Scan As Integer, Flags As Long, At As Long + For I = 0 To N - 1 + At = P + I * Size + keys_CopyMemory Kind, ByVal At, 4 + If Kind = 1 Then + At = At + 4 + keys_CopyMemory Vk, ByVal At, 2 + keys_CopyMemory Scan, ByVal At + 2, 2 + keys_CopyMemory Flags, ByVal At + 4, 4 + keys_RecordInput Vk, Scan, Flags + End If + Next + keys_FakeInput = N + End Function + + Private Function keys_FakeHookA(ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 2, False + keys_FakeHookA = keys_RealHookA(Id, Fn, M, T) + keys_Put 2, True + End Function + + Private Function keys_FakeHookW(ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 3, False + keys_FakeHookW = keys_RealHookW(Id, Fn, M, T) + keys_Put 3, True + End Function + #End If + + ' KEYEVENTF_KEYUP is 2, KEYEVENTF_UNICODE 4 (the character in wScan). + Private Sub keys_RecordInput(ByVal Vk As Integer, ByVal Scan As Integer, ByVal Flags As Long) + Dim UpDown As String + UpDown = IIf((Flags And 2) <> 0, "u", "d") + If (Flags And 4) <> 0 Then + keys_Record "U" & Hex$(Scan And &HFFFF&) & UpDown + Else + keys_Record Hex$(Vk And &HFF&) & UpDown + End If + End Sub + + ' Writes target I's jump (IsOn) or its original bytes back (not IsOn). + Private Sub keys_Put(ByVal I As Long, ByVal IsOn As Boolean) + Dim N As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If IsEmpty(keys_Targets(I)) Then Exit Sub + P = keys_Targets(I) + If IsOn Then + keys_CopyMemory ByVal P, keys_Jumps(I * 12), N + Else + keys_CopyMemory ByVal P, keys_Saved(I * 12), N + End If + End Sub + + ' The jump to Fn: mov eax, Fn; jmp eax, or in 64-bit code mov rax, Fn; jmp rax. + Private Sub keys_Patch(ByVal I As Long, ByVal Name As String, ByVal Fn As Variant) + Dim N As Long, Old As Long, Target As Variant + Target = keys_GetProcAddress(keys_GetModuleHandleA("user32"), Name) + If Target = 0 Then Exit Sub + #If Win64 Then + Dim F As LongPtr, P As LongPtr + F = Fn + keys_Jumps(I * 12) = &H48: keys_Jumps(I * 12 + 1) = &HB8 + keys_CopyMemory keys_Jumps(I * 12 + 2), F, 8 + keys_Jumps(I * 12 + 10) = &HFF: keys_Jumps(I * 12 + 11) = &HE0 + N = 12 + #Else + Dim F As Long, P As Long + F = Fn + keys_Jumps(I * 12) = &HB8 + keys_CopyMemory keys_Jumps(I * 12 + 1), F, 4 + keys_Jumps(I * 12 + 5) = &HFF: keys_Jumps(I * 12 + 6) = &HE0 + N = 7 + #End If + P = Target + keys_VirtualProtect P, N, &H40, Old + keys_CopyMemory keys_Saved(I * 12), ByVal P, N + keys_Targets(I) = Target + keys_Put I, True + End Sub + + Private Sub keys_Begin() + Dim I As Long + keys_Sent = "" + For I = 0 To 3 + keys_Targets(I) = Empty + Next + keys_Patch 0, "keybd_event", keys_Address(AddressOf keys_FakeEvent) + keys_Patch 1, "SendInput", keys_Address(AddressOf keys_FakeInput) + keys_Patch 2, "SetWindowsHookExA", keys_Address(AddressOf keys_FakeHookA) + keys_Patch 3, "SetWindowsHookExW", keys_Address(AddressOf keys_FakeHookW) + End Sub + + Private Sub keys_End() + Dim I As Long + For I = 3 To 0 Step -1 + keys_Put I, False + keys_Targets(I) = Empty + Next + End Sub + + ' Forgets the events recorded so far. VB6 and VBA keep the keys of a string they refuse and send + ' them with the next SendKeys: a case after a refused one sends those first (SendKeys "") and + ' clears them, in its setup. + Private Sub keys_Clear() + keys_Sent = "" + End Sub + + ' Raises 1001 when the events recorded are not Keys. Does nothing when the case has already raised. + Private Sub keys_Expect(ByVal Keys As String) + If Err.Number <> 0 Then Exit Sub + If keys_Sent <> Keys Then Err.Raise 1001, , "sent " & IIf(keys_Sent = "", "nothing", keys_Sent) + End Sub + + ' A control: a character the layout has a key for. + [TestCase] + Public Sub SendKeys_LowerA_SendsA() + keys_Begin + SendKeys "a" + keys_End + Assert.Strict.AreEqual "41d 41u", keys_Sent + End Sub + + ' A control: with Shift. + [TestCase] + Public Sub SendKeys_UpperA_SendsShiftA() + keys_Begin + SendKeys "A" + keys_End + Assert.Strict.AreEqual "10d 41d 41u 10u", keys_Sent + End Sub + + ' é: in the ANSI code page, with no key on a US layout. + [TestCase] + Public Sub SendKeys_EAcute_SendsTheCharacter() + keys_Begin + SendKeys ChrW(&HE9) + keys_End + Assert.Strict.AreEqual "UE9d UE9u", keys_Sent + End Sub + + ' ☺ (U+263A): outside the ANSI code page. + [TestCase] + Public Sub SendKeys_WhiteSmilingFace_SendsTheCharacter() + keys_Begin + SendKeys ChrW(&H263A) + keys_End + Assert.Strict.AreEqual "U263Ad U263Au", keys_Sent + End Sub + + ' Ā (U+0100): outside the ANSI code page, whose nearest character is A. + [TestCase] + Public Sub SendKeys_AMacron_SendsTheCharacter() + keys_Begin + SendKeys ChrW(&H100) + keys_End + Assert.Strict.AreEqual "U100d U100u", keys_Sent + End Sub + +End Module diff --git a/bugs/sendkeys-non-ascii/src/Sources/Startup.twin b/bugs/sendkeys-non-ascii/src/Sources/Startup.twin new file mode 100644 index 00000000..be8f5c8b --- /dev/null +++ b/bugs/sendkeys-non-ascii/src/Sources/Startup.twin @@ -0,0 +1,6 @@ +Module Startup + + Public Sub Main() + End Sub + +End Module diff --git a/bugs/sendkeys-non-ascii/vb6/Module1.bas b/bugs/sendkeys-non-ascii/vb6/Module1.bas new file mode 100644 index 00000000..abe42d9d --- /dev/null +++ b/bugs/sendkeys-non-ascii/vb6/Module1.bas @@ -0,0 +1,246 @@ +Attribute VB_Name = "Module1" +Option Explicit + +' The key events VB6 sends for each string of the twinBASIC test cases, in the same order. +' Build and run it with: node scripts/bug_repro.mjs vb6 sendkeys-non-ascii +' ---- a copy of errors/harnesses/keys.bas (twinBASIC documentation): it records the key +' events SendKeys would send, and sends none. +' The keys harness, for twinBASIC, VB6 and VBA alike: a case that calls SendKeys runs with +' the calls that inject input replaced, so that the key events are recorded and none is sent. +' twinBASIC sends each key down and up with keybd_event; VB6 and VBA first set a journal +' playback hook (SetWindowsHookExW, WH_JOURNALPLAYBACK), which Windows refuses to a process +' without UIAccess, and then send one event at a time with SendInput. keys_Begin patches +' keybd_event and SendInput with fakes that record each event and succeed, and +' SetWindowsHookExA and W with one that refuses a journal playback hook (ERROR_ACCESS_DENIED, +' as Windows does) and passes any other hook to the real function (its bytes put back for +' the call). keys_End puts the bytes back. keys_Expect raises 1001 when the events recorded +' are not the ones given: each ``, down or up, space-separated +' ("10d 41d 41u 10u" for "+a"), or `U` for one SendInput sends +' as a character (KEYEVENTF_UNICODE). VBA7 is true in twinBASIC and in VBA 7; VB6 compiles +' only the #Else branches, so they hold what it cannot parse. + +#If VBA7 Then +Private Declare PtrSafe Function keys_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As LongPtr +Private Declare PtrSafe Function keys_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As LongPtr, ByVal Name As String) As LongPtr +Private Declare PtrSafe Function keys_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As LongPtr, ByVal S As LongPtr, ByVal P As Long, ByRef Old As Long) As Long +Private Declare PtrSafe Sub keys_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As LongPtr) +Private Declare PtrSafe Sub keys_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare PtrSafe Function keys_RealHookA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr +Private Declare PtrSafe Function keys_RealHookW Lib "user32" Alias "SetWindowsHookExW" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr +#Else +Private Declare Function keys_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As Long +Private Declare Function keys_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As Long, ByVal Name As String) As Long +Private Declare Function keys_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As Long, ByVal S As Long, ByVal P As Long, ByRef Old As Long) As Long +Private Declare Sub keys_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As Long) +Private Declare Sub keys_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare Function keys_RealHookA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long +Private Declare Function keys_RealHookW Lib "user32" Alias "SetWindowsHookExW" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long +#End If + +' Each address is kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. +' Targets: 0 keybd_event, 1 SendInput, 2 SetWindowsHookExA, 3 SetWindowsHookExW. +Private keys_Targets(3) As Variant +Private keys_Saved(47) As Byte +Private keys_Jumps(47) As Byte +Private keys_Sent As String + +Private Sub keys_Record(ByVal Text As String) + If Len(keys_Sent) Then keys_Sent = keys_Sent & " " + keys_Sent = keys_Sent & Text +End Sub + +Private Sub keys_FakeEvent(ByVal Vk As Long, ByVal Scan As Long, ByVal Flags As Long, ByVal Extra As Long) + keys_Record Hex$(Vk And &HFF&) & IIf((Flags And 2) <> 0, "u", "d") +End Sub + +#If VBA7 Then +Private Function keys_Address(ByVal A As LongPtr) As Variant + keys_Address = A +End Function + +' INPUT: type, then (aligned to a pointer in 64-bit code) KEYBDINPUT: wVk, wScan, dwFlags. +Private Function keys_FakeInput(ByVal N As Long, ByVal P As LongPtr, ByVal Size As Long) As Long + Dim I As Long, Kind As Long, Vk As Integer, Scan As Integer, Flags As Long, At As LongPtr + For I = 0 To N - 1 + At = P + I * Size + keys_CopyMemory Kind, ByVal At, 4 + If Kind = 1 Then + At = At + LenB(P) + keys_CopyMemory Vk, ByVal At, 2 + keys_CopyMemory Scan, ByVal At + 2, 2 + keys_CopyMemory Flags, ByVal At + 4, 4 + keys_RecordInput Vk, Scan, Flags + End If + Next + keys_FakeInput = N +End Function + +Private Function keys_FakeHookA(ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 2, False + keys_FakeHookA = keys_RealHookA(Id, Fn, M, T) + keys_Put 2, True +End Function + +Private Function keys_FakeHookW(ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 3, False + keys_FakeHookW = keys_RealHookW(Id, Fn, M, T) + keys_Put 3, True +End Function +#Else +Private Function keys_Address(ByVal A As Long) As Variant + keys_Address = A +End Function + +Private Function keys_FakeInput(ByVal N As Long, ByVal P As Long, ByVal Size As Long) As Long + Dim I As Long, Kind As Long, Vk As Integer, Scan As Integer, Flags As Long, At As Long + For I = 0 To N - 1 + At = P + I * Size + keys_CopyMemory Kind, ByVal At, 4 + If Kind = 1 Then + At = At + 4 + keys_CopyMemory Vk, ByVal At, 2 + keys_CopyMemory Scan, ByVal At + 2, 2 + keys_CopyMemory Flags, ByVal At + 4, 4 + keys_RecordInput Vk, Scan, Flags + End If + Next + keys_FakeInput = N +End Function + +Private Function keys_FakeHookA(ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 2, False + keys_FakeHookA = keys_RealHookA(Id, Fn, M, T) + keys_Put 2, True +End Function + +Private Function keys_FakeHookW(ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 3, False + keys_FakeHookW = keys_RealHookW(Id, Fn, M, T) + keys_Put 3, True +End Function +#End If + +' KEYEVENTF_KEYUP is 2, KEYEVENTF_UNICODE 4 (the character in wScan). +Private Sub keys_RecordInput(ByVal Vk As Integer, ByVal Scan As Integer, ByVal Flags As Long) + Dim UpDown As String + UpDown = IIf((Flags And 2) <> 0, "u", "d") + If (Flags And 4) <> 0 Then + keys_Record "U" & Hex$(Scan And &HFFFF&) & UpDown + Else + keys_Record Hex$(Vk And &HFF&) & UpDown + End If +End Sub + +' Writes target I's jump (IsOn) or its original bytes back (not IsOn). +Private Sub keys_Put(ByVal I As Long, ByVal IsOn As Boolean) + Dim N As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If IsEmpty(keys_Targets(I)) Then Exit Sub + P = keys_Targets(I) + If IsOn Then + keys_CopyMemory ByVal P, keys_Jumps(I * 12), N + Else + keys_CopyMemory ByVal P, keys_Saved(I * 12), N + End If +End Sub + +' The jump to Fn: mov eax, Fn; jmp eax, or in 64-bit code mov rax, Fn; jmp rax. +Private Sub keys_Patch(ByVal I As Long, ByVal Name As String, ByVal Fn As Variant) + Dim N As Long, Old As Long, Target As Variant + Target = keys_GetProcAddress(keys_GetModuleHandleA("user32"), Name) + If Target = 0 Then Exit Sub + #If Win64 Then + Dim F As LongPtr, P As LongPtr + F = Fn + keys_Jumps(I * 12) = &H48: keys_Jumps(I * 12 + 1) = &HB8 + keys_CopyMemory keys_Jumps(I * 12 + 2), F, 8 + keys_Jumps(I * 12 + 10) = &HFF: keys_Jumps(I * 12 + 11) = &HE0 + N = 12 + #Else + Dim F As Long, P As Long + F = Fn + keys_Jumps(I * 12) = &HB8 + keys_CopyMemory keys_Jumps(I * 12 + 1), F, 4 + keys_Jumps(I * 12 + 5) = &HFF: keys_Jumps(I * 12 + 6) = &HE0 + N = 7 + #End If + P = Target + keys_VirtualProtect P, N, &H40, Old + keys_CopyMemory keys_Saved(I * 12), ByVal P, N + keys_Targets(I) = Target + keys_Put I, True +End Sub + +Private Sub keys_Begin() + Dim I As Long + keys_Sent = "" + For I = 0 To 3 + keys_Targets(I) = Empty + Next + keys_Patch 0, "keybd_event", keys_Address(AddressOf keys_FakeEvent) + keys_Patch 1, "SendInput", keys_Address(AddressOf keys_FakeInput) + keys_Patch 2, "SetWindowsHookExA", keys_Address(AddressOf keys_FakeHookA) + keys_Patch 3, "SetWindowsHookExW", keys_Address(AddressOf keys_FakeHookW) +End Sub + +Private Sub keys_End() + Dim I As Long + For I = 3 To 0 Step -1 + keys_Put I, False + keys_Targets(I) = Empty + Next +End Sub + +' Forgets the events recorded so far. VB6 and VBA keep the keys of a string they refuse and send +' them with the next SendKeys: a case after a refused one sends those first (SendKeys "") and +' clears them, in its setup. +Private Sub keys_Clear() + keys_Sent = "" +End Sub + +' Raises 1001 when the events recorded are not Keys. Does nothing when the case has already raised. +Private Sub keys_Expect(ByVal Keys As String) + If Err.Number <> 0 Then Exit Sub + If keys_Sent <> Keys Then Err.Raise 1001, , "sent " & IIf(keys_Sent = "", "nothing", keys_Sent) +End Sub + +Sub Main() + Open App.Path & "\out.txt" For Output As #9 + On Error Resume Next + keys_Begin + SendKeys "a" + keys_End + Print #9, "SendKeys_LowerA_SendsA: " & Err.Number & " " & keys_Sent + Err.Clear + keys_Begin + SendKeys "A" + keys_End + Print #9, "SendKeys_UpperA_SendsShiftA: " & Err.Number & " " & keys_Sent + Err.Clear + keys_Begin + SendKeys ChrW(&HE9) + keys_End + Print #9, "SendKeys_EAcute_SendsTheCharacter: " & Err.Number & " " & keys_Sent + Err.Clear + keys_Begin + SendKeys ChrW(&H263A) + keys_End + Print #9, "SendKeys_WhiteSmilingFace_SendsTheCharacter: " & Err.Number & " " & keys_Sent + Err.Clear + keys_Begin + SendKeys ChrW(&H100) + keys_End + Print #9, "SendKeys_AMacron_SendsTheCharacter: " & Err.Number & " " & keys_Sent + Err.Clear + Close #9 +End Sub diff --git a/bugs/sendkeys-non-ascii/vb6/Probe.vbp b/bugs/sendkeys-non-ascii/vb6/Probe.vbp new file mode 100644 index 00000000..4d210b0e --- /dev/null +++ b/bugs/sendkeys-non-ascii/vb6/Probe.vbp @@ -0,0 +1,7 @@ +Type=Exe +Module=Module1; Module1.bas +Startup="Sub Main" +ExeName32="Probe.exe" +Name="Probe" +CompilationType=0 +OptimizationType=0 diff --git a/docs/Documentation/Tools-Defects.md b/docs/Documentation/Tools-Defects.md index d2082052..057eea17 100644 --- a/docs/Documentation/Tools-Defects.md +++ b/docs/Documentation/Tools-Defects.md @@ -43,7 +43,7 @@ needs a twinBASIC install and Windows. It is outside every gate and outside CI; | `compile ` | Packs, then compiles the project with `tbbuild --json` and prints its diagnostics. | | `build ` | Packs, then compiles and builds it with `tbbuild --build`, or `--llvm` when that is given. A failed build prints the build log and the failing line. | | `run ` | Copies `src/` to `%TEMP%\bugrepro\-\`, adds a `TbRunProbe` module whose `[RunAfterBuild]` Sub calls `Debug.Cls` and then `Main`, runs `tbrun` on the copy and prints what it captured. The Sub clears `WEBVIEW2_USER_DATA_FOLDER` and `WEBVIEW2_ADDITIONAL_BROWSER_ARGUMENTS` while `Main` runs, because the harness sets both and they would stop a WebView2 control in the project from starting. With `--exe` no probe module is added: `tbrun` runs `Sub Main` in the built exe. With `images` in `repro.json`, `run` gives `tbrun` an empty folder in `BUGREPRO_IMAGES`, which the IDE and, with `--exe`, the exe inherit, and keeps each picture as `images/-tb.png`; a picture the probe did not write is a failure that names it, exit 9. Apart from those pictures, `run` changes nothing under `bugs/`. A reproducer whose mode is `test` is run with `tbrun --tests` on `src/` instead, with no probe module; a failed case is exit 1, and `--exe` and `--llvm` are refused. | -| `vb6 ` | Builds the reproducer's VB6 project in `vb6/` and prints what its exe wrote. By convention `Probe.vbp` builds `Probe.exe`, which writes its findings to `out.txt` beside the exe and handles every error itself. It needs no IDE. The sources are built from a copy under the OS temp folder, so nothing lands in the repository. It finds and starts VB6, and runs the exe, as [`vb6run.mjs`](#vb6run) does: Unattended Execution (dropped for a project with a form, user control, property page, user document or designer, which VB6 refuses it for), a private desktop, a time limit, and a refusal, exit 2, of sources that call `MsgBox` or `InputBox`. An unhandled error in an exe built with Unattended Execution exits with code 0 and leaves no fault; the VB runtime writes it to the Application event log, and that record is reported. `--timeout` is the exe's time limit (default 30 s), and `--keep` keeps the work folder and prints where it is. With `images` in `repro.json`, the exe is given an empty folder in `BUGREPRO_IMAGES`, and each picture it wrote is kept as `images/-vb6.png`. | +| `vb6 ` | Builds the reproducer's VB6 project in `vb6/` and prints what its exe wrote. By convention `Probe.vbp` builds `Probe.exe`, which writes its findings to `out.txt` beside the exe and handles every error itself. It needs no IDE. The sources are built from a copy under the OS temp folder, so nothing lands in the repository. It finds and starts VB6, and runs the exe, as [`vb6run.mjs`](#vb6run) does: Unattended Execution (dropped for a project with a form, user control, property page, user document or designer, which VB6 refuses it for), a private desktop, a time limit, and a refusal, exit 2, of sources that call `MsgBox` or `InputBox`, unless the project carries a copy of the dialog harness of [`errors.mjs`](#errors) (a source that defines `dialog_Begin`), which answers every box at once; such a project is built without Unattended Execution, so its boxes are shown and answered rather than logged. An unhandled error in an exe built with Unattended Execution exits with code 0 and leaves no fault; the VB runtime writes it to the Application event log, and that record is reported. `--timeout` is the exe's time limit (default 30 s), and `--keep` keeps the work folder and prints where it is. With `images` in `repro.json`, the exe is given an empty folder in `BUGREPRO_IMAGES`, and each picture it wrote is kept as `images/-vb6.png`. | | `verify [slug ...]` | Reads `repro.json` for each named reproducer, or every one under `bugs/` and `bugs/filed/`, runs what it says and reports one line each. A filed reproducer's line is labelled with its issue, such as `(filed #2453)`, and the summary counts the filed ones on a line of their own. | | `file ` | Moves the entry that names `` `.twinproj` `` out of `BUGS-TO-REPORT.md`, with one `---` beside it, into `bugs/filed//REPORT.md`. Its first line links the issue (with `--existing`, "Covered by the existing issue ..."), and it holds no mark line. Then moves `bugs//` to `bugs/filed//` and records `issue` (and `existing`) in its `repro.json`. An entry whose reproducer is not an attachment names `bugs//` in its closing comment instead. Refused, exit 2 and nothing changed, when no entry or more than one names the slug, `bugs/` is missing, or `bugs/filed/` exists. | | `file --marked` | Does that for every entry with a mark line directly under its title: `*FILED #*`, `*CAPTURED IN EXISTING #*` or `*CAPTURED IN \#*`. The issue and the slug are taken from the entry. A line such as `*DEFERRED until after v1*` is not a mark, and the entry is skipped. If a mark cannot be read, or a slug cannot be settled, the entries concerned are printed and nothing is filed, exit 2. Takes neither a slug nor an issue. | @@ -157,11 +157,11 @@ Exit codes: **0** the sample ran, or, with `--docs`, no fence differs and none r node scripts/errors.mjs write [...] node scripts/errors.mjs messages [--runtime tb|win64|vb6|vba64]... [--ide ] [--vb6 ] [--keep] -Measures the run-time errors each documented procedure raises, and writes each reference page's Common Errors section from them. The errors are data, not prose: a YAML file per area under `errors/` lists, for each page, the cases that raise each error and the cases that must raise nothing, and `errors/messages.yml` gives each number's message: the one `Err.Description` gives once the error is raised, and the one `Error$(number)` gives, where the two differ. The format is in `WIP.Errors.md`. Each twinBASIC build is compared with its counterpart: 32-bit twinBASIC with VB6, 64-bit twinBASIC with 64-bit VBA. A case can run under a *harness*, the code of `errors/harnesses/.bas`, one source for twinBASIC, VB6 and VBA, which the probe calls before and after the case: the `clock` harness replaces the system's clock setters in the probe's own process, so a case that sets `Date` or `Time` is measured, and the value it would set checked, without the clock being changed. A file is named as it is in `errors/`; with none named, every file there is used. `--only ` keeps the pages whose path under `docs/` matches. +Measures the run-time errors each documented procedure raises, and writes each reference page's Common Errors section from them. The errors are data, not prose: a YAML file per area under `errors/` lists, for each page, the cases that raise each error and the cases that must raise nothing, and `errors/messages.yml` gives each number's message: the one `Err.Description` gives once the error is raised, and the one `Error$(number)` gives, where the two differ. The format is in `WIP.Errors.md`. Each twinBASIC build is compared with its counterpart: 32-bit twinBASIC with VB6, 64-bit twinBASIC with 64-bit VBA. A case can run under a *harness*, the code of `errors/harnesses/.bas`, one source for twinBASIC, VB6 and VBA, which the probe calls before and after the case: the `clock` harness replaces the system's clock setters in the probe's own process, so a case that sets `Date` or `Time` is measured, and the value it would set checked, without the clock being changed; `registry` removes what a case writes under the VB settings key; `dialog` answers each box `MsgBox` or `InputBox` shows the moment it opens, and refuses one that would open on another desktop; `keys` records the keys `SendKeys` would send and sends none; and `window` gives `AppActivate` a window of the probe to activate. VB6 builds a probe with cases under `dialog` without Unattended Execution, which would write the box to the event log in place of showing it. A file is named as it is in `errors/`; with none named, every file there is used. `--only ` keeps the pages whose path under `docs/` matches. | Command | Effect | |---|---| -| `run` | Builds one probe of the cases for each runtime and runs it: 32-bit twinBASIC (`tb`), 64-bit twinBASIC (`win64`), VB6 (`vb6`) and 64-bit VBA (`vba64`), all four by default; `--runtime` names them instead, and may be repeated. Each case is a procedure of its own that runs under `On Error Resume Next` and reports `Err.Number` and `Err.Description`. The twinBASIC probe is a tree run by [`tbrun --exe`](Tools-Compiler#tbrun), so the cases run in the built exe and not in the IDE, and the VB6 probe is a `Probe.vbp` built and run by the code [`bug_repro.mjs vb6`](#bug-repro) uses, on a private desktop. The VBA probe is a module run in 64-bit Microsoft Access through automation, also on a private desktop: one Access serves the whole run, each probe in a new database, and an Access that shows a box (a compile error) or passes the time limit is ended and the next probe starts another. Access needs no change to its security settings for this. A case a compiler refuses is reported with the compiler's message and left out, and the probe is built again without it, so one bad case costs a rebuild and not the run. Each case is printed with what each runtime raised, and a case is `FAIL` when a runtime raised another number than the data says, refused it, never reported, or raised a number whose message is not the one in `messages.yml`. `--keep` keeps the generated probes and prints where they are. | +| `run` | Builds one probe of the cases for each runtime and runs it: 32-bit twinBASIC (`tb`), 64-bit twinBASIC (`win64`), VB6 (`vb6`) and 64-bit VBA (`vba64`), all four by default; `--runtime` names them instead, and may be repeated. Each case is a procedure of its own that runs under `On Error Resume Next` and reports `Err.Number` and `Err.Description`. The twinBASIC probe is a tree run by [`tbrun --exe`](Tools-Compiler#tbrun), so the cases run in the built exe and not in the IDE, and the VB6 probe is a `Probe.vbp` built and run by the code [`bug_repro.mjs vb6`](#bug-repro) uses, on a private desktop. The VBA probe is a module run in 64-bit Microsoft Access through automation, also on a private desktop: one Access serves the whole run, each probe in a new database, and an Access that shows a box (a compile error) at two checks a second apart, or passes the time limit, is ended and the next probe starts another. Access needs no change to its security settings for this. A case a compiler refuses is reported with the compiler's message and left out, and the probe is built again without it, so one bad case costs a rebuild and not the run. Each case is printed with what each runtime raised, and a case is `FAIL` when a runtime raised another number than the data says, refused it, never reported, or raised a number whose message is not the one in `messages.yml`. `--keep` keeps the generated probes and prints where they are. | | `generate` | Writes the probes to `/tb`, a tree for `tbrun --exe`, `/vb6`, a `Probe.vbp` project, and `/vba`, a `Module1.bas` module, without running them. | | `write` | Writes each page's section from the data, between `` and ``: before the page's first Example heading, else before See Also, else at the end, at the level the page gives those headings. Rows of the data that raise the same number make one row of the table, their conditions one line each, in the order of the data. A page whose data lists only cases that raise nothing gets no section, and loses one it had. Each number in a section links to its row on the central page, [Run-time Errors](../../Reference/Run-time-Errors), and `write` also writes that page's index between `` and ``: a row for every number in `messages.yml`, with its anchor, its message and links to the pages whose sections list it. Writing again changes nothing. [`check_errors.mjs`](Tools-Toolchain-Tests#check-errors) is its gate. | | `messages` | Builds one probe of the messages for each runtime, all four unless `--runtime` names some, runs it as `run` runs its probe, and compares it with `messages.yml`. The probe gives `Error$(n)` and, after `Err.Raise n`, `Err.Number` and `Err.Description`, for every number from 1 to 65535 whose `Error$` is not *Application-defined or object-defined error*, and for every other number the file lists. Every such number from 1 to 65535 must be in the file, and every number in it must give its messages: both in every runtime for a number from 1 to 65535; for another number, both in twinBASIC and `Error$` in VB6 and VBA, since VB6's `Err.Raise` turns many HRESULTs into its own numbers (`Err.Raise &H80070057` raises 5). Each disagreement is printed. | diff --git a/docs/Reference/Default/VBA/Interaction/AppActivate.md b/docs/Reference/Default/VBA/Interaction/AppActivate.md index 04d60412..de6dbfdf 100644 --- a/docs/Reference/Default/VBA/Interaction/AppActivate.md +++ b/docs/Reference/Default/VBA/Interaction/AppActivate.md @@ -27,7 +27,32 @@ Syntax: The **AppActivate** statement changes the focus to the named application or window but does not affect whether it is maximized or minimized. Focus moves from the activated application window when the user takes some action to change the focus or close the window. Use the [**Shell**](Shell) function to start an application and set the window style. -In determining which application to activate, *title* is compared to the title string of each running application. If there is no exact match, any application whose title string begins with *title* is activated. If there is more than one instance of the application named by *title*, one instance is arbitrarily activated. +In determining which application to activate, *title* is compared to the title string of each running application. If there is no exact match, any application whose title string begins or ends with *title* is activated. If there is more than one instance of the application named by *title*, one instance is arbitrarily activated. + +> [!NOTE] +> A *title* that is a zero-length string activates a window, as its title begins with it; 64-bit VBA does the same. VB6 raises error 5, *Invalid procedure call or argument*. + + +### Common Errors + +| Error | When | +|---|---| +| [94 (`&H5E`)](tb:Errors#94), *Invalid use of Null* | *title* is **Null** | +| [-2147467259 (`&H80004005`)](tb:Errors#-2147467259), *Unspecified error* | no window has *title* as its title, or its beginning or end, and no process with *title* as its task ID has a window (0, a negative number, **True** and **Empty** included) | + +> [!NOTE] BETA 1010 +> When no window has *title* as its title, or its beginning or end, and no process with *title* as its task ID has a window (0, a negative number, **True** and **Empty** included), VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*, instead. + +> [!NOTE] BETA 1010 +> When the window *title* names is hidden, VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*; twinBASIC raises none. + +> [!NOTE] BETA 1010 +> When *wait* is **Null**, VB6 and 64-bit VBA raise error [94 (`&H5E`)](tb:Errors#94), *Invalid use of Null*; twinBASIC raises none. + +> [!NOTE] BETA 1010 +> When *wait* is a string that is not a **Boolean**, VB6 and 64-bit VBA raise error [13 (`&HD`)](tb:Errors#13), *Type mismatch*; twinBASIC raises none. + + ### Example diff --git a/docs/Reference/Default/VBA/Interaction/InputBox.md b/docs/Reference/Default/VBA/Interaction/InputBox.md index ebebc39a..4a620ce8 100644 --- a/docs/Reference/Default/VBA/Interaction/InputBox.md +++ b/docs/Reference/Default/VBA/Interaction/InputBox.md @@ -29,10 +29,10 @@ Syntax: **InputBox(** *prompt* [ **,** *title* ] [ **,** *default* ] [ **,** *xp : *optional* Numeric expression specifying, in twips, the vertical distance of the top edge of the dialog from the top of the screen. If omitted, the dialog is positioned approximately one-third of the way down the screen. *helpfile* -: *optional* String expression that identifies the Help file to use to provide context-sensitive Help for the dialog box. If *helpfile* is supplied, *context* must also be supplied. +: *optional* String expression that identifies the Help file to use to provide context-sensitive Help for the dialog box. *context* -: *optional* Numeric expression giving the Help context number assigned to the relevant Help topic. If *context* is supplied, *helpfile* must also be supplied. +: *optional* Numeric expression giving the Help context number assigned to the relevant Help topic. If the user clicks **OK** or presses ENTER, **InputBox** returns whatever is in the text box. If the user clicks **Cancel**, the function returns a zero-length string (`""`). @@ -55,6 +55,29 @@ The text box accepts at most 255 characters; the returned string is truncated to When both *helpfile* and *context* are supplied, the user can press F1 to view the relevant Help topic. + +### Common Errors + +| Error | When | +|---|---| +| [94 (`&H5E`)](tb:Errors#94), *Invalid use of Null* | *prompt*, *title*, *default*, *xpos*, *ypos* or *context* is **Null**
*helpfile* is **Null** | +| [6 (`&H6`)](tb:Errors#6), *Overflow* | *xpos* or *ypos* is outside the range of a **Long** | +| [-2147467259 (`&H80004005`)](tb:Errors#-2147467259), *Unspecified error* | *helpfile* is given without *context* | + +> [!NOTE] BETA 1010 +> When *helpfile* is **Null**, VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*, instead. + +> [!NOTE] BETA 1010 +> When *xpos* or *ypos* is outside -32,768 to 32,767 after rounding, and inside the range of a **Long**, VB6 and 64-bit VBA raise error [6 (`&H6`)](tb:Errors#6), *Overflow*; twinBASIC raises none. + +> [!NOTE] BETA 1010 +> When *helpfile* is given without *context*, VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*, instead. + +> [!NOTE] BETA 1010 +> When *context* is given without *helpfile*, VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*; twinBASIC raises none. + + + ### Example This example shows several ways of calling **InputBox**. If *xpos* and *ypos* are omitted the dialog is centered on its respective axis. The variable `MyValue` ends up containing whatever the user typed when **OK** or ENTER was pressed, or a zero-length string when **Cancel** was pressed. diff --git a/docs/Reference/Default/VBA/Interaction/MsgBox.md b/docs/Reference/Default/VBA/Interaction/MsgBox.md index bf9e7b08..d18444d2 100644 --- a/docs/Reference/Default/VBA/Interaction/MsgBox.md +++ b/docs/Reference/Default/VBA/Interaction/MsgBox.md @@ -23,13 +23,20 @@ Syntax: **MsgBox(** *prompt* [ **,** *buttons* ] [ **,** *title* ] [ **,** *help : *optional* String expression displayed in the title bar of the dialog box. If omitted, the application name is used. *helpfile* -: *optional* String expression that identifies the Help file to use to provide context-sensitive Help for the dialog box. If *helpfile* is supplied, *context* must also be supplied. +: *optional* String expression that identifies the Help file to use to provide context-sensitive Help for the dialog box. *context* -: *optional* Numeric expression giving the Help context number assigned to the relevant Help topic. If *context* is supplied, *helpfile* must also be supplied. +: *optional* Numeric expression giving the Help context number assigned to the relevant Help topic. The *buttons* argument is a combination of values from the [**VbMsgBoxStyle**](../Constants/VbMsgBoxStyle) enumeration: one *button group* value (`vbOKOnly`, `vbOKCancel`, `vbAbortRetryIgnore`, `vbYesNoCancel`, `vbYesNo`, `vbRetryCancel`, `vbCancelTryAgainContinue`), optionally combined with one *icon* value (`vbCritical`, `vbQuestion`, `vbExclamation`, `vbInformation`), one *default-button* value (`vbDefaultButton1` through `vbDefaultButton4`), one *modality* value (`vbApplicationModal`, `vbSystemModal`), and any of the option flags (`vbMsgBoxHelpButton`, `vbMsgBoxSetForeground`, `vbMsgBoxRight`, `vbMsgBoxRtlReading`). Combine values with **Or** or addition. +> [!NOTE] +> **MsgBox** passes *buttons* to Windows as it is, so any style Windows accepts can be used. VB6 and 64-bit VBA show a plain **OK** box for a value they do not know --- `vbCancelTryAgainContinue`, two icons combined, a default-button value of &H400 --- and raise no error. + + +> [!WARNING] BETA 1010 +> A *buttons* value whose button group Windows does not have (7 to 15, -1 included) shows no box: **MsgBox** returns 0 and raises no error. VB6 and 64-bit VBA show an **OK** box and return **vbOK**. + The return value is one of the constants from the [**VbMsgBoxResult**](../Constants/VbMsgBoxResult) enumeration, identifying which button the user clicked. If the dialog box displays a **Cancel** button, pressing the ESC key has the same effect as clicking **Cancel**. When both *helpfile* and *context* are supplied, the user can press F1 to view the relevant Help topic; if the dialog also contains a **Help** button, clicking it invokes context-sensitive Help. The dialog stays open and **MsgBox** does not return until one of the non-Help buttons is clicked. @@ -37,6 +44,25 @@ If the dialog box displays a **Cancel** button, pressing the ESC key has the sam > [!NOTE] > To pass any argument by name (other than the first), use **MsgBox** in an expression context --- for example, assign its result to a variable. To skip a positional argument, include the corresponding comma delimiter. + +### Common Errors + +| Error | When | +|---|---| +| [94 (`&H5E`)](tb:Errors#94), *Invalid use of Null* | *prompt*, *buttons*, *title* or *context* is **Null**
*helpfile* is **Null** | +| [-2147467259 (`&H80004005`)](tb:Errors#-2147467259), *Unspecified error* | *helpfile* is given without *context* | + +> [!NOTE] BETA 1010 +> When *helpfile* is **Null**, VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*, instead. + +> [!NOTE] BETA 1010 +> When *helpfile* is given without *context*, VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*, instead. + +> [!NOTE] BETA 1010 +> When *context* is given without *helpfile*, VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*; twinBASIC raises none. + + + ### Example This example displays a critical-error message in a dialog with **Yes** and **No** buttons; the **No** button is the default. The value returned by **MsgBox** depends on the button the user clicks. diff --git a/docs/Reference/Default/VBA/Interaction/SendKeys.md b/docs/Reference/Default/VBA/Interaction/SendKeys.md index c644acb2..160d759f 100644 --- a/docs/Reference/Default/VBA/Interaction/SendKeys.md +++ b/docs/Reference/Default/VBA/Interaction/SendKeys.md @@ -19,6 +19,9 @@ Syntax: **SendKeys** *string* [ **,** *wait* ] *wait* : *optional* **Boolean** specifying the wait mode. If **False** (default), control is returned to the procedure as soon as the keys have been queued. If **True**, the keystrokes must be processed by the receiving window before control returns. +> [!NOTE] +> A string *wait* that reads as a **Boolean**, such as `"True"`, is taken as one. VB6 and 64-bit VBA raise error 13, *Type mismatch*, for any string. + Each key is represented by one or more characters. To specify a single keyboard character, use the character itself --- for example, `"A"` for the letter A, or `"ABC"` for A, B, then C in sequence. The plus sign (`+`), caret (`^`), percent sign (`%`), tilde (`~`), and parentheses `( )` have special meanings to **SendKeys**. To send one of these characters as itself, enclose it in braces: for example, `"{+}"` for the plus sign. Brackets `[ ]` have no special meaning to **SendKeys** itself, but they must be enclosed in braces because other applications may treat them specially during dynamic data exchange (DDE). To send brace characters, use `"{{}"` and `"{}}"`. @@ -37,7 +40,7 @@ To send keys that don't correspond to a printable character, use the codes in th | ESC | `{ESC}` | | HELP | `{HELP}` | | HOME | `{HOME}` | -| INS or INSERT | `{INSERT}` or `{INS}` | +| INS or INSERT | `{INSERT}` | | LEFT ARROW | `{LEFT}` | | NUM LOCK | `{NUMLOCK}` | | PAGE DOWN | `{PGDN}` | @@ -49,6 +52,8 @@ To send keys that don't correspond to a printable character, use the codes in th | UP ARROW | `{UP}` | | F1--F16 | `{F1}` … `{F16}` | + + To combine a key with SHIFT, CTRL, or ALT, prefix the key code with one or more of the following modifier codes: | Key | Code | @@ -62,7 +67,30 @@ To hold one or more modifiers down while a sequence of keys is pressed, enclose To repeat a key, use the form `{key number}` --- for example, `"{LEFT 42}"` to press LEFT 42 times, or `"{h 10}"` to type `h` ten times. The space between *key* and *number* is required. > [!NOTE] -> **SendKeys** can't send keystrokes to applications that aren't running in Windows, and it cannot send the PRINT SCREEN key (`{PRTSC}`) to any application. +> **SendKeys** can't send keystrokes to applications that aren't running in Windows, and it cannot send the PRINT SCREEN key to any application: `{PRTSC}` sends the virtual key `VK_PRINT` (&H2A), not `VK_SNAPSHOT` (&H2C), as VB6 and 64-bit VBA do. + + +> [!WARNING] BETA 1010 +> A character that has no key on the keyboard layout sends the wrong key, and no error is raised. The string is first converted to the ANSI code page, so a character outside it becomes its nearest ANSI character (`Ā` becomes `A`, `☺` becomes `?`), and a character the layout has no key for is sent as the virtual key of its ANSI code (`é`, on a US layout, as &HE9, which types nothing or another character). VB6 and 64-bit VBA send such a character as the character itself, which types it in any window. + + +### Common Errors + +| Error | When | +|---|---| +| [94 (`&H5E`)](tb:Errors#94), *Invalid use of Null* | *string* is **Null** | +| [-2147352567 (`&H80020009`)](tb:Errors#-2147352567), *Exception occurred.* | *string* has a brace that is not closed or not opened, an unknown key code (`{INS}` and `{F17}` included), a count in braces that is not a whole number from 0 to 8,175, unbalanced parentheses, or a modifier with nothing after it (`++`)
*wait* is **Null**
*wait* is a string that is not a **Boolean** | + +> [!NOTE] BETA 1010 +> When *string* has a brace that is not closed or not opened, an unknown key code (`{INS}` and `{F17}` included), a count in braces that is not a whole number from 0 to 8,175, unbalanced parentheses, or a modifier with nothing after it (`++`), VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*, instead. + +> [!NOTE] BETA 1010 +> When *wait* is **Null**, VB6 and 64-bit VBA raise error [94 (`&H5E`)](tb:Errors#94), *Invalid use of Null*, instead. + +> [!NOTE] BETA 1010 +> When *wait* is a string that is not a **Boolean**, VB6 and 64-bit VBA raise error [13 (`&HD`)](tb:Errors#13), *Type mismatch*, instead. + + ### Example diff --git a/docs/Reference/Default/VBA/Interaction/Shell.md b/docs/Reference/Default/VBA/Interaction/Shell.md index 4eb25e8c..d0d6e27f 100644 --- a/docs/Reference/Default/VBA/Interaction/Shell.md +++ b/docs/Reference/Default/VBA/Interaction/Shell.md @@ -9,7 +9,10 @@ vba_attribution: true # Shell {: .no_toc } -Runs an executable program asynchronously and returns a **Double** containing the new process's task ID, or zero if the program could not be started. +Runs an executable program asynchronously and returns a **Double** containing the new process's task ID. + + + Syntax: **Shell(** *pathname* [ **,** *windowstyle* ] **)** @@ -24,6 +27,28 @@ If **Shell** successfully launches the named program, it returns the new process > [!NOTE] > By default, **Shell** runs other programs *asynchronously*: a program started with **Shell** may not have finished --- or even fully started --- by the time the statements following **Shell** are executed. To wait for the program to finish, retain the returned task ID and poll the process via the Win32 `OpenProcess`/`WaitForSingleObject` APIs (or use a higher-level helper). + +### Common Errors + +| Error | When | +|---|---| +| [94 (`&H5E`)](tb:Errors#94), *Invalid use of Null* | *pathname* or *windowstyle* is **Null** | +| [-2147467259 (`&H80004005`)](tb:Errors#-2147467259), *Unspecified error* | *pathname* is a zero-length string or spaces, names a folder or a file that is not a program, or is longer than 32,767 characters
the program, or a folder in its path, does not exist, or *pathname* opens a quotation mark it does not close
*windowstyle* is less than 0 or greater than 10 after rounding | + +> [!NOTE] BETA 1010 +> When *pathname* is a zero-length string or spaces, names a folder or a file that is not a program, or is longer than 32,767 characters, VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*, instead. + +> [!NOTE] BETA 1010 +> When the program, or a folder in its path, does not exist, or *pathname* opens a quotation mark it does not close, VB6 and 64-bit VBA raise error [53 (`&H35`)](tb:Errors#53), *File not found*, instead. + +> [!NOTE] BETA 1010 +> When *windowstyle* is less than 0 or greater than 10 after rounding, VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*, instead. + +> [!NOTE] BETA 1010 +> When *windowstyle* is 10 after rounding (`SW_SHOWDEFAULT`, which a new program's start-up information may not hold), VB6 and 64-bit VBA raise error [5 (`&H5`)](tb:Errors#5), *Invalid procedure call or argument*; twinBASIC raises none. + + + ### Example This example uses **Shell** to run Notepad with a normal-sized focused window. diff --git a/docs/Reference/Run-time-Errors.md b/docs/Reference/Run-time-Errors.md index 7941a983..40b86884 100644 --- a/docs/Reference/Run-time-Errors.md +++ b/docs/Reference/Run-time-Errors.md @@ -45,7 +45,7 @@ The messages are those of twinBASIC 32-bit and VB6, which agree for every number |---|---|---| | **3**{: #3 } (`&H3`) | *Return without GoSub* | --- | | **5**{: #5 } (`&H5`) | *Invalid procedure call or argument* | [38 pages](#listed-5) | -| **6**{: #6 } (`&H6`) | *Overflow* | [23 pages](#listed-6) | +| **6**{: #6 } (`&H6`) | *Overflow* | [24 pages](#listed-6) | | **7**{: #7 } (`&H7`) | *Out of memory* | --- | | **9**{: #9 } (`&H9`) | *Subscript out of range* | [4 pages](#listed-9) | | **10**{: #10 } (`&HA`) | *This array is fixed or temporarily locked* | --- | @@ -82,7 +82,7 @@ The messages are those of twinBASIC 32-bit and VB6, which agree for every number | **91**{: #91 } (`&H5B`) | *Object variable or With block variable not set* | [2 pages](#listed-91) | | **92**{: #92 } (`&H5C`) | *For loop not initialized* | --- | | **93**{: #93 } (`&H5D`) | *Invalid pattern string* | --- | -| **94**{: #94 } (`&H5E`) | *Invalid use of Null* | [95 pages](#listed-94) | +| **94**{: #94 } (`&H5E`) | *Invalid use of Null* | [100 pages](#listed-94) | | **96**{: #96 } (`&H60`) | *Unable to sink events of object because the object is already firing events to the maximum number of event receivers that it supports* | --- | | **97**{: #97 } (`&H61`) | *Can not call friend function on object which is not an instance of defining class* | --- | | **98**{: #98 } (`&H62`) | *A property or method call cannot include a reference to a private object, either as an argument or as a return value* | --- | @@ -131,8 +131,8 @@ The messages are those of twinBASIC 32-bit and VB6, which agree for every number | **744**{: #744 } (`&H2E8`) | *Search text not found* | --- | | **746**{: #746 } (`&H2EA`) | *Replacements too long* | --- | | **-2147467262**{: #-2147467262 } (`&H80004002`) | *No such interface supported*; **Error** gives *Application-defined or object-defined error* | [1 page](#listed--2147467262) | -| **-2147467259**{: #-2147467259 } (`&H80004005`) | *Unspecified error*; **Error** gives *Application-defined or object-defined error* | [16 pages](#listed--2147467259) | -| **-2147352567**{: #-2147352567 } (`&H80020009`) | *Exception occurred.*; **Error** gives *Application-defined or object-defined error* | [1 page](#listed--2147352567) | +| **-2147467259**{: #-2147467259 } (`&H80004005`) | *Unspecified error*; **Error** gives *Application-defined or object-defined error* | [20 pages](#listed--2147467259) | +| **-2147352567**{: #-2147352567 } (`&H80020009`) | *Exception occurred.*; **Error** gives *Application-defined or object-defined error* | [2 pages](#listed--2147352567) | | **-2147352562**{: #-2147352562 } (`&H8002000E`) | *Invalid number of parameters.*; **Error** gives *Application-defined or object-defined error* | [2 pages](#listed--2147352562) | | **-2147352559**{: #-2147352559 } (`&H80020011`) | *Does not support a collection.*; **Error** gives *Application-defined or object-defined error* | [1 page](#listed--2147352559) | | **-2147348207**{: #-2147348207 } (`&H80021111`) | *Automation error*; **Error** gives *Application-defined or object-defined error* | [1 page](#listed--2147348207) | @@ -147,7 +147,7 @@ The messages are those of twinBASIC 32-bit and VB6, which agree for every number **5**{: #listed-5 } (`&H5`): [Array](../tB/Modules/Information/Array), [Asc](../tB/Modules/Strings/Asc), [Chr](../tB/Modules/Strings/Chr), [CreateObject](../tB/Modules/Interaction/CreateObject), [CVErr](../tB/Modules/Conversion/CVErr), [DateAdd](../tB/Modules/DateTime/DateAdd), [DateDiff](../tB/Modules/DateTime/DateDiff), [DatePart](../tB/Modules/DateTime/DatePart), [DateSerial](../tB/Modules/DateTime/DateSerial), [Filter](../tB/Modules/Strings/Filter), [Format](../tB/Modules/Strings/Format), [FormatCurrency](../tB/Modules/Strings/FormatCurrency), [FormatDateTime](../tB/Modules/Strings/FormatDateTime), [FormatNumber](../tB/Modules/Strings/FormatNumber), [FormatPercent](../tB/Modules/Strings/FormatPercent), [GetObject](../tB/Modules/Interaction/GetObject), [InStr](../tB/Modules/Strings/InStr), [InStrRev](../tB/Modules/Strings/InStrRev), [Join](../tB/Modules/Strings/Join), [Left](../tB/Modules/Strings/Left), [Log](../tB/Modules/Math/Log), [Mid](../tB/Modules/Strings/Mid), [MonthName](../tB/Modules/Strings/MonthName), [QBColor](../tB/Modules/Information/QBColor), [Replace](../tB/Modules/Strings/Replace), [RGB](../tB/Modules/Information/RGB), [RGBA](../tB/Modules/Information/RGBA), [Right](../tB/Modules/Strings/Right), [Round](../tB/Modules/Math/Round), [Space](../tB/Modules/Strings/Space), [Split](../tB/Modules/Strings/Split), [Sqr](../tB/Modules/Math/Sqr), [StrComp](../tB/Modules/Strings/StrComp), [StrConv](../tB/Modules/Strings/StrConv), [String](../tB/Modules/Strings/String), [TranslateColor](../tB/Modules/Information/TranslateColor), [Weekday](../tB/Modules/DateTime/Weekday), [WeekdayName](../tB/Modules/Strings/WeekdayName) -**6**{: #listed-6 } (`&H6`): [Abs](../tB/Modules/Math/Abs), [Bin](../tB/Modules/Conversion/Bin), [CBool](../tB/Modules/Conversion/CBool), [CByte](../tB/Modules/Conversion/CByte), [CCur](../tB/Modules/Conversion/CCur), [CDate](../tB/Modules/Conversion/CDate), [CDbl](../tB/Modules/Conversion/CDbl), [CDec](../tB/Modules/Conversion/CDec), [Choose](../tB/Modules/Interaction/Choose), [Chr](../tB/Modules/Strings/Chr), [CInt](../tB/Modules/Conversion/CInt), [CLng](../tB/Modules/Conversion/CLng), [CLngLng](../tB/Modules/Conversion/CLngLng), [CLngPtr](../tB/Modules/Conversion/CLngPtr), [CSng](../tB/Modules/Conversion/CSng), [CType](../tB/Modules/Conversion/CType), [DateAdd](../tB/Modules/DateTime/DateAdd), [DateDiff](../tB/Modules/DateTime/DateDiff), [Exp](../tB/Modules/Math/Exp), [Hex](../tB/Modules/Conversion/Hex), [Oct](../tB/Modules/Conversion/Oct), [Val](../tB/Modules/Conversion/Val), [ValDec](../tB/Modules/Conversion/ValDec) +**6**{: #listed-6 } (`&H6`): [Abs](../tB/Modules/Math/Abs), [Bin](../tB/Modules/Conversion/Bin), [CBool](../tB/Modules/Conversion/CBool), [CByte](../tB/Modules/Conversion/CByte), [CCur](../tB/Modules/Conversion/CCur), [CDate](../tB/Modules/Conversion/CDate), [CDbl](../tB/Modules/Conversion/CDbl), [CDec](../tB/Modules/Conversion/CDec), [Choose](../tB/Modules/Interaction/Choose), [Chr](../tB/Modules/Strings/Chr), [CInt](../tB/Modules/Conversion/CInt), [CLng](../tB/Modules/Conversion/CLng), [CLngLng](../tB/Modules/Conversion/CLngLng), [CLngPtr](../tB/Modules/Conversion/CLngPtr), [CSng](../tB/Modules/Conversion/CSng), [CType](../tB/Modules/Conversion/CType), [DateAdd](../tB/Modules/DateTime/DateAdd), [DateDiff](../tB/Modules/DateTime/DateDiff), [Exp](../tB/Modules/Math/Exp), [Hex](../tB/Modules/Conversion/Hex), [InputBox](../tB/Modules/Interaction/InputBox), [Oct](../tB/Modules/Conversion/Oct), [Val](../tB/Modules/Conversion/Val), [ValDec](../tB/Modules/Conversion/ValDec) **9**{: #listed-9 } (`&H9`): [Array](../tB/Modules/Information/Array), [LBound](../tB/Modules/Information/LBound), [ReDim](../tB/Core/ReDim), [UBound](../tB/Modules/Information/UBound) @@ -155,15 +155,15 @@ The messages are those of twinBASIC 32-bit and VB6, which agree for every number **91**{: #listed-91 } (`&H5B`): [RaiseEventByName](../tB/Modules/Interaction/RaiseEventByName), [RaiseEventByName2](../tB/Modules/Interaction/RaiseEventByName2) -**94**{: #listed-94 } (`&H5E`): [Asc](../tB/Modules/Strings/Asc), [Atn](../tB/Modules/Math/Atn), [Bin](../tB/Modules/Conversion/Bin), [Calendar](../tB/Modules/DateTime/Calendar), [CallByDispId](../tB/Modules/Interaction/CallByDispId), [CallByName](../tB/Modules/Interaction/CallByName), [CBool](../tB/Modules/Conversion/CBool), [CByte](../tB/Modules/Conversion/CByte), [CCur](../tB/Modules/Conversion/CCur), [CDate](../tB/Modules/Conversion/CDate), [CDbl](../tB/Modules/Conversion/CDbl), [CDec](../tB/Modules/Conversion/CDec), [Choose](../tB/Modules/Interaction/Choose), [Chr](../tB/Modules/Strings/Chr), [CInt](../tB/Modules/Conversion/CInt), [CLng](../tB/Modules/Conversion/CLng), [CLngLng](../tB/Modules/Conversion/CLngLng), [CLngPtr](../tB/Modules/Conversion/CLngPtr), [Cos](../tB/Modules/Math/Cos), [CreateObject](../tB/Modules/Interaction/CreateObject), [CSng](../tB/Modules/Conversion/CSng), [CStr](../tB/Modules/Conversion/CStr), [CType](../tB/Modules/Conversion/CType), [CVErr](../tB/Modules/Conversion/CVErr), [Date](../tB/Modules/DateTime/Date), [DateAdd](../tB/Modules/DateTime/DateAdd), [DateDiff](../tB/Modules/DateTime/DateDiff), [DatePart](../tB/Modules/DateTime/DatePart), [DateSerial](../tB/Modules/DateTime/DateSerial), [DateValue](../tB/Modules/DateTime/DateValue), [DeleteSetting](../tB/Modules/Interaction/DeleteSetting), [Environ](../tB/Modules/Interaction/Environ), [Error function](../tB/Modules/Conversion/Error), [Exp](../tB/Modules/Math/Exp), [Filter](../tB/Modules/Strings/Filter), [Format](../tB/Modules/Strings/Format), [FormatCurrency](../tB/Modules/Strings/FormatCurrency), [FormatDateTime](../tB/Modules/Strings/FormatDateTime), [FormatNumber](../tB/Modules/Strings/FormatNumber), [FormatPercent](../tB/Modules/Strings/FormatPercent), [GetAllSettings](../tB/Modules/Interaction/GetAllSettings), [GetObject](../tB/Modules/Interaction/GetObject), [GetSetting](../tB/Modules/Interaction/GetSetting), [Hex](../tB/Modules/Conversion/Hex), [InStr](../tB/Modules/Strings/InStr), [InStrRev](../tB/Modules/Strings/InStrRev), [Join](../tB/Modules/Strings/Join), [LBound](../tB/Modules/Information/LBound), [LCase](../tB/Modules/Strings/LCase), [Left](../tB/Modules/Strings/Left), [Log](../tB/Modules/Math/Log), [LTrim](../tB/Modules/Strings/LTrim), [MacID](../tB/Modules/Conversion/MacID), [Mid](../tB/Modules/Strings/Mid), [MonthName](../tB/Modules/Strings/MonthName), [Oct](../tB/Modules/Conversion/Oct), [QBColor](../tB/Modules/Information/QBColor), [Randomize](../tB/Modules/Math/Randomize), [Replace](../tB/Modules/Strings/Replace), [RGB](../tB/Modules/Information/RGB), [RGB_B](../tB/Modules/Information/RGB_B), [RGB_G](../tB/Modules/Information/RGB_G), [RGB_R](../tB/Modules/Information/RGB_R), [RGBA](../tB/Modules/Information/RGBA), [RGBA_A](../tB/Modules/Information/RGBA_A), [Right](../tB/Modules/Strings/Right), [Rnd](../tB/Modules/Math/Rnd), [Round](../tB/Modules/Math/Round), [RTrim](../tB/Modules/Strings/RTrim), [SaveSetting](../tB/Modules/Interaction/SaveSetting), [Sgn](../tB/Modules/Math/Sgn), [ShiftRotateLeft](../tB/Modules/Math/ShiftRotateLeft), [ShiftRotateRight](../tB/Modules/Math/ShiftRotateRight), [ShiftUnsignedRight](../tB/Modules/Math/ShiftUnsignedRight), [Sin](../tB/Modules/Math/Sin), [Space](../tB/Modules/Strings/Space), [Split](../tB/Modules/Strings/Split), [Sqr](../tB/Modules/Math/Sqr), [Str](../tB/Modules/Conversion/Str), [StrComp](../tB/Modules/Strings/StrComp), [StrConv](../tB/Modules/Strings/StrConv), [String](../tB/Modules/Strings/String), [StrReverse](../tB/Modules/Strings/StrReverse), [Tan](../tB/Modules/Math/Tan), [Time](../tB/Modules/DateTime/Time), [TimeSerial](../tB/Modules/DateTime/TimeSerial), [TimeValue](../tB/Modules/DateTime/TimeValue), [TranslateColor](../tB/Modules/Information/TranslateColor), [Trim](../tB/Modules/Strings/Trim), [UBound](../tB/Modules/Information/UBound), [UCase](../tB/Modules/Strings/UCase), [Val](../tB/Modules/Conversion/Val), [ValDec](../tB/Modules/Conversion/ValDec), [Weekday](../tB/Modules/DateTime/Weekday), [WeekdayName](../tB/Modules/Strings/WeekdayName) +**94**{: #listed-94 } (`&H5E`): [AppActivate](../tB/Modules/Interaction/AppActivate), [Asc](../tB/Modules/Strings/Asc), [Atn](../tB/Modules/Math/Atn), [Bin](../tB/Modules/Conversion/Bin), [Calendar](../tB/Modules/DateTime/Calendar), [CallByDispId](../tB/Modules/Interaction/CallByDispId), [CallByName](../tB/Modules/Interaction/CallByName), [CBool](../tB/Modules/Conversion/CBool), [CByte](../tB/Modules/Conversion/CByte), [CCur](../tB/Modules/Conversion/CCur), [CDate](../tB/Modules/Conversion/CDate), [CDbl](../tB/Modules/Conversion/CDbl), [CDec](../tB/Modules/Conversion/CDec), [Choose](../tB/Modules/Interaction/Choose), [Chr](../tB/Modules/Strings/Chr), [CInt](../tB/Modules/Conversion/CInt), [CLng](../tB/Modules/Conversion/CLng), [CLngLng](../tB/Modules/Conversion/CLngLng), [CLngPtr](../tB/Modules/Conversion/CLngPtr), [Cos](../tB/Modules/Math/Cos), [CreateObject](../tB/Modules/Interaction/CreateObject), [CSng](../tB/Modules/Conversion/CSng), [CStr](../tB/Modules/Conversion/CStr), [CType](../tB/Modules/Conversion/CType), [CVErr](../tB/Modules/Conversion/CVErr), [Date](../tB/Modules/DateTime/Date), [DateAdd](../tB/Modules/DateTime/DateAdd), [DateDiff](../tB/Modules/DateTime/DateDiff), [DatePart](../tB/Modules/DateTime/DatePart), [DateSerial](../tB/Modules/DateTime/DateSerial), [DateValue](../tB/Modules/DateTime/DateValue), [DeleteSetting](../tB/Modules/Interaction/DeleteSetting), [Environ](../tB/Modules/Interaction/Environ), [Error function](../tB/Modules/Conversion/Error), [Exp](../tB/Modules/Math/Exp), [Filter](../tB/Modules/Strings/Filter), [Format](../tB/Modules/Strings/Format), [FormatCurrency](../tB/Modules/Strings/FormatCurrency), [FormatDateTime](../tB/Modules/Strings/FormatDateTime), [FormatNumber](../tB/Modules/Strings/FormatNumber), [FormatPercent](../tB/Modules/Strings/FormatPercent), [GetAllSettings](../tB/Modules/Interaction/GetAllSettings), [GetObject](../tB/Modules/Interaction/GetObject), [GetSetting](../tB/Modules/Interaction/GetSetting), [Hex](../tB/Modules/Conversion/Hex), [InputBox](../tB/Modules/Interaction/InputBox), [InStr](../tB/Modules/Strings/InStr), [InStrRev](../tB/Modules/Strings/InStrRev), [Join](../tB/Modules/Strings/Join), [LBound](../tB/Modules/Information/LBound), [LCase](../tB/Modules/Strings/LCase), [Left](../tB/Modules/Strings/Left), [Log](../tB/Modules/Math/Log), [LTrim](../tB/Modules/Strings/LTrim), [MacID](../tB/Modules/Conversion/MacID), [Mid](../tB/Modules/Strings/Mid), [MonthName](../tB/Modules/Strings/MonthName), [MsgBox](../tB/Modules/Interaction/MsgBox), [Oct](../tB/Modules/Conversion/Oct), [QBColor](../tB/Modules/Information/QBColor), [Randomize](../tB/Modules/Math/Randomize), [Replace](../tB/Modules/Strings/Replace), [RGB](../tB/Modules/Information/RGB), [RGB_B](../tB/Modules/Information/RGB_B), [RGB_G](../tB/Modules/Information/RGB_G), [RGB_R](../tB/Modules/Information/RGB_R), [RGBA](../tB/Modules/Information/RGBA), [RGBA_A](../tB/Modules/Information/RGBA_A), [Right](../tB/Modules/Strings/Right), [Rnd](../tB/Modules/Math/Rnd), [Round](../tB/Modules/Math/Round), [RTrim](../tB/Modules/Strings/RTrim), [SaveSetting](../tB/Modules/Interaction/SaveSetting), [SendKeys](../tB/Modules/Interaction/SendKeys), [Sgn](../tB/Modules/Math/Sgn), [Shell](../tB/Modules/Interaction/Shell), [ShiftRotateLeft](../tB/Modules/Math/ShiftRotateLeft), [ShiftRotateRight](../tB/Modules/Math/ShiftRotateRight), [ShiftUnsignedRight](../tB/Modules/Math/ShiftUnsignedRight), [Sin](../tB/Modules/Math/Sin), [Space](../tB/Modules/Strings/Space), [Split](../tB/Modules/Strings/Split), [Sqr](../tB/Modules/Math/Sqr), [Str](../tB/Modules/Conversion/Str), [StrComp](../tB/Modules/Strings/StrComp), [StrConv](../tB/Modules/Strings/StrConv), [String](../tB/Modules/Strings/String), [StrReverse](../tB/Modules/Strings/StrReverse), [Tan](../tB/Modules/Math/Tan), [Time](../tB/Modules/DateTime/Time), [TimeSerial](../tB/Modules/DateTime/TimeSerial), [TimeValue](../tB/Modules/DateTime/TimeValue), [TranslateColor](../tB/Modules/Information/TranslateColor), [Trim](../tB/Modules/Strings/Trim), [UBound](../tB/Modules/Information/UBound), [UCase](../tB/Modules/Strings/UCase), [Val](../tB/Modules/Conversion/Val), [ValDec](../tB/Modules/Conversion/ValDec), [Weekday](../tB/Modules/DateTime/Weekday), [WeekdayName](../tB/Modules/Strings/WeekdayName) **438**{: #listed-438 } (`&H1B6`): [CallByDispId](../tB/Modules/Interaction/CallByDispId), [CallByName](../tB/Modules/Interaction/CallByName) **-2147467262**{: #listed--2147467262 } (`&H80004002`): [GetObject](../tB/Modules/Interaction/GetObject) -**-2147467259**{: #listed--2147467259 } (`&H80004005`): [Calendar](../tB/Modules/DateTime/Calendar), [CallByDispId](../tB/Modules/Interaction/CallByDispId), [CallByName](../tB/Modules/Interaction/CallByName), [Date](../tB/Modules/DateTime/Date), [DeleteSetting](../tB/Modules/Interaction/DeleteSetting), [Environ](../tB/Modules/Interaction/Environ), [GetAllSettings](../tB/Modules/Interaction/GetAllSettings), [GetObject](../tB/Modules/Interaction/GetObject), [GetSetting](../tB/Modules/Interaction/GetSetting), [LBound](../tB/Modules/Information/LBound), [Partition](../tB/Modules/Interaction/Partition), [ReDim](../tB/Core/ReDim), [SaveSetting](../tB/Modules/Interaction/SaveSetting), [Switch](../tB/Modules/Interaction/Switch), [Time](../tB/Modules/DateTime/Time), [UBound](../tB/Modules/Information/UBound) +**-2147467259**{: #listed--2147467259 } (`&H80004005`): [AppActivate](../tB/Modules/Interaction/AppActivate), [Calendar](../tB/Modules/DateTime/Calendar), [CallByDispId](../tB/Modules/Interaction/CallByDispId), [CallByName](../tB/Modules/Interaction/CallByName), [Date](../tB/Modules/DateTime/Date), [DeleteSetting](../tB/Modules/Interaction/DeleteSetting), [Environ](../tB/Modules/Interaction/Environ), [GetAllSettings](../tB/Modules/Interaction/GetAllSettings), [GetObject](../tB/Modules/Interaction/GetObject), [GetSetting](../tB/Modules/Interaction/GetSetting), [InputBox](../tB/Modules/Interaction/InputBox), [LBound](../tB/Modules/Information/LBound), [MsgBox](../tB/Modules/Interaction/MsgBox), [Partition](../tB/Modules/Interaction/Partition), [ReDim](../tB/Core/ReDim), [SaveSetting](../tB/Modules/Interaction/SaveSetting), [Shell](../tB/Modules/Interaction/Shell), [Switch](../tB/Modules/Interaction/Switch), [Time](../tB/Modules/DateTime/Time), [UBound](../tB/Modules/Information/UBound) -**-2147352567**{: #listed--2147352567 } (`&H80020009`): [CallByName](../tB/Modules/Interaction/CallByName) +**-2147352567**{: #listed--2147352567 } (`&H80020009`): [CallByName](../tB/Modules/Interaction/CallByName), [SendKeys](../tB/Modules/Interaction/SendKeys) **-2147352562**{: #listed--2147352562 } (`&H8002000E`): [CallByDispId](../tB/Modules/Interaction/CallByDispId), [CallByName](../tB/Modules/Interaction/CallByName) diff --git a/errors/VBA.Interaction.yml b/errors/VBA.Interaction.yml index ae6f1018..c4773fbf 100644 --- a/errors/VBA.Interaction.yml +++ b/errors/VBA.Interaction.yml @@ -1,4 +1,4 @@ -# The VBA Interaction module, its non-interactive procedures (batch 6a). Format: WIP.Errors.md. +# The VBA Interaction module: its non-interactive procedures (batch 6a) and its interactive ones (batch 6b). Format: WIP.Errors.md. beta: 1010 pages: Reference/Default/VBA/Interaction/Choose.md: @@ -445,3 +445,302 @@ pages: - { setup: 'SaveSetting registry_App, "S", "K", "V"', run: 'DeleteSetting registry_App, "S", "K"' } - { setup: 'SaveSetting registry_App, "S", "K", "V"', run: 'DeleteSetting registry_App, "S"' } - { setup: 'SaveSetting registry_App, "S", "K", "V"', run: DeleteSetting registry_App } + # Batch 6b: the interactive procedures, each under a harness that keeps its effect in the + # probe (WIP.Errors.md, Harnesses). Beep takes no argument: no case (owner, D3). + Reference/Default/VBA/Interaction/MsgBox.md: + harness: dialog + rows: + - error: 94 + when: "*prompt*, *buttons*, *title* or *context* is **Null**" + cases: + - MsgBox(Null) + - MsgBox("x", Null) + - MsgBox("x", 0, Null) + - MsgBox("x", 0, "t", "h.hlp", Null) + - error: 94 + when: "*helpfile* is **Null**" + vb6: 5 + bug: interaction-missing-argument-checks + cases: + - MsgBox("x", 0, "t", Null) + - error: -2147467259 + when: "*helpfile* is given without *context*" + vb6: 5 + bug: argument-errors-unspecified-error + cases: + - MsgBox("x", , , "h.hlp") + - error: 0 + when: "*context* is given without *helpfile*" + vb6: 5 + bug: interaction-missing-argument-checks + cases: + - MsgBox("x", , , , 5) + quiet: + - { run: "MsgBox \"x\"\ndialog_Expect 1" } + - { run: "Result = MsgBox(\"x\", vbYesNo)\ndialog_Expect 1\nIf Result <> vbYes Then Err.Raise 1001, , \"returned \" & Result" } + - { run: "Result = MsgBox(\"x\", vbOKCancel)\ndialog_Expect 1\nIf Result <> vbCancel Then Err.Raise 1001, , \"returned \" & Result" } + - MsgBox("x", 0) + - MsgBox("x", 5) + - MsgBox("x", 16) + - MsgBox("x", 64) + - MsgBox("x", 768) + - MsgBox("x", 12288) + - MsgBox("x", 16384) + - MsgBox("x", 65536) + - MsgBox("x", 524288) + - MsgBox("x", 1048576) + - MsgBox("x", &H1000000) + - MsgBox("x", vbYesNo + vbDefaultButton3) + # A style Windows refuses: no box, and 0 returned (VB shows an OK box); a bug, not an error. + - MsgBox("x", 7) + - MsgBox("x", 15) + - MsgBox("x", , , "h.hlp", 5) + - MsgBox("x", 0, "t", "", 5) + - MsgBox(String(100000, "a")) + - MsgBox("a" & Chr(0) & "b") + - MsgBox("x", 0, "") + - MsgBox("") + - MsgBox(Empty) + - MsgBox(123) + Reference/Default/VBA/Interaction/InputBox.md: + harness: dialog + rows: + - error: 94 + when: "*prompt*, *title*, *default*, *xpos*, *ypos* or *context* is **Null**" + cases: + - InputBox(Null) + - InputBox("x", Null) + - InputBox("x", , Null) + - InputBox("x", , , Null) + - InputBox("x", , , 0, Null) + - InputBox("x", , , , , "h.hlp", Null) + - error: 94 + when: "*helpfile* is **Null**" + vb6: 5 + bug: interaction-missing-argument-checks + cases: + - InputBox("x", , , , , Null) + - error: 6 + when: "*xpos* or *ypos* is outside the range of a **Long**" + cases: + - InputBox("x", , , 2147483648#, 0) + - InputBox("x", , , 1E+10, 0) + - InputBox("x", , , -1E+30, 0) + - InputBox("x", , , 0, 1E+30) + - error: 0 + when: "*xpos* or *ypos* is outside -32,768 to 32,767 after rounding, and inside the range of a **Long**" + vb6: 6 + bug: interaction-missing-argument-checks + cases: + - InputBox("x", , , 32768, 0) + - InputBox("x", , , 32767.6, 0) + - InputBox("x", , , -32769, 0) + - InputBox("x", , , 0, 32768) + - InputBox("x", , , 2147483647, 0) + - InputBox("x", , , -2147483648#, 0) + - error: -2147467259 + when: "*helpfile* is given without *context*" + vb6: 5 + bug: argument-errors-unspecified-error + cases: + - InputBox("x", , , , , "h.hlp") + - error: 0 + when: "*context* is given without *helpfile*" + vb6: 5 + bug: interaction-missing-argument-checks + cases: + - InputBox("x", , , , , , 5) + quiet: + - { run: "Result = InputBox(\"x\", , \"d\")\ndialog_Expect 1\nIf Result <> \"\" Then Err.Raise 1001, , \"returned \" & Result" } + - InputBox("x", , , 100) + - InputBox("x", , , , 100) + - InputBox("x", , , -1, -1) + - InputBox("x", , , 32767, -32768) + - InputBox("x", , , 32767.4, 0) + - InputBox("x", , , , , "h.hlp", 5) + - InputBox("x", , String(300, "d")) + - InputBox(String(100000, "a")) + - InputBox("") + - InputBox("x", "") + - InputBox(123) + Reference/Default/VBA/Interaction/SendKeys.md: + harness: keys + rows: + - error: 94 + when: "*string* is **Null**" + cases: + - { run: SendKeys Null } + - error: -2147352567 + when: "*string* has a brace that is not closed or not opened, an unknown key code (`{INS}` and `{F17}` included), a count in braces that is not a whole number from 0 to 8,175, unbalanced parentheses, or a modifier with nothing after it (`++`)" + vb6: 5 + bug: argument-errors-unspecified-error + cases: + - { run: 'SendKeys "{"' } + - { run: 'SendKeys "}"' } + - { run: 'SendKeys "{}"' } + - { run: 'SendKeys "{BAD}"' } + - { run: 'SendKeys "a{BAD}"' } + - { run: 'SendKeys "{INS}"' } + - { run: 'SendKeys "{F17}"' } + - { run: 'SendKeys "{LEFT x}"' } + - { run: 'SendKeys "{LEFT -1}"' } + - { run: 'SendKeys "{LEFT 32767}"' } + - { run: 'SendKeys "{a 8176}"' } + - { run: 'SendKeys "{a 1.5}"' } + - { run: 'SendKeys "{LEFT2}"' } + - { run: 'SendKeys "("' } + - { run: 'SendKeys ")"' } + - { run: 'SendKeys "+(a"' } + - { run: 'SendKeys "a)"' } + - { run: 'SendKeys "++"' } + - error: -2147352567 + when: "*wait* is **Null**" + vb6: 94 + bug: argument-errors-unspecified-error + cases: + - { run: 'SendKeys "a", Null' } + - error: -2147352567 + when: "*wait* is a string that is not a **Boolean**" + vb6: 13 + bug: argument-errors-unspecified-error + cases: + - { run: 'SendKeys "a", "x"' } + quiet: + # The first case after the refused ones sends the keys VB6 and VBA kept from them. + - { setup: "SendKeys \"\"\nkeys_Clear", run: "SendKeys \"\"\nkeys_Expect \"\"" } + - { run: "SendKeys \"a\"\nkeys_Expect \"41d 41u\"" } + - { run: "SendKeys \"A\"\nkeys_Expect \"10d 41d 41u 10u\"" } + - { run: "SendKeys 123\nkeys_Expect \"31d 31u 32d 32u 33d 33u\"" } + - { run: "SendKeys \"+(EC)\"\nkeys_Expect \"10d 45d 45u 43d 43u 10u\"" } + - { run: "SendKeys \"^%a\"\nkeys_Expect \"11d 12d 41d 41u 11u 12u\"" } + - { run: "SendKeys \"{+}{^}{%}{~}{(}{)}\"\nkeys_Expect \"10d BBd BBu 10u 10d 36d 36u 10u 10d 35d 35u 10u 10d C0d C0u 10u 10d 39d 39u 10u 10d 30d 30u 10u\"" } + - { run: "SendKeys \"{{}{}}\"\nkeys_Expect \"10d DBd DBu 10u 10d DDd DDu 10u\"" } + - { run: "SendKeys \"~\"\nkeys_Expect \"Dd Du\"" } + - { run: "SendKeys \"{LEFT 2}{h 3}\"\nkeys_Expect \"25d 25u 25d 25u 48d 48u 48d 48u 48d 48u\"" } + - { run: "SendKeys \"{LEFT 0}{a 0}\"\nkeys_Expect \"\"" } + - { run: "SendKeys \"{BS}{BKSP}{BACKSPACE}{BREAK}{CAPSLOCK}{DEL}{DELETE}{DOWN}{END}{ENTER}{ESC}{HELP}\"\nkeys_Expect \"8d 8u 8d 8u 8d 8u 3d 3u 14d 14u 2Ed 2Eu 2Ed 2Eu 28d 28u 23d 23u Dd Du 1Bd 1Bu 2Fd 2Fu\"" } + - { run: "SendKeys \"{HOME}{INSERT}{left}{NUMLOCK}{PGDN}{PGUP}{RIGHT}{SCROLLLOCK}{TAB}{UP}\"\nkeys_Expect \"24d 24u 2Dd 2Du 25d 25u 90d 90u 22d 22u 21d 21u 27d 27u 91d 91u 9d 9u 26d 26u\"" } + - { run: "SendKeys \"{F1}{F12}{F16}{PRTSC}\"\nkeys_Expect \"70d 70u 7Bd 7Bu 7Fd 7Fu 2Ad 2Au\"" } + - { run: "SendKeys \"{ENTER 2}\"\nkeys_Expect \"Dd Du Dd Du\"" } + - { run: 'SendKeys "{a 8175}"' } + - { run: 'SendKeys "{a 5000}{a 5000}"' } + - { run: "SendKeys \"{a 02}\"\nkeys_Expect \"41d 41u 41d 41u\"" } + - { run: "SendKeys \"a\", True\nkeys_Expect \"41d 41u\"" } + - { run: "SendKeys \"a\", False\nkeys_Expect \"41d 41u\"" } + - { run: "SendKeys \"a\", 2\nkeys_Expect \"41d 41u\"" } + # An extension (owner, 2026-10-27): VB6 and 64-bit VBA raise 13. + - { run: "SendKeys \"a\", \"True\"\nkeys_Expect \"41d 41u\"", only: tb } + Reference/Default/VBA/Interaction/AppActivate.md: + harness: window + rows: + - error: 94 + when: "*title* is **Null**" + cases: + - { run: AppActivate Null } + - error: -2147467259 + when: "no window has *title* as its title, or its beginning or end, and no process with *title* as its task ID has a window (0, a negative number, **True** and **Empty** included)" + vb6: 5 + bug: argument-errors-unspecified-error + cases: + - { run: AppActivate "xqzzy no such window" } + - { run: AppActivate 0 } + - { run: AppActivate -1 } + - { run: AppActivate 4 } + - { run: AppActivate 2147483647 } + - { run: AppActivate True } + - { run: AppActivate Empty } + - error: 0 + when: "the window *title* names is hidden" + vb6: 5 + bug: interaction-missing-argument-checks + cases: + - { setup: window_Hide, run: AppActivate window_Title() } + - error: 0 + when: "*wait* is **Null**" + vb6: 94 + bug: interaction-missing-argument-checks + cases: + - { run: "AppActivate window_Title(), Null" } + - error: 0 + when: "*wait* is a string that is not a **Boolean**" + vb6: 13 + bug: interaction-missing-argument-checks + cases: + - { run: "AppActivate window_Title(), \"x\"" } + quiet: + - { run: "AppActivate window_Title()\nIf Not window_Visible() Then Err.Raise 1001, , \"hidden\"" } + - { run: AppActivate LCase$(window_Title()) } + - { run: "AppActivate Left$(window_Title(), 12)" } + - { run: "AppActivate Mid$(window_Title(), 7)" } + - { run: AppActivate window_Pid() } + - { run: AppActivate CStr(window_Pid()) } + - { run: AppActivate CDbl(window_Pid()) } + - { setup: window_Minimize, run: "AppActivate window_Title()\nIf Not window_Minimized() Then Err.Raise 1001, , \"restored\"" } + - { run: "AppActivate window_Title(), False" } + # An extension (owner, 2026-10-27): VB6 raises 5; 64-bit VBA raises nothing, as twinBASIC. + - { run: AppActivate "", only: [tb, vba64] } + Reference/Default/VBA/Interaction/Shell.md: + rows: + - error: 94 + when: "*pathname* or *windowstyle* is **Null**" + cases: + - Shell(Null) + - Shell("cmd.exe /c exit", Null) + - error: -2147467259 + when: "*pathname* is a zero-length string or spaces, names a folder or a file that is not a program, or is longer than 32,767 characters" + vb6: 5 + bug: argument-errors-unspecified-error + cases: + - Shell("") + - Shell(" ") + - Shell(Environ$("windir")) + - Shell(Environ$("windir") & "\win.ini") + - Shell(String(33000, "a")) + - error: -2147467259 + when: "the program, or a folder in its path, does not exist, or *pathname* opens a quotation mark it does not close" + vb6: 53 + bug: argument-errors-unspecified-error + cases: + - Shell("nonexistent_tbdocs.exe") + - Shell("C:\nonexistent_tbdocs_dir\x.exe") + - Shell(String(300, "a")) + - Shell("""cmd.exe /c exit") + - error: -2147467259 + when: "*windowstyle* is less than 0 or greater than 10 after rounding" + vb6: 5 + bug: argument-errors-unspecified-error + cases: + - Shell("cmd.exe /c exit", 11) + - Shell("cmd.exe /c exit", -1) + - Shell("cmd.exe /c exit", 32767) + - Shell("cmd.exe /c exit", 32768) + - Shell("cmd.exe /c exit", 2147483647) + - error: 0 + when: "*windowstyle* is 10 after rounding (`SW_SHOWDEFAULT`, which a new program's start-up information may not hold)" + vb6: 5 + bug: interaction-missing-argument-checks + cases: + - Shell("cmd.exe /c exit", 10) + - Shell("cmd.exe /c exit", 9.6) + - Shell("cmd.exe /c exit", CInt(10)) + quiet: + - Shell("cmd.exe /c exit") + - Shell("cmd.exe /c exit", vbHide) + - Shell("cmd.exe /c exit", 1) + - Shell("cmd.exe /c exit", 2) + - Shell("cmd.exe /c exit", 3) + - Shell("cmd.exe /c exit", 4) + - Shell("cmd.exe /c exit", 5) + - Shell("cmd.exe /c exit", 6) + - Shell("cmd.exe /c exit", 7) + - Shell("cmd.exe /c exit", 8) + - Shell("cmd.exe /c exit", 9) + - Shell("cmd.exe /c exit", 9.4) + - Shell("cmd.exe /c exit", -0.4) + - Shell("cmd /c exit", vbHide) + - Shell("""cmd.exe"" /c exit", vbHide) + - Shell(Environ$("windir") & "\System32\cmd.exe /c exit", vbHide) + Reference/Default/VBA/Interaction/DoEvents.md: + quiet: + - DoEvents() + - { run: DoEvents } diff --git a/errors/harnesses/dialog.bas b/errors/harnesses/dialog.bas new file mode 100644 index 00000000..f7f8bcae --- /dev/null +++ b/errors/harnesses/dialog.bas @@ -0,0 +1,329 @@ +' The dialog harness, for twinBASIC, VB6 and VBA alike: a case that calls MsgBox or InputBox +' runs with the box answered as soon as it is shown, so the real MessageBox and the real +' dialog run, and what they refuse is what the probe measures. dialog_Begin installs a WH_CBT +' hook on the probe's own thread: each top-level #32770 window the thread creates is noted, and +' when it is activated the hook hides it and sends it WM_COMMAND from a button, as a click +' does: Cancel (2) when it has a Cancel button, else its first push button that is not Help +' (9). It is sent, not posted: in Access a posted WM_COMMAND never reaches the box. Nor is the +' box ended with EndDialog, which skips the dialog procedure: twinBASIC's InputBox then +' returns a string it never set, and faults in OLEAUT32 (BETA 1010). Windows the hook did +' not see created (Access's own) are left alone. Each box answered is counted, with its +' title, its text and the button, for dialog_Expect. +' A style with MB_SERVICE_NOTIFICATION (&H200000), its NT 3.x form (&H40000) or +' MB_DEFAULT_DESKTOP_ONLY (&H20000) puts a message box on the user's desktop, where no thread +' hook sees it. So dialog_Begin also patches MessageBoxIndirectA and MessageBoxIndirectW, the +' ones the runtimes call (twinBASIC the W form, VB6 and VBA the A form), with a guard that +' refuses such a style, and passes any other to the real function (its bytes put back for the +' call); the six other MessageBox entry points, which no runtime calls, are refused whatever +' the style. dialog_End raises 1002 when the guard refused a box, so such a case never passes. +' dialog_End puts the bytes back and removes the hook. VBA7 is true in twinBASIC and in VBA 7; +' VB6 compiles only the #Else branches, so they hold what it cannot parse. + +#If VBA7 Then +Private Declare PtrSafe Function dialog_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As LongPtr +Private Declare PtrSafe Function dialog_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As LongPtr, ByVal Name As String) As LongPtr +Private Declare PtrSafe Function dialog_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As LongPtr, ByVal S As LongPtr, ByVal P As Long, ByRef Old As Long) As Long +Private Declare PtrSafe Sub dialog_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As LongPtr) +Private Declare PtrSafe Sub dialog_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare PtrSafe Function dialog_GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Long +Private Declare PtrSafe Function dialog_SetWindowsHookExA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr +Private Declare PtrSafe Function dialog_UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function dialog_CallNextHookEx Lib "user32" Alias "CallNextHookEx" (ByVal H As LongPtr, ByVal Code As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr +Private Declare PtrSafe Function dialog_GetClassNameA Lib "user32" Alias "GetClassNameA" (ByVal H As LongPtr, ByVal S As String, ByVal N As Long) As Long +Private Declare PtrSafe Function dialog_GetWindowTextA Lib "user32" Alias "GetWindowTextA" (ByVal H As LongPtr, ByVal S As String, ByVal N As Long) As Long +Private Declare PtrSafe Function dialog_GetDlgItem Lib "user32" Alias "GetDlgItem" (ByVal H As LongPtr, ByVal Id As Long) As LongPtr +Private Declare PtrSafe Function dialog_GetDlgCtrlID Lib "user32" Alias "GetDlgCtrlID" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function dialog_GetWindow Lib "user32" Alias "GetWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As LongPtr +Private Declare PtrSafe Function dialog_GetWindowLongA Lib "user32" Alias "GetWindowLongA" (ByVal H As LongPtr, ByVal I As Long) As Long +Private Declare PtrSafe Function dialog_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As Long +Private Declare PtrSafe Function dialog_SendMessageA Lib "user32" Alias "SendMessageA" (ByVal H As LongPtr, ByVal M As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr +Private Declare PtrSafe Function dialog_RealIndirectA Lib "user32" Alias "MessageBoxIndirectA" (ByVal P As LongPtr) As Long +Private Declare PtrSafe Function dialog_RealIndirectW Lib "user32" Alias "MessageBoxIndirectW" (ByVal P As LongPtr) As Long +#Else +Private Declare Function dialog_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As Long +Private Declare Function dialog_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As Long, ByVal Name As String) As Long +Private Declare Function dialog_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As Long, ByVal S As Long, ByVal P As Long, ByRef Old As Long) As Long +Private Declare Sub dialog_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As Long) +Private Declare Sub dialog_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare Function dialog_GetCurrentThreadId Lib "kernel32" Alias "GetCurrentThreadId" () As Long +Private Declare Function dialog_SetWindowsHookExA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long +Private Declare Function dialog_UnhookWindowsHookEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal H As Long) As Long +Private Declare Function dialog_CallNextHookEx Lib "user32" Alias "CallNextHookEx" (ByVal H As Long, ByVal Code As Long, ByVal W As Long, ByVal L As Long) As Long +Private Declare Function dialog_GetClassNameA Lib "user32" Alias "GetClassNameA" (ByVal H As Long, ByVal S As String, ByVal N As Long) As Long +Private Declare Function dialog_GetWindowTextA Lib "user32" Alias "GetWindowTextA" (ByVal H As Long, ByVal S As String, ByVal N As Long) As Long +Private Declare Function dialog_GetDlgItem Lib "user32" Alias "GetDlgItem" (ByVal H As Long, ByVal Id As Long) As Long +Private Declare Function dialog_GetDlgCtrlID Lib "user32" Alias "GetDlgCtrlID" (ByVal H As Long) As Long +Private Declare Function dialog_GetWindow Lib "user32" Alias "GetWindow" (ByVal H As Long, ByVal Cmd As Long) As Long +Private Declare Function dialog_GetWindowLongA Lib "user32" Alias "GetWindowLongA" (ByVal H As Long, ByVal I As Long) As Long +Private Declare Function dialog_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As Long, ByVal Cmd As Long) As Long +Private Declare Function dialog_SendMessageA Lib "user32" Alias "SendMessageA" (ByVal H As Long, ByVal M As Long, ByVal W As Long, ByVal L As Long) As Long +Private Declare Function dialog_RealIndirectA Lib "user32" Alias "MessageBoxIndirectA" (ByVal P As Long) As Long +Private Declare Function dialog_RealIndirectW Lib "user32" Alias "MessageBoxIndirectW" (ByVal P As Long) As Long +#End If + +' Each address and window is kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. +' Targets 0 and 1 are MessageBoxIndirectA and W, the guarded ones; 2 to 7 are refused. +Private dialog_Targets(7) As Variant +Private dialog_Saved(95) As Byte +Private dialog_Hook As Variant +Private dialog_Noted(7) As Variant +Private dialog_Guarded As Long +' The boxes answered, and the last one's title, text and button. +Private dialog_Count As Long +Private dialog_Title As String +Private dialog_Text As String +Private dialog_Button As Long +' The style the last MessageBoxIndirect call was given. +Private dialog_Style As Long + +Private Function dialog_WindowText(ByVal H As Variant) As String + Dim S As String, N As Long + S = String$(1024, 0) + N = dialog_GetWindowTextA(H, S, 1024) + dialog_WindowText = Left$(S, N) +End Function + +' Notes a top-level window of class #32770 that the thread creates. +Private Sub dialog_Created(ByVal H As Variant, ByVal Style As Long) + Dim S As String, N As Long, I As Long + If (Style And &H40000000) <> 0 Then Exit Sub + S = String$(64, 0) + N = dialog_GetClassNameA(H, S, 64) + If Left$(S, N) <> "#32770" Then Exit Sub + For I = 0 To 7 + If IsEmpty(dialog_Noted(I)) Then + dialog_Noted(I) = H + Exit Sub + End If + Next +End Sub + +' Answers a noted window as it is activated: hides it, then ends it as the button. +Private Sub dialog_Activated(ByVal H As Variant) + Dim I As Long, C As Variant, Id As Long, T As Long + For I = 0 To 7 + If Not IsEmpty(dialog_Noted(I)) Then + If dialog_Noted(I) = H Then Exit For + End If + Next + If I > 7 Then Exit Sub + dialog_Noted(I) = Empty + If dialog_GetDlgItem(H, 2) <> 0 Then + Id = 2 + Else + C = dialog_GetWindow(H, 5) + Do While C <> 0 + T = dialog_GetWindowLongA(C, -16) And &HF& + If dialog_GetDlgCtrlID(C) <> 9 And (T = 0 Or T = 1) Then + If dialog_ClassOf(C) = "Button" Then + Id = dialog_GetDlgCtrlID(C) + Exit Do + End If + End If + C = dialog_GetWindow(C, 2) + Loop + End If + dialog_Count = dialog_Count + 1 + dialog_Title = dialog_WindowText(H) + C = dialog_GetDlgItem(H, 65535) + If C <> 0 Then dialog_Text = dialog_WindowText(C) Else dialog_Text = "" + dialog_Button = Id + dialog_ShowWindow H, 0 + dialog_SendMessageA H, &H111, Id, dialog_GetDlgItem(H, Id) +End Sub + +Private Function dialog_ClassOf(ByVal H As Variant) As String + Dim S As String, N As Long + S = String$(64, 0) + N = dialog_GetClassNameA(H, S, 64) + dialog_ClassOf = Left$(S, N) +End Function + +' A style the guard refuses: one that shows the box on another desktop. +Private Function dialog_Refused(ByVal Style As Long) As Boolean + dialog_Style = Style + If (Style And &H260000) = 0 Then Exit Function + dialog_Guarded = dialog_Guarded + 1 + dialog_SetLastError 87 + dialog_Refused = True +End Function + +' The six MessageBox entry points no runtime calls: refused, whatever the style. +Private Function dialog_Box4(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long) As Long + dialog_Refused &H200000 +End Function +Private Function dialog_Box5(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long, ByVal E As Long) As Long + dialog_Refused &H200000 +End Function +Private Function dialog_Box6(ByVal A As Long, ByVal B As Long, ByVal C As Long, ByVal D As Long, ByVal E As Long, ByVal F As Long) As Long + dialog_Refused &H200000 +End Function + +#If VBA7 Then +Private Function dialog_Address(ByVal A As LongPtr) As Variant + dialog_Address = A +End Function + +Private Function dialog_Cbt(ByVal Code As Long, ByVal W As LongPtr, ByVal L As LongPtr) As LongPtr + Dim Cs As LongPtr, Style As Long + If Code = 3 Then + dialog_CopyMemory Cs, ByVal L, LenB(Cs) + dialog_CopyMemory Style, ByVal Cs + 4 * LenB(Cs) + 16, 4 + dialog_Created W, Style + ElseIf Code = 5 Then + dialog_Activated W + End If + dialog_Cbt = dialog_CallNextHookEx(0, Code, W, L) +End Function + +' MSGBOXPARAMS: cbSize, then hwndOwner, hInstance, lpszText and lpszCaption, then dwStyle. +Private Function dialog_GuardA(ByVal P As LongPtr) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 4 * LenB(P) + LenB(P), 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 0, False + dialog_GuardA = dialog_RealIndirectA(P) + dialog_Put 0, True +End Function + +Private Function dialog_GuardW(ByVal P As LongPtr) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 4 * LenB(P) + LenB(P), 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 1, False + dialog_GuardW = dialog_RealIndirectW(P) + dialog_Put 1, True +End Function +#Else +Private Function dialog_Address(ByVal A As Long) As Variant + dialog_Address = A +End Function + +Private Function dialog_Cbt(ByVal Code As Long, ByVal W As Long, ByVal L As Long) As Long + Dim Cs As Long, Style As Long + If Code = 3 Then + dialog_CopyMemory Cs, ByVal L, 4 + dialog_CopyMemory Style, ByVal Cs + 32, 4 + dialog_Created W, Style + ElseIf Code = 5 Then + dialog_Activated W + End If + dialog_Cbt = dialog_CallNextHookEx(0, Code, W, L) +End Function + +Private Function dialog_GuardA(ByVal P As Long) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 20, 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 0, False + dialog_GuardA = dialog_RealIndirectA(P) + dialog_Put 0, True +End Function + +Private Function dialog_GuardW(ByVal P As Long) As Long + Dim Style As Long + dialog_CopyMemory Style, ByVal P + 20, 4 + If dialog_Refused(Style) Then Exit Function + dialog_Put 1, False + dialog_GuardW = dialog_RealIndirectW(P) + dialog_Put 1, True +End Function +#End If + +' Writes target I's jump (On) or its original bytes back (not On). +Private Sub dialog_Put(ByVal I As Long, ByVal IsOn As Boolean) + Static Jumps(95) As Byte + Dim N As Long, Old As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If IsEmpty(dialog_Targets(I)) Then Exit Sub + P = dialog_Targets(I) + If IsOn Then + dialog_CopyMemory ByVal P, Jumps(I * 12), N + Else + dialog_CopyMemory Jumps(I * 12), ByVal P, N + dialog_CopyMemory ByVal P, dialog_Saved(I * 12), N + End If +End Sub + +' The jump to Fn: mov eax, Fn; jmp eax, or in 64-bit code mov rax, Fn; jmp rax. +Private Sub dialog_Patch(ByVal I As Long, ByVal Name As String, ByVal Fn As Variant) + Dim B(11) As Byte, N As Long, Old As Long, Target As Variant + Target = dialog_GetProcAddress(dialog_GetModuleHandleA("user32"), Name) + If Target = 0 Then Exit Sub + #If Win64 Then + Dim F As LongPtr, P As LongPtr + F = Fn + B(0) = &H48: B(1) = &HB8 + dialog_CopyMemory B(2), F, 8 + B(10) = &HFF: B(11) = &HE0 + N = 12 + #Else + Dim F As Long, P As Long + F = Fn + B(0) = &HB8 + dialog_CopyMemory B(1), F, 4 + B(5) = &HFF: B(6) = &HE0 + N = 7 + #End If + P = Target + dialog_VirtualProtect P, N, &H40, Old + dialog_CopyMemory dialog_Saved(I * 12), ByVal P, N + dialog_CopyMemory ByVal P, B(0), N + dialog_Targets(I) = Target +End Sub + +Private Sub dialog_Begin() + Dim I As Long + dialog_Count = 0 + dialog_Guarded = 0 + dialog_Title = "" + dialog_Text = "" + dialog_Button = 0 + dialog_Style = 0 + For I = 0 To 7 + dialog_Noted(I) = Empty + dialog_Targets(I) = Empty + Next + dialog_Patch 0, "MessageBoxIndirectA", dialog_Address(AddressOf dialog_GuardA) + dialog_Patch 1, "MessageBoxIndirectW", dialog_Address(AddressOf dialog_GuardW) + dialog_Patch 2, "MessageBoxA", dialog_Address(AddressOf dialog_Box4) + dialog_Patch 3, "MessageBoxW", dialog_Address(AddressOf dialog_Box4) + dialog_Patch 4, "MessageBoxExA", dialog_Address(AddressOf dialog_Box5) + dialog_Patch 5, "MessageBoxExW", dialog_Address(AddressOf dialog_Box5) + dialog_Patch 6, "MessageBoxTimeoutA", dialog_Address(AddressOf dialog_Box6) + dialog_Patch 7, "MessageBoxTimeoutW", dialog_Address(AddressOf dialog_Box6) + dialog_Hook = dialog_SetWindowsHookExA(5, dialog_Address(AddressOf dialog_Cbt), 0, dialog_GetCurrentThreadId()) +End Sub + +Private Sub dialog_End() + Dim I As Long, N As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If dialog_Hook <> 0 Then dialog_UnhookWindowsHookEx dialog_Hook + dialog_Hook = 0 + For I = 7 To 0 Step -1 + If Not IsEmpty(dialog_Targets(I)) Then + P = dialog_Targets(I) + dialog_CopyMemory ByVal P, dialog_Saved(I * 12), N + dialog_Targets(I) = Empty + End If + Next + If dialog_Guarded <> 0 Then Err.Raise 1002, , "the guard refused a box for another desktop" +End Sub + +' Raises 1001 when the case did not show Count boxes. Does nothing when it has already raised. +Private Sub dialog_Expect(ByVal Count As Long) + If Err.Number <> 0 Then Exit Sub + If dialog_Count <> Count Then Err.Raise 1001, , dialog_Count & " boxes shown, not " & Count +End Sub diff --git a/errors/harnesses/keys.bas b/errors/harnesses/keys.bas new file mode 100644 index 00000000..1d973c1a --- /dev/null +++ b/errors/harnesses/keys.bas @@ -0,0 +1,208 @@ +' The keys harness, for twinBASIC, VB6 and VBA alike: a case that calls SendKeys runs with +' the calls that inject input replaced, so that the key events are recorded and none is sent. +' twinBASIC sends each key down and up with keybd_event; VB6 and VBA first set a journal +' playback hook (SetWindowsHookExW, WH_JOURNALPLAYBACK), which Windows refuses to a process +' without UIAccess, and then send one event at a time with SendInput. keys_Begin patches +' keybd_event and SendInput with fakes that record each event and succeed, and +' SetWindowsHookExA and W with one that refuses a journal playback hook (ERROR_ACCESS_DENIED, +' as Windows does) and passes any other hook to the real function (its bytes put back for +' the call). keys_End puts the bytes back. keys_Expect raises 1001 when the events recorded +' are not the ones given: each ``, down or up, space-separated +' ("10d 41d 41u 10u" for "+a"), or `U` for one SendInput sends +' as a character (KEYEVENTF_UNICODE). VBA7 is true in twinBASIC and in VBA 7; VB6 compiles +' only the #Else branches, so they hold what it cannot parse. + +#If VBA7 Then +Private Declare PtrSafe Function keys_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As LongPtr +Private Declare PtrSafe Function keys_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As LongPtr, ByVal Name As String) As LongPtr +Private Declare PtrSafe Function keys_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As LongPtr, ByVal S As LongPtr, ByVal P As Long, ByRef Old As Long) As Long +Private Declare PtrSafe Sub keys_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As LongPtr) +Private Declare PtrSafe Sub keys_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare PtrSafe Function keys_RealHookA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr +Private Declare PtrSafe Function keys_RealHookW Lib "user32" Alias "SetWindowsHookExW" (ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr +#Else +Private Declare Function keys_GetModuleHandleA Lib "kernel32" Alias "GetModuleHandleA" (ByVal Name As String) As Long +Private Declare Function keys_GetProcAddress Lib "kernel32" Alias "GetProcAddress" (ByVal H As Long, ByVal Name As String) As Long +Private Declare Function keys_VirtualProtect Lib "kernel32" Alias "VirtualProtect" (ByVal A As Long, ByVal S As Long, ByVal P As Long, ByRef Old As Long) As Long +Private Declare Sub keys_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef D As Any, ByRef S As Any, ByVal N As Long) +Private Declare Sub keys_SetLastError Lib "kernel32" Alias "SetLastError" (ByVal E As Long) +Private Declare Function keys_RealHookA Lib "user32" Alias "SetWindowsHookExA" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long +Private Declare Function keys_RealHookW Lib "user32" Alias "SetWindowsHookExW" (ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long +#End If + +' Each address is kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. +' Targets: 0 keybd_event, 1 SendInput, 2 SetWindowsHookExA, 3 SetWindowsHookExW. +Private keys_Targets(3) As Variant +Private keys_Saved(47) As Byte +Private keys_Jumps(47) As Byte +Private keys_Sent As String + +Private Sub keys_Record(ByVal Text As String) + If Len(keys_Sent) Then keys_Sent = keys_Sent & " " + keys_Sent = keys_Sent & Text +End Sub + +Private Sub keys_FakeEvent(ByVal Vk As Long, ByVal Scan As Long, ByVal Flags As Long, ByVal Extra As Long) + keys_Record Hex$(Vk And &HFF&) & IIf((Flags And 2) <> 0, "u", "d") +End Sub + +#If VBA7 Then +Private Function keys_Address(ByVal A As LongPtr) As Variant + keys_Address = A +End Function + +' INPUT: type, then (aligned to a pointer in 64-bit code) KEYBDINPUT: wVk, wScan, dwFlags. +Private Function keys_FakeInput(ByVal N As Long, ByVal P As LongPtr, ByVal Size As Long) As Long + Dim I As Long, Kind As Long, Vk As Integer, Scan As Integer, Flags As Long, At As LongPtr + For I = 0 To N - 1 + At = P + I * Size + keys_CopyMemory Kind, ByVal At, 4 + If Kind = 1 Then + At = At + LenB(P) + keys_CopyMemory Vk, ByVal At, 2 + keys_CopyMemory Scan, ByVal At + 2, 2 + keys_CopyMemory Flags, ByVal At + 4, 4 + keys_RecordInput Vk, Scan, Flags + End If + Next + keys_FakeInput = N +End Function + +Private Function keys_FakeHookA(ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 2, False + keys_FakeHookA = keys_RealHookA(Id, Fn, M, T) + keys_Put 2, True +End Function + +Private Function keys_FakeHookW(ByVal Id As Long, ByVal Fn As LongPtr, ByVal M As LongPtr, ByVal T As Long) As LongPtr + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 3, False + keys_FakeHookW = keys_RealHookW(Id, Fn, M, T) + keys_Put 3, True +End Function +#Else +Private Function keys_Address(ByVal A As Long) As Variant + keys_Address = A +End Function + +Private Function keys_FakeInput(ByVal N As Long, ByVal P As Long, ByVal Size As Long) As Long + Dim I As Long, Kind As Long, Vk As Integer, Scan As Integer, Flags As Long, At As Long + For I = 0 To N - 1 + At = P + I * Size + keys_CopyMemory Kind, ByVal At, 4 + If Kind = 1 Then + At = At + 4 + keys_CopyMemory Vk, ByVal At, 2 + keys_CopyMemory Scan, ByVal At + 2, 2 + keys_CopyMemory Flags, ByVal At + 4, 4 + keys_RecordInput Vk, Scan, Flags + End If + Next + keys_FakeInput = N +End Function + +Private Function keys_FakeHookA(ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 2, False + keys_FakeHookA = keys_RealHookA(Id, Fn, M, T) + keys_Put 2, True +End Function + +Private Function keys_FakeHookW(ByVal Id As Long, ByVal Fn As Long, ByVal M As Long, ByVal T As Long) As Long + If Id = 1 Then keys_SetLastError 5: Exit Function + keys_Put 3, False + keys_FakeHookW = keys_RealHookW(Id, Fn, M, T) + keys_Put 3, True +End Function +#End If + +' KEYEVENTF_KEYUP is 2, KEYEVENTF_UNICODE 4 (the character in wScan). +Private Sub keys_RecordInput(ByVal Vk As Integer, ByVal Scan As Integer, ByVal Flags As Long) + Dim UpDown As String + UpDown = IIf((Flags And 2) <> 0, "u", "d") + If (Flags And 4) <> 0 Then + keys_Record "U" & Hex$(Scan And &HFFFF&) & UpDown + Else + keys_Record Hex$(Vk And &HFF&) & UpDown + End If +End Sub + +' Writes target I's jump (IsOn) or its original bytes back (not IsOn). +Private Sub keys_Put(ByVal I As Long, ByVal IsOn As Boolean) + Dim N As Long + #If Win64 Then + Dim P As LongPtr + N = 12 + #Else + Dim P As Long + N = 7 + #End If + If IsEmpty(keys_Targets(I)) Then Exit Sub + P = keys_Targets(I) + If IsOn Then + keys_CopyMemory ByVal P, keys_Jumps(I * 12), N + Else + keys_CopyMemory ByVal P, keys_Saved(I * 12), N + End If +End Sub + +' The jump to Fn: mov eax, Fn; jmp eax, or in 64-bit code mov rax, Fn; jmp rax. +Private Sub keys_Patch(ByVal I As Long, ByVal Name As String, ByVal Fn As Variant) + Dim N As Long, Old As Long, Target As Variant + Target = keys_GetProcAddress(keys_GetModuleHandleA("user32"), Name) + If Target = 0 Then Exit Sub + #If Win64 Then + Dim F As LongPtr, P As LongPtr + F = Fn + keys_Jumps(I * 12) = &H48: keys_Jumps(I * 12 + 1) = &HB8 + keys_CopyMemory keys_Jumps(I * 12 + 2), F, 8 + keys_Jumps(I * 12 + 10) = &HFF: keys_Jumps(I * 12 + 11) = &HE0 + N = 12 + #Else + Dim F As Long, P As Long + F = Fn + keys_Jumps(I * 12) = &HB8 + keys_CopyMemory keys_Jumps(I * 12 + 1), F, 4 + keys_Jumps(I * 12 + 5) = &HFF: keys_Jumps(I * 12 + 6) = &HE0 + N = 7 + #End If + P = Target + keys_VirtualProtect P, N, &H40, Old + keys_CopyMemory keys_Saved(I * 12), ByVal P, N + keys_Targets(I) = Target + keys_Put I, True +End Sub + +Private Sub keys_Begin() + Dim I As Long + keys_Sent = "" + For I = 0 To 3 + keys_Targets(I) = Empty + Next + keys_Patch 0, "keybd_event", keys_Address(AddressOf keys_FakeEvent) + keys_Patch 1, "SendInput", keys_Address(AddressOf keys_FakeInput) + keys_Patch 2, "SetWindowsHookExA", keys_Address(AddressOf keys_FakeHookA) + keys_Patch 3, "SetWindowsHookExW", keys_Address(AddressOf keys_FakeHookW) +End Sub + +Private Sub keys_End() + Dim I As Long + For I = 3 To 0 Step -1 + keys_Put I, False + keys_Targets(I) = Empty + Next +End Sub + +' Forgets the events recorded so far. VB6 and VBA keep the keys of a string they refuse and send +' them with the next SendKeys: a case after a refused one sends those first (SendKeys "") and +' clears them, in its setup. +Private Sub keys_Clear() + keys_Sent = "" +End Sub + +' Raises 1001 when the events recorded are not Keys. Does nothing when the case has already raised. +Private Sub keys_Expect(ByVal Keys As String) + If Err.Number <> 0 Then Exit Sub + If keys_Sent <> Keys Then Err.Raise 1001, , "sent " & IIf(keys_Sent = "", "nothing", keys_Sent) +End Sub diff --git a/errors/harnesses/window.bas b/errors/harnesses/window.bas new file mode 100644 index 00000000..8108dfe6 --- /dev/null +++ b/errors/harnesses/window.bas @@ -0,0 +1,66 @@ +' The window harness, for twinBASIC, VB6 and VBA alike: a case that calls AppActivate has a +' window to activate. window_Begin creates a visible top-level window of the probe's own +' thread, titled window_Title (tbdocsErrorsProbe and the process id, so that runtimes run at +' once never share one), and window_End destroys it. window_Pid is the probe's process id, +' the task id Shell would return for it; window_Hide hides the window for a case. The real +' activation runs: on the private desktop the window never becomes the foreground one, and +' AppActivate raises nothing for that in any runtime (BETA 1010), so nothing is patched. +' VBA7 is true in twinBASIC and in VBA 7; VB6 compiles only the #Else branch. + +#If VBA7 Then +Private Declare PtrSafe Function window_CreateWindowExA Lib "user32" Alias "CreateWindowExA" (ByVal Ex As Long, ByVal Cls As String, ByVal Title As String, ByVal Style As Long, ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long, ByVal Parent As LongPtr, ByVal Menu As LongPtr, ByVal Inst As LongPtr, ByVal P As LongPtr) As LongPtr +Private Declare PtrSafe Function window_DestroyWindow Lib "user32" Alias "DestroyWindow" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function window_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As LongPtr, ByVal Cmd As Long) As Long +Private Declare PtrSafe Function window_IsWindowVisible Lib "user32" Alias "IsWindowVisible" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function window_IsIconic Lib "user32" Alias "IsIconic" (ByVal H As LongPtr) As Long +Private Declare PtrSafe Function window_GetCurrentProcessId Lib "kernel32" Alias "GetCurrentProcessId" () As Long +#Else +Private Declare Function window_CreateWindowExA Lib "user32" Alias "CreateWindowExA" (ByVal Ex As Long, ByVal Cls As String, ByVal Title As String, ByVal Style As Long, ByVal X As Long, ByVal Y As Long, ByVal W As Long, ByVal H As Long, ByVal Parent As Long, ByVal Menu As Long, ByVal Inst As Long, ByVal P As Long) As Long +Private Declare Function window_DestroyWindow Lib "user32" Alias "DestroyWindow" (ByVal H As Long) As Long +Private Declare Function window_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal H As Long, ByVal Cmd As Long) As Long +Private Declare Function window_IsWindowVisible Lib "user32" Alias "IsWindowVisible" (ByVal H As Long) As Long +Private Declare Function window_IsIconic Lib "user32" Alias "IsIconic" (ByVal H As Long) As Long +Private Declare Function window_GetCurrentProcessId Lib "kernel32" Alias "GetCurrentProcessId" () As Long +#End If + +' The window, kept in a Variant: a LongPtr in twinBASIC and VBA 7, a Long in VB6. +Private window_Handle As Variant + +Private Function window_Title() As String + window_Title = "tbdocsErrorsProbe" & window_GetCurrentProcessId() +End Function + +Private Function window_Pid() As Long + window_Pid = window_GetCurrentProcessId() +End Function + +' Whether the window is visible now, and whether it is minimized. +Private Function window_Visible() As Boolean + window_Visible = window_IsWindowVisible(window_Handle) <> 0 +End Function + +Private Function window_Minimized() As Boolean + window_Minimized = window_IsIconic(window_Handle) <> 0 +End Function + +Private Sub window_Hide() + window_ShowWindow window_Handle, 0 +End Sub + +' SW_SHOWMINNOACTIVE: minimized, not activated. +Private Sub window_Minimize() + window_ShowWindow window_Handle, 7 +End Sub + +' A STATIC window, WS_OVERLAPPEDWINDOW, shown without being activated (SW_SHOWNA): created +' with WS_VISIBLE, which activates it, it takes 2 s to create from the third case on in +' twinBASIC (BETA 1010). +Private Sub window_Begin() + window_Handle = window_CreateWindowExA(0, "STATIC", window_Title(), &HCF0000, 0, 0, 300, 100, 0, 0, 0, 0) + window_ShowWindow window_Handle, 8 +End Sub + +Private Sub window_End() + If window_Handle <> 0 Then window_DestroyWindow window_Handle + window_Handle = 0 +End Sub diff --git a/scripts/broker/src/Sources/BrokerServer.twin b/scripts/broker/src/Sources/BrokerServer.twin index bf349369..1dbff424 100644 --- a/scripts/broker/src/Sources/BrokerServer.twin +++ b/scripts/broker/src/Sources/BrokerServer.twin @@ -167,7 +167,7 @@ Module BrokerServer Connected c Else Drop c - mNeedListener = True + ListenNow End If Exit Sub End If @@ -198,10 +198,21 @@ Module BrokerServer c.ClientPid = pid BrokerText.Log "connection " & c.Id & " from pid " & pid ' The next client needs an instance of its own to connect to. - Listen False + ListenNow Read c End Sub + ' A new instance now, tried three times: an instance that fails (a client that connected + ' and left before ConnectNamedPipe, error 232) would otherwise leave the pipe with none + ' until the next tick, and a client that opens it then gets ERROR_FILE_NOT_FOUND. + Private Sub ListenNow() + Dim i As Long + For i = 1 To 3 + Listen False + If Not mNeedListener Then Exit Sub + Next + End Sub + Private Sub Read(ByVal c As BrokerConn) Dim e As Long RtlZeroMemory c.Block, OVERLAPPED_SPACE diff --git a/scripts/broker/tbbroker.twinproj b/scripts/broker/tbbroker.twinproj index 6c77771d..9b1c4b42 100644 Binary files a/scripts/broker/tbbroker.twinproj and b/scripts/broker/tbbroker.twinproj differ diff --git a/scripts/check_errors.mjs b/scripts/check_errors.mjs index f1b87cbb..5269e144 100644 --- a/scripts/check_errors.mjs +++ b/scripts/check_errors.mjs @@ -47,6 +47,8 @@ import { pagePath, probeCases, probeModule, + splitHarness, + vb6Unattended, readData, readMessageOutput, readMessages, @@ -360,6 +362,43 @@ for (const dialect of ["tb", "vb6", "vba"]) { !c5.some((l) => l.includes("_Begin")), ); } +{ + const split = splitHarness([ + "' head", + "#If VBA7 Then", + 'Private Declare PtrSafe Sub A Lib "k" ()', + "#End If", + "Private X As Long", + "' the first procedure", + "#If VBA7 Then", + "Private Function F(ByVal P As LongPtr) As Long", + "End Function", + "#End If", + "Private Sub G()", + "End Sub", + ]); + check( + "a harness splits before its first procedure, its comments and the #If it is in", + split.declarations.length === 5 && split.procedures[0] === "' the first procedure", + JSON.stringify(split), + ); + const two = probeModule( + probeCases([harnessed], "vb6"), + "vb6", + new Map([ + ["one", "Private A1 As Long\nPrivate Sub one_Begin()\nEnd Sub"], + ["two", "Private A2 As Long\nPrivate Sub two_Begin()\nEnd Sub"], + ]), + ).text.split("\r\n"); + check( + "every harness's declarations come before every harness's procedures", + two.indexOf("Private A2 As Long") < two.indexOf("Private Sub one_Begin()"), + ); + check( + "VB6 builds a probe without Unattended Execution only when a case is under the dialog harness", + vb6Unattended([{ harness: "clock" }, {}]) && !vb6Unattended([{}, { harness: "dialog" }]), + ); +} check( "a harness without its file under errors/harnesses/ is reported", (() => { diff --git a/scripts/errors.mjs b/scripts/errors.mjs index c5a487f2..fa1b36a8 100644 --- a/scripts/errors.mjs +++ b/scripts/errors.mjs @@ -59,6 +59,7 @@ import { spliceIndex, spliceSection, VB_NUMBERS, + vb6Unattended, } from "./lib/errors-data.mjs"; import { encodeAnsi, findVb6, NO_VB6, parseMakeLog, runRepro } from "./lib/vb6.mjs"; import { faultText } from "./lib/win-fault.mjs"; @@ -282,7 +283,9 @@ async function measure(runtime, cases, run) { async function runTb(dir, cases, arch, text) { const mod = writeTbTree(dir, cases, text); const args = [dir, "--exe", "--json", "--arch", arch]; - if (text !== undefined) args.push("--exe-run-timeout", "600"); + // A probe of many cases can outlast tbrun's limit for an exe: each AppActivate case takes + // about 1.5 s in twinBASIC (BETA 1010). VB6 and VBA have 120 s too. + args.push("--exe-run-timeout", text !== undefined ? "600" : "120"); if (values.ide) args.push("--ide", values.ide); const r = await runNode(args); if (r.code === 1) { @@ -311,7 +314,10 @@ async function runVb6(dir, cases, vb6, text) { const mod = writeVb6Project(dir, cases, text); let r; try { - r = await runRepro(vb6, dir, { timeoutMs: text === undefined ? 120000 : 600000 }); + r = await runRepro(vb6, dir, { + timeoutMs: text === undefined ? 120000 : 600000, + unattended: vb6Unattended(cases), + }); } catch (e) { return { harness: e.message.split("\n")[0] }; } @@ -459,7 +465,8 @@ for (const c of [...all.values()].sort((a, b) => a.id - b.id)) { if (r.refused) wrong.push(`${rt} refused it: ${r.refused}`); else if (r.missing) wrong.push(`${rt} reported nothing`); else if (r.setup) wrong.push(`${rt}: its setup raised ${r.number}, ${r.description}`); - else if (r.number !== mine.expect) wrong.push(`${rt} raised ${r.number}, the data says ${mine.expect}`); + else if (r.number !== mine.expect) + wrong.push(`${rt} raised ${r.number}${r.description ? ` (${r.description})` : ""}, the data says ${mine.expect}`); else if (r.number !== 0) { const want = expectedDescription(mine.row, rt, r.number, messages); if (want !== null && r.description !== want) { diff --git a/scripts/lib/errors-data.mjs b/scripts/lib/errors-data.mjs index caf02428..ca67fba0 100644 --- a/scripts/lib/errors-data.mjs +++ b/scripts/lib/errors-data.mjs @@ -14,6 +14,15 @@ export const ERRORS_DIR = path.join(REPO_ROOT, "errors"); export const MESSAGES_FILE = "messages.yml"; /** The harnesses, errors/harnesses/.bas: module-level code a case can run under (WIP.Errors.md). */ export const HARNESS_DIR = "harnesses"; + +/** + * The harnesses whose cases show a box: VB6 builds their probe without Unattended Execution, + * under which MsgBox writes to the event log and shows nothing (lib/vb6.mjs, 9). + */ +export const ATTENDED_HARNESSES = new Set(["dialog"]); + +/** Whether VB6 builds the probe of `cases` with Unattended Execution: when no case shows a box. */ +export const vb6Unattended = (cases) => !cases.some((c) => ATTENDED_HARNESSES.has(c.harness)); const HARNESS_NAME = /^[a-z][a-z0-9]*$/; const ROW_KEYS = new Set(["error", "when", "cases", "vb6", "win64", "vba64", "bug", "message", "harness"]); @@ -313,11 +322,16 @@ function caseLines(c, report) { */ export function probeModule(cases, dialect, harnesses = new Map()) { const used = [...new Set(cases.map((c) => c.harness).filter(Boolean))].sort(); - const harnessLines = used.flatMap((h) => { + // VB6 and VBA refuse a declaration after a procedure: every harness's declarations come + // first, then every harness's procedures. + const parts = used.map((h) => { if (!harnesses.has(h)) throw new Error(`no code for harness ${h}`); - const text = harnesses.get(h).replace(/\r/g, "").replace(/\n+$/, ""); - return [`' ---- harness ${h}: errors/${HARNESS_DIR}/${h}.bas`, ...text.split("\n")]; + return [h, splitHarness(harnesses.get(h).replace(/\r/g, "").replace(/\n+$/, "").split("\n"))]; }); + const harnessLines = [ + ...parts.flatMap(([h, p]) => [`' ---- harness ${h}: errors/${HARNESS_DIR}/${h}.bas`, ...p.declarations]), + ...parts.flatMap(([h, p]) => (p.procedures.length ? [`' ---- harness ${h}, its procedures`, ...p.procedures] : [])), + ]; const head = dialect === "tb" ? [ @@ -367,6 +381,26 @@ export function probeModule(cases, dialect, harnesses = new Map()) { return { text: `${lines.join("\r\n")}\r\n`, spans }; } +const PROCEDURE_START = /^\s*(?:(?:Public|Private|Friend)\s+)?(?:Static\s+)?(?:Sub|Function|Property)\s/i; + +/** + * A harness's lines, split before its first procedure: `declarations` and `procedures`. The + * split goes back over the comments just before that procedure, and to the `#If` it is inside + * when it is in one, so that no conditional block is cut in two. + */ +export function splitHarness(lines) { + let at = lines.findIndex((l) => PROCEDURE_START.test(l)); + if (at < 0) return { declarations: lines, procedures: [] }; + const open = []; + for (let i = 0; i < at; i++) { + if (/^\s*#If\b/i.test(lines[i])) open.push(i); + else if (/^\s*#End\s+If\b/i.test(lines[i])) open.pop(); + } + if (open.length) at = open[0]; + while (at > 0 && /^\s*'/.test(lines[at - 1])) at--; + return { declarations: lines.slice(0, at), procedures: lines.slice(at) }; +} + /** The code of each harness `cases` use, read from `dir`: Map name -> text. */ export function harnessCode(cases, dir = ERRORS_DIR) { const out = new Map(); diff --git a/scripts/lib/tb-broker.mjs b/scripts/lib/tb-broker.mjs index 602cf44f..f13fad8f 100644 --- a/scripts/lib/tb-broker.mjs +++ b/scripts/lib/tb-broker.mjs @@ -9,7 +9,8 @@ // // A client that cannot open the pipe starts the broker: it runs `tbbroker start`, which starts // the broker detached, out of this process's job and tree, waits until the pipe answers and -// exits; then the client connects again. +// exits; then the client connects again, for up to 5 s while the pipe has no instance free +// (openPipeRetrying). import { execFile } from "node:child_process"; import { existsSync } from "node:fs"; @@ -50,6 +51,21 @@ function openPipe(pipe) { }); } +// After `tbbroker start`, the pipe can be briefly without an instance waiting for a client +// (ENOENT), or have none free (EBUSY), when several clients start the broker at once: one +// that found no broker connects again, at a random short interval, for up to `ms`. +async function openPipeRetrying(pipe, ms = 5000) { + const until = Date.now() + ms; + for (;;) { + try { + return await openPipe(pipe); + } catch (e) { + if ((e.code !== "ENOENT" && e.code !== "EBUSY") || Date.now() > until) throw e; + await new Promise((r) => setTimeout(r, 50 + Math.floor(Math.random() * 100))); + } + } +} + /** * Start the broker unless it runs, with `tbbroker start`; resolves once the pipe answers. * `args` are the broker's options (--pipe, --prefix, --max, --ports, --log). @@ -87,7 +103,7 @@ export async function connectBroker({ pipe = DEFAULT_PIPE, client, start = true, } catch (e) { if (!start || (e.code !== "ENOENT" && e.code !== "EBUSY")) throw e; await startBroker({ exe, args: ["--pipe", full, ...args] }); - socket = await openPipe(full); + socket = await openPipeRetrying(full); } const b = new Broker(socket, full); const hello = await b.request({ op: "hello", client: client ?? path.basename(process.argv[1] ?? "node") }); diff --git a/scripts/lib/vb6.mjs b/scripts/lib/vb6.mjs index 39457465..a83e209a 100644 --- a/scripts/lib/vb6.mjs +++ b/scripts/lib/vb6.mjs @@ -59,7 +59,10 @@ // reproducer's or a batch of samples, starts as tbrun starts an exe, on a private // desktop inside a kill-on-close job: a box there is on no desktop anyone uses, the // launcher records it and closes it with OK, and the time limit ends an exe that -// still waits. +// still waits. runRepro's `unattended: false` builds a project without it too: +// scripts/errors.mjs passes it for a probe whose cases call MsgBox or InputBox under +// the dialog harness, because under Unattended Execution MsgBox writes to the event +// log and shows nothing, so the probe would measure the log, not the box. // // 10. A `project=form` FENCE GETS A BLANK Form1.frm, WITHOUT UNATTENDED EXECUTION (9). // A form a sample leaves loaded keeps the exe @@ -798,15 +801,32 @@ export function reproFiles(dir) { return { sources, others }; } +/** + * Whether a reproducer's VB6 project carries the dialog harness, a copy of + * errors/harnesses/dialog.bas (WIP.Errors.md), which answers every box its own thread opens + * and refuses one for another desktop: a source that defines `dialog_Begin`. Such a project + * may call `MsgBox` and `InputBox`, between `dialog_Begin` and `dialog_End`, and is built + * without Unattended Execution, under which a box would go to the event log instead. + */ +export function reproAnswersBoxes(dir) { + return reproFiles(dir).sources.some( + (name) => + /\.(?:bas|cls|frm|ctl)$/i.test(name) && + /^\s*Private\s+Sub\s+dialog_Begin\s*\(/im.test(decodeAnsi(readFileSync(path.join(dir, name)))), + ); +} + /** * What stops a reproducer's VB6 project from being built and run, or null: no * `Probe.vbp`, or a source that calls `MsgBox` or `InputBox`, which would open a * modal box on the desktop of whoever runs it (the check vb6run makes on a - * sample). Comments and string contents are not read. + * sample), unless the project carries the dialog harness (reproAnswersBoxes). + * Comments and string contents are not read. */ export function reproProblem(dir) { const { sources } = reproFiles(dir); if (!sources.includes(`${REPRO_PROJECT}.vbp`)) return `has no ${REPRO_PROJECT}.vbp`; + if (reproAnswersBoxes(dir)) return null; for (const name of sources) { if (/\.(?:vbp|frx|ctx)$/i.test(name)) continue; for (const { text, line } of logicalLines(decodeAnsi(readFileSync(path.join(dir, name))))) { @@ -920,13 +940,17 @@ async function runReproExe(work, title, timeoutMs, env = {}) { * boxes it opened and `logged` what the VB runtime logged for it (see 11 and 12 at the * top); a VB6 that did not finish building throws */ -export async function runRepro(vb6, dir, { timeoutMs = 30000, keep = false, env = {} } = {}) { +export async function runRepro( + vb6, + dir, + { timeoutMs = 30000, keep = false, env = {}, unattended: attended = true } = {}, +) { const work = mkdtempSync(path.join(tmpdir(), "bugrepro-vb6-")); try { for (const name of reproFiles(dir).sources) copyFileSync(path.join(dir, name), path.join(work, name)); const vbp = path.join(work, `${REPRO_PROJECT}.vbp`); const text = decodeAnsi(readFileSync(vbp)); - writeFileSync(vbp, encodeAnsi(unattended(text, !hasVisibleComponent(text)))); + writeFileSync(vbp, encodeAnsi(unattended(text, attended && !hasVisibleComponent(text) && !reproAnswersBoxes(dir)))); const made = await make(vb6, work, { project: REPRO_PROJECT }); if (made.timedOut || made.error) { throw new Error(`VB6 did not finish building${made.error ? `: ${made.error}` : " in time"}\n${made.log}`); diff --git a/scripts/lib/vba.mjs b/scripts/lib/vba.mjs index 8f07c89a..f5c9e8e7 100644 --- a/scripts/lib/vba.mjs +++ b/scripts/lib/vba.mjs @@ -32,6 +32,9 @@ // Run does not return once the box is answered, since the VBE stays in break mode waiting // for a person, so that Access is ended and the next job starts another. An error in the module's declarations stops it before // Main's first line, which the probe reports as `start`, so the two cannot be confused. +// A box ends Access only when it is seen at two polls in a row: the dialog harness +// (errors/harnesses/dialog.bas) answers the box MsgBox or InputBox shows as soon as it +// is activated, and a poll may catch it in that instant. A compile error's box stays. // 6. THE MODULE IS READ IN THE ANSI CODE PAGE, as VB6 reads its own, and out.txt is // written in it. @@ -268,6 +271,7 @@ export class VbaSession { const start = Date.now(); let timedOut = false; let lost = false; + let boxSeen = false; while (!existsSync(resultFile)) { await Promise.race([this.run.exited, sleep(this.pollMs)]); if (existsSync(resultFile)) break; @@ -288,8 +292,11 @@ export class VbaSession { // the desktop is listed again at the next poll } // Run does not return after a compile error's box is answered: the VBE stays in break - // mode, waiting for a person. So any box ends this Access, and the next job starts one. - if (seen.length) { + // mode, waiting for a person. So a box ends this Access, and the next job starts one, + // once it is seen at two polls in a row (5): a box a harness answers is gone by then. + const shown = seen.length > 0 && boxSeen; + boxSeen = seen.length > 0; + if (shown) { boxes.push(...seen.map((b) => ({ title: b.title, text: b.text }))); lost = true; break; diff --git a/test/example-batches.test.mjs b/test/example-batches.test.mjs index c3a9bb9f..d1325607 100644 --- a/test/example-batches.test.mjs +++ b/test/example-batches.test.mjs @@ -13,6 +13,9 @@ // Runs with a bare `node --test test/example-batches.test.mjs`: no tree, no build. import assert from "node:assert/strict"; +import { mkdtempSync, rmSync, writeFileSync } from "node:fs"; +import { tmpdir } from "node:os"; +import path from "node:path"; import { test } from "node:test"; import { runProbes } from "../scripts/lib/example-batches.mjs"; import { @@ -25,7 +28,7 @@ import { } from "../scripts/lib/harness-settings.mjs"; import { BUILD_FAILED, LLVM_REFUSAL, linkedLog } from "../scripts/lib/tb-ide.mjs"; import { buildTimeoutMessage, checkCapture } from "../scripts/lib/tb-run.mjs"; -import { vb6Probes } from "../scripts/lib/vb6.mjs"; +import { reproAnswersBoxes, reproProblem, vb6Probes } from "../scripts/lib/vb6.mjs"; test("check_examples' probes pass", async () => { const said = []; @@ -181,6 +184,25 @@ test("test/harness.json is read as its contract says", () => { ); }); +test("a reproducer's VB6 project may call MsgBox only with the dialog harness", () => { + const dir = mkdtempSync(path.join(tmpdir(), "repro-boxes-")); + try { + writeFileSync(path.join(dir, "Probe.vbp"), "Type=Exe\r\nModule=Module1; Module1.bas\r\n"); + const main = 'Sub Main()\r\n MsgBox "x"\r\nEnd Sub\r\n'; + writeFileSync(path.join(dir, "Module1.bas"), `Attribute VB_Name = "Module1"\r\n${main}`); + assert.equal(reproAnswersBoxes(dir), false); + assert.match(reproProblem(dir) ?? "", /calls MsgBox/); + writeFileSync( + path.join(dir, "Module1.bas"), + `Attribute VB_Name = "Module1"\r\nPrivate Sub dialog_Begin()\r\nEnd Sub\r\n${main}`, + ); + assert.equal(reproAnswersBoxes(dir), true); + assert.equal(reproProblem(dir), null); + } finally { + rmSync(dir, { recursive: true, force: true }); + } +}); + test("vb6run's probes pass", () => { const probes = vb6Probes(); assert.ok(probes.length > 0, "vb6Probes() returned no probes");