From e3339727541f6c27cf5df5d2e863410a983b92a7 Mon Sep 17 00:00:00 2001 From: Kuba Sunderland-Ober Date: Tue, 27 Oct 2026 17:29:18 +0100 Subject: [PATCH 1/8] tbbroker: listen again at once after a failed instance; clients retry ENOENT/EBUSY after start --- WIP.Broker.md | 5 ++++- scripts/broker/src/Sources/BrokerServer.twin | 15 ++++++++++++-- scripts/broker/tbbroker.twinproj | Bin 81024 -> 81463 bytes scripts/lib/tb-broker.mjs | 20 +++++++++++++++++-- 4 files changed, 35 insertions(+), 5 deletions(-) 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/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 6c77771d88ff97a2cc2911ffeeac02b26f27f03a..9b1c4b4286aa8d42678418d75d09ef9c53aee7b3 100644 GIT binary patch delta 421 zcmY+AJx>Bb5Qc+-M$E;+0xL5b4IdH|OR2j>H1(Oe`$6 zpfR!V50Fq;TT5Z@uOOi@G3vrajZ@A%@640AdJjK+g!`G{OsY888TuOwCF%)ey5q~| zuXTA>jmX@mCeLn`2XiAiJ3ARXj5oV+*aL<>Q05833St`lO~!K>UJ>=$hpHI zlg%W-cUrayjsqwpYKt(L2`!d9`Auj%EJTA_TZA8ZGEE1b58KsavI;rES+Wbb+{6qBi=sLXY= o`E0<-+wrP=87*o}9nlPE$rdT4fx8GHvj+t delta 66 zcmV-I0KNaW`~-mc1h6v90&_>RG|YD-lQ`-SljrFYlfMfPlR$_GlaH_slUs-rv-|Lq Y0|p>QVQh0{lacf#lfSwMvxD}uM+J5t9RL6T 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") }); From 29e92ef43e79f4e5a19981f25deef2fa4151e17a Mon Sep 17 00:00:00 2001 From: Kuba Sunderland-Ober Date: Thu, 22 Oct 2026 22:52:22 +0200 Subject: [PATCH 2/8] Errors batch 6b: design (dialog, keys and window harnesses) and plan; owner's answers D1, D2, D3, D4 --- ERRORS-6B-PLAN.md | 164 ++++++++++++++++++++++++++++++++++++++++++++++ WIP.Errors.md | 125 +++++++++++++++++++++++++++++++++-- 2 files changed, 285 insertions(+), 4 deletions(-) create mode 100644 ERRORS-6B-PLAN.md diff --git a/ERRORS-6B-PLAN.md b/ERRORS-6B-PLAN.md new file mode 100644 index 00000000..45d9b5c4 --- /dev/null +++ b/ERRORS-6B-PLAN.md @@ -0,0 +1,164 @@ +# Errors batch 6b --- plan + +The steps of batch 6b of [WIP.Errors.md](WIP.Errors.md): the run-time errors of AppActivate, +Beep, DoEvents, InputBox, MsgBox, SendKeys and Shell. *Batch 6b design* in WIP.Errors.md says +why each part is built as it is; this file says what to do, in order, and is ticked as it +goes. It is deleted when the batch is done, its findings moved to a *Batch 6b findings* +section of WIP.Errors.md. + +Read first, as for every batch: *How a batch runs* and *Harnesses* in WIP.Errors.md, the +opening comments of `scripts/lib/vb6.mjs` and `scripts/lib/vba.mjs`, and +`errors/harnesses/clock.bas`, whose patching the new harnesses reuse. + +## 0. The owner's answers + +- [x] D1: MsgBox and InputBox under the `dialog` harness --- yes (2026-10-22) +- [x] D2: SendKeys strings that send keys, under the `keys` harness --- yes (2026-10-22) +- [x] D3: Beep --- left for now: no case, no harness, no section (2026-10-22) +- [x] D4: an error Windows itself makes VB6 or VBA raise on the user's desktop --- nothing: + no row, no NOTE, not checked on the user's desktop (2026-10-22) + +## 1. Find what each runtime calls + +A temporary harness, `errors/harnesses/trace.bas` (deleted before the commit, as +`Explore.yml` is), patches each candidate export with a fake that **refuses** (returns 0 or +fails as the real one can) and records the call and its main argument; `trace_End` raises +1003 with the list of calls as its description, so the case's line in `run`'s output shows +it in every runtime. The candidates: + +- boxes: `MessageBoxA/W`, `MessageBoxExA/W`, `MessageBoxIndirectA/W`, `MessageBoxTimeoutA/W`, + `TaskDialog`, `TaskDialogIndirect` (comctl32), `DialogBoxParamA/W`, + `DialogBoxIndirectParamA/W`, `CreateDialogParamA/W`, `CreateDialogIndirectParamA/W`; +- keys: `SendInput`, `keybd_event`, `SetWindowsHookExA/W` (the `idHook` recorded); +- focus: `SetForegroundWindow`, `SetActiveWindow`, `BringWindowToTop`, `SetFocus`, + `AllowSetForegroundWindow`, `SwitchToThisWindow`. + +Runs, each through `node scripts/errors.mjs run Explore.yml`: + +- [ ] 1a. No box and no key can come of these, whatever the answer: `AppActivate "x"` (a + title that is no window), `Shell("nonexistent.exe")`, and, with every candidate refused, `SendKeys ""`. +- [ ] 1b. (D1) `MsgBox "x"`, `InputBox("x")` and `MsgBox("x", vbYesNo)`, with every box + candidate refused. If a runtime's case shows no call at all, its MsgBox goes some other way + and **no further MsgBox case runs in that runtime** until the way is found: a box may then + have opened on the private desktop, closed by the launcher (twinBASIC, VB6) or ending + Access (VBA), which the run reports. Also note the class of each window the runtime creates + for InputBox (a `WH_CBT` hook in the trace harness, recording `HCBT_CREATEWND`). +- [ ] 1c. (D2) `SendKeys "a"` with every key candidate refused; the same check: a runtime + with no call recorded is not given another key-sending case. +- [ ] 1d. `AppActivate` of a window the trace harness creates: does the real activation fail + on the private desktop (run with the focus candidates *not* patched, then patched)? + +Record in this file, per runtime: which export each procedure calls, and the InputBox +window's class. That fixes which exports the guard and the `keys` fakes must cover. + +## 2. The harnesses + +Each in `errors/harnesses/`, one source for all four runtimes, with a comment at its head +saying what it does and why, as `clock.bas` and `registry.bas` have. + +- [ ] `dialog.bas`: the `WH_CBT` hook (answers only boxes it saw created, of the classes step + 1 found; hides, then posts `WM_COMMAND` for Cancel, else the first button that is not + Help), the guard over the exports step 1 found (style bits &H260000 refused, error 1002 at + `dialog_End`; any other style passed to the real function), `dialog_Expect Count` (1001). + The hook's callback in a `#If VBA7` pair (`LongPtr` and `Long` signatures). +- [ ] `keys.bas`: fakes for the key exports step 1 found, the recorded events as a list of + `` items (`"10d 41d 41u 10u"` for `"+a"`), `keys_Expect ""` + (1001); the journal-playback driver only if step 1 shows VB6 uses one. +- [ ] `window.bas`: the window (`window_Title`, `window_Pid`), destroyed at `window_End`; the + activation fake only if step 1d shows the real call fails on the private desktop. +- [ ] A quiet self-test case for each, all four runtimes: `MsgBox "x"` then + `dialog_Expect 1`; `SendKeys "a"` then `keys_Expect "41d 41u"`; `AppActivate window_Title`. + And one case that shows the guard: `MsgBox("x", &H200000)` raising 1002 (a case of + `Explore.yml` only; it is not data). + +## 3. The tooling + +- [ ] `scripts/lib/vb6.mjs`: `runRepro` takes `unattended: false`; its opening comment's + section 9 gains the reason (a MsgBox under Unattended Execution goes to the event log). +- [ ] `scripts/errors.mjs`: `runVb6` passes it when a case of the probe uses `dialog`. +- [ ] `scripts/lib/vba.mjs`: `runModule` ends Access at a box only when it is seen at two polls + in a row; the opening comment's point 5 says why. +- [ ] `scripts/check_errors.mjs`: a probe that the VB6 project of a `dialog` page has no + `Unattended=-1` and that of any other page has it. +- [ ] `docs/Documentation/Tools-Defects.md`, the errors.mjs entry, if it lists the harnesses + or the VB6 build's options. +- [ ] WIP.Errors.md: *Harnesses* gains the three; *What the probes must respect* says MsgBox + and InputBox only under `dialog`, SendKeys only under `keys`. +- [ ] `node --test`, `check_errors.mjs` and `check_lint.mjs` pass. + +## 4. Explore + +`errors/Explore.yml`, every case `quiet:`, the page's harness set on the page. Probe each +boundary from both sides. Candidates (more as the answers suggest): + +- [ ] **MsgBox** (`dialog`): **Null** as each argument; *helpfile* without *context* and the + reverse; *buttons* 0 to 6 (each group), 7 to 15, each icon and two icons together (&H50), + `vbDefaultButton1` to 4 and &H400, each modality and two together (&H3000), each option + flag, 32768, 2147483648# (the conversion, not listed); a *prompt* of 1,024, 100,000 and + 1,000,000 characters, with `Chr(0)`; an empty *title*. Never &H20000, &H40000, &H200000, + -1 or 2147483647 before step 1b's guard check has passed for that runtime. +- [ ] **InputBox** (`dialog`): **Null** as each argument; *xpos* without *ypos* and the + reverse; *xpos*, *ypos* negative, 0, 2147483647, 1E+10, 1E+30 (a twips-to-pixels overflow is + the procedure's own work, so a 6 inside the parameter's range is listed); *helpfile* + without *context*; *default* of 300 characters. +- [ ] **SendKeys** (`keys`): **Null**; `""`; `"{"`, `"}"`, `"{}"`, `"{{}"`, `"{BAD}"`, + `"{LEFT x}"`, `"{LEFT -1}"`, `"{LEFT 0}"`, `"{LEFT 2147483648}"`, `"{F16}"`, `"{F17}"`, + `"{PRTSC}"`, `"+("`, `"("`, `")"`, `"+"`, `"~"`, `"{h 10}"`; *wait* **Null**, **True** and + **False**; then (D2) a valid key before a bad token, `"a{BAD}"`, with `keys_Expect` to show + whether `a` is sent first. Every modifier and every code of the page's two tables once, + with its `keys_Expect`. +- [ ] **AppActivate** (`window`): **Null**; `""`; a title that is no window; `window_Title`, + a prefix of it, the same in another case; `window_Pid`, 0, -1, 4 (the System process, which has no + window), 1E+20; a numeric string; a hidden window's title; *wait* + **Null** and **False**. *wait* **True** waits for the probe to have the focus, which on a + private desktop it never has: one such case alone, with a short `--exe-run-timeout`, and + left out if it hangs (a fact about the private desktop, so nothing goes on the page). +- [ ] **Shell** (no harness): **Null**; `""`; `"nonexistent.exe"`; a missing folder in the + path; the Windows folder itself; `Environ$("windir") & "\win.ini"`; a path of 300 and + 33,000 characters; an unbalanced quote; `"cmd.exe /c exit"` with each *windowstyle* 0 to 4 + and 6, and 5, 7, 8, 10, 11, -1, 32767, 32768, **Null**. A case that starts `cmd.exe` uses + `vbHide` unless it tries *windowstyle*. +- [ ] **DoEvents**: `DoEvents()` and `DoEvents` as a statement, quiet. +- [x] **Beep**: left for now (D3). + +Delete `Explore.yml` before committing. + +## 5. The data + +- [ ] The rows and quiet cases in `errors/VBA.Interaction.yml`, after 6a's pages, each page's + `harness:` set; `node scripts/errors.mjs run VBA.Interaction.yml --only + "(AppActivate|DoEvents|InputBox|MsgBox|SendKeys|Shell)\.md$"` until all agree in all four + runtimes. +- [ ] Afterwards, `run` of the whole file, so that 6a's pages still agree beside the new ones. +- [ ] Check that no `tbdocsErrorsProbe*` window, process or registry key is left, and that + the Application event log has no new entries from a VB6 probe (Unattended Execution off). + +## 6. The pages + +- [ ] `node scripts/errors.mjs write`. +- [ ] Shell: its opening says it returns zero when the program cannot be started, and its text + that an error is raised; the table settles which, and the other goes (or becomes a + `` comment if both VB runtimes contradict it). +- [ ] MsgBox and InputBox: the sentences "If *helpfile* is supplied, *context* must also be + supplied" (and the reverse) go into the table if an error is raised, and stay as prose if + none is. +- [ ] SendKeys: the NOTE on `{PRTSC}` checked against the cases. +- [ ] The module's `index.md` for the same claims. + +## 7. Differences + +- [ ] Each difference from VB6 or 64-bit VBA: `bug: pending`, then a `tests` reproducer + with a `vb6/` side (`node scripts/bug_repro.mjs new --template tests`; one that needs + a harness carries a copy of its code), the entry in BUGS-TO-REPORT.md, the slug in the + data. A reproducer for MsgBox or InputBox needs the same hook, since it must not open a box + either. +- [ ] Where twinBASIC accepts what VB6 refuses: ask the owner before queuing. +- [ ] Group as 6a did where the cause is one (an argument error raised as -2147467259 joins + `argument-errors-unspecified-error`). + +## 8. Gates and the end + +- [ ] `build.bat` (0 broken), `node scripts/check_errors.mjs`, `test.bat`, `check.bat`. +- [ ] Commit on `staging` by path, one-line message. +- [ ] WIP.Errors.md: *Where things stand*, *Batch 6b findings*, the batch row; this file + deleted; the questions for the owner listed. diff --git a/WIP.Errors.md b/WIP.Errors.md index 6c1e731b..cd64742a 100644 --- a/WIP.Errors.md +++ b/WIP.Errors.md @@ -64,8 +64,9 @@ 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). +**Next: batch 6b**, `Interaction`'s interactive procedures. Its design is *Batch 6b design* +below, and its steps are in [ERRORS-6B-PLAN.md](ERRORS-6B-PLAN.md). The owner answered D1 +to D4 on 2026-10-22. ## Owner's decisions @@ -675,6 +676,122 @@ 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. + ## 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 +871,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` (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`; *Batch 6b design* proposes the `dialog`, `keys` and `window` harnesses to replace the first two limits) | 7 | design 2026-10-22, plan in ERRORS-6B-PLAN.md; D1--D4 answered; not started | | 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 | From d3bfb394037e4228962209af965053a66292b094 Mon Sep 17 00:00:00 2001 From: Kuba Sunderland-Ober Date: Tue, 27 Oct 2026 17:29:19 +0100 Subject: [PATCH 3/8] Errors batch 6b: dialog, keys and window harnesses; probe tooling for boxes; exploration findings --- ERRORS-6B-PLAN.md | 140 ++++++++++-- WIP.Errors.md | 27 ++- docs/Documentation/Tools-Defects.md | 4 +- errors/harnesses/dialog.bas | 329 ++++++++++++++++++++++++++++ errors/harnesses/keys.bas | 201 +++++++++++++++++ errors/harnesses/window.bas | 66 ++++++ scripts/check_errors.mjs | 39 ++++ scripts/errors.mjs | 13 +- scripts/lib/errors-data.mjs | 40 +++- scripts/lib/vb6.mjs | 13 +- scripts/lib/vba.mjs | 11 +- 11 files changed, 849 insertions(+), 34 deletions(-) create mode 100644 errors/harnesses/dialog.bas create mode 100644 errors/harnesses/keys.bas create mode 100644 errors/harnesses/window.bas diff --git a/ERRORS-6B-PLAN.md b/ERRORS-6B-PLAN.md index 45d9b5c4..ba533591 100644 --- a/ERRORS-6B-PLAN.md +++ b/ERRORS-6B-PLAN.md @@ -35,52 +35,72 @@ it in every runtime. The candidates: Runs, each through `node scripts/errors.mjs run Explore.yml`: -- [ ] 1a. No box and no key can come of these, whatever the answer: `AppActivate "x"` (a +- [x] 1a. No box and no key can come of these, whatever the answer: `AppActivate "x"` (a title that is no window), `Shell("nonexistent.exe")`, and, with every candidate refused, `SendKeys ""`. -- [ ] 1b. (D1) `MsgBox "x"`, `InputBox("x")` and `MsgBox("x", vbYesNo)`, with every box +- [x] 1b. (D1) `MsgBox "x"`, `InputBox("x")` and `MsgBox("x", vbYesNo)`, with every box candidate refused. If a runtime's case shows no call at all, its MsgBox goes some other way and **no further MsgBox case runs in that runtime** until the way is found: a box may then have opened on the private desktop, closed by the launcher (twinBASIC, VB6) or ending Access (VBA), which the run reports. Also note the class of each window the runtime creates for InputBox (a `WH_CBT` hook in the trace harness, recording `HCBT_CREATEWND`). -- [ ] 1c. (D2) `SendKeys "a"` with every key candidate refused; the same check: a runtime +- [x] 1c. (D2) `SendKeys "a"` with every key candidate refused; the same check: a runtime with no call recorded is not given another key-sending case. -- [ ] 1d. `AppActivate` of a window the trace harness creates: does the real activation fail +- [x] 1d. `AppActivate` of a window the trace harness creates: does the real activation fail on the private desktop (run with the focus candidates *not* patched, then patched)? Record in this file, per runtime: which export each procedure calls, and the InputBox window's class. That fixes which exports the guard and the `keys` fakes must cover. +**Step 1 done (2026-10-22, BETA 1010, all four runtimes).** 1a: none of the three calls any +candidate (AppActivate of a missing title raises -2147467259 in twinBASIC, 5 in VB6 and VBA; +Shell of a missing program -2147467259, VB 53). + +| | twinBASIC (32 and 64) | VB6 | 64-bit VBA | +|---|---|---|---| +| MsgBox | `MessageBoxIndirectW` | `MessageBoxIndirectA` (refused, called twice) | as VB6 | +| InputBox | `DialogBoxIndirectParamW` | `DialogBoxParamA`, template &HFBF; refused, it shows a `MessageBoxIndirectA` | as VB6 | +| SendKeys | `keybd_event`, one call per key down and up | `SetWindowsHookExW` 1 (journal playback); refused, `SendInput` of one event at a time; that refused, error 17 | as VB6 | +| AppActivate | `SetForegroundWindow`, `SetFocus` | the same | the same | + +1d: on the private desktop AppActivate of a window the probe made raises nothing, real calls +or refused ones, though the window never becomes the foreground one: no activation fake is +needed. A refused `DialogBoxIndirectParamW` returning -1 crashes twinBASIC 64-bit later in +OLEAUT32 (the fake's `Long` return is not a 64-bit -1): an artefact of the trace, not a finding. +So the guard covers `MessageBoxIndirectA/W` (and refuses the six other MessageBox entry points +outright, which no runtime calls); `keys` fakes `keybd_event` and `SendInput`, and refuses a +journal-playback hook with `ERROR_ACCESS_DENIED`, as Windows does for a process without +UIAccess, so VB6 and VBA take their `SendInput` path, which is the one they take on Windows 10. + ## 2. The harnesses Each in `errors/harnesses/`, one source for all four runtimes, with a comment at its head saying what it does and why, as `clock.bas` and `registry.bas` have. -- [ ] `dialog.bas`: the `WH_CBT` hook (answers only boxes it saw created, of the classes step +- [x] `dialog.bas`: the `WH_CBT` hook (answers only boxes it saw created, of the classes step 1 found; hides, then posts `WM_COMMAND` for Cancel, else the first button that is not Help), the guard over the exports step 1 found (style bits &H260000 refused, error 1002 at `dialog_End`; any other style passed to the real function), `dialog_Expect Count` (1001). The hook's callback in a `#If VBA7` pair (`LongPtr` and `Long` signatures). -- [ ] `keys.bas`: fakes for the key exports step 1 found, the recorded events as a list of +- [x] `keys.bas`: fakes for the key exports step 1 found, the recorded events as a list of `` items (`"10d 41d 41u 10u"` for `"+a"`), `keys_Expect ""` (1001); the journal-playback driver only if step 1 shows VB6 uses one. -- [ ] `window.bas`: the window (`window_Title`, `window_Pid`), destroyed at `window_End`; the +- [x] `window.bas`: the window (`window_Title`, `window_Pid`), destroyed at `window_End`; the activation fake only if step 1d shows the real call fails on the private desktop. -- [ ] A quiet self-test case for each, all four runtimes: `MsgBox "x"` then +- [x] A quiet self-test case for each, all four runtimes: `MsgBox "x"` then `dialog_Expect 1`; `SendKeys "a"` then `keys_Expect "41d 41u"`; `AppActivate window_Title`. And one case that shows the guard: `MsgBox("x", &H200000)` raising 1002 (a case of `Explore.yml` only; it is not data). ## 3. The tooling -- [ ] `scripts/lib/vb6.mjs`: `runRepro` takes `unattended: false`; its opening comment's +- [x] `scripts/lib/vb6.mjs`: `runRepro` takes `unattended: false`; its opening comment's section 9 gains the reason (a MsgBox under Unattended Execution goes to the event log). -- [ ] `scripts/errors.mjs`: `runVb6` passes it when a case of the probe uses `dialog`. -- [ ] `scripts/lib/vba.mjs`: `runModule` ends Access at a box only when it is seen at two polls +- [x] `scripts/errors.mjs`: `runVb6` passes it when a case of the probe uses `dialog`. +- [x] `scripts/lib/vba.mjs`: `runModule` ends Access at a box only when it is seen at two polls in a row; the opening comment's point 5 says why. -- [ ] `scripts/check_errors.mjs`: a probe that the VB6 project of a `dialog` page has no +- [x] `scripts/check_errors.mjs`: a probe that the VB6 project of a `dialog` page has no `Unattended=-1` and that of any other page has it. -- [ ] `docs/Documentation/Tools-Defects.md`, the errors.mjs entry, if it lists the harnesses +- [x] `docs/Documentation/Tools-Defects.md`, the errors.mjs entry, if it lists the harnesses or the VB6 build's options. - [ ] WIP.Errors.md: *Harnesses* gains the three; *What the probes must respect* says MsgBox and InputBox only under `dialog`, SendKeys only under `keys`. @@ -91,38 +111,120 @@ saying what it does and why, as `clock.bas` and `registry.bas` have. `errors/Explore.yml`, every case `quiet:`, the page's harness set on the page. Probe each boundary from both sides. Candidates (more as the answers suggest): -- [ ] **MsgBox** (`dialog`): **Null** as each argument; *helpfile* without *context* and the +- [x] **MsgBox** (`dialog`): **Null** as each argument; *helpfile* without *context* and the reverse; *buttons* 0 to 6 (each group), 7 to 15, each icon and two icons together (&H50), `vbDefaultButton1` to 4 and &H400, each modality and two together (&H3000), each option flag, 32768, 2147483648# (the conversion, not listed); a *prompt* of 1,024, 100,000 and 1,000,000 characters, with `Chr(0)`; an empty *title*. Never &H20000, &H40000, &H200000, -1 or 2147483647 before step 1b's guard check has passed for that runtime. -- [ ] **InputBox** (`dialog`): **Null** as each argument; *xpos* without *ypos* and the +- [x] **InputBox** (`dialog`): **Null** as each argument; *xpos* without *ypos* and the reverse; *xpos*, *ypos* negative, 0, 2147483647, 1E+10, 1E+30 (a twips-to-pixels overflow is the procedure's own work, so a 6 inside the parameter's range is listed); *helpfile* without *context*; *default* of 300 characters. -- [ ] **SendKeys** (`keys`): **Null**; `""`; `"{"`, `"}"`, `"{}"`, `"{{}"`, `"{BAD}"`, +- [x] **SendKeys** (`keys`): **Null**; `""`; `"{"`, `"}"`, `"{}"`, `"{{}"`, `"{BAD}"`, `"{LEFT x}"`, `"{LEFT -1}"`, `"{LEFT 0}"`, `"{LEFT 2147483648}"`, `"{F16}"`, `"{F17}"`, `"{PRTSC}"`, `"+("`, `"("`, `")"`, `"+"`, `"~"`, `"{h 10}"`; *wait* **Null**, **True** and **False**; then (D2) a valid key before a bad token, `"a{BAD}"`, with `keys_Expect` to show whether `a` is sent first. Every modifier and every code of the page's two tables once, with its `keys_Expect`. -- [ ] **AppActivate** (`window`): **Null**; `""`; a title that is no window; `window_Title`, +- [x] **AppActivate** (`window`): **Null**; `""`; a title that is no window; `window_Title`, a prefix of it, the same in another case; `window_Pid`, 0, -1, 4 (the System process, which has no window), 1E+20; a numeric string; a hidden window's title; *wait* **Null** and **False**. *wait* **True** waits for the probe to have the focus, which on a private desktop it never has: one such case alone, with a short `--exe-run-timeout`, and left out if it hangs (a fact about the private desktop, so nothing goes on the page). -- [ ] **Shell** (no harness): **Null**; `""`; `"nonexistent.exe"`; a missing folder in the +- [x] **Shell** (no harness): **Null**; `""`; `"nonexistent.exe"`; a missing folder in the path; the Windows folder itself; `Environ$("windir") & "\win.ini"`; a path of 300 and 33,000 characters; an unbalanced quote; `"cmd.exe /c exit"` with each *windowstyle* 0 to 4 and 6, and 5, 7, 8, 10, 11, -1, 32767, 32768, **Null**. A case that starts `cmd.exe` uses `vbHide` unless it tries *windowstyle*. -- [ ] **DoEvents**: `DoEvents()` and `DoEvents` as a statement, quiet. +- [x] **DoEvents**: `DoEvents()` and `DoEvents` as a statement, quiet. - [x] **Beep**: left for now (D3). Delete `Explore.yml` before committing. +**Step 4 done (2026-10-22, BETA 1010, all four runtimes; twinBASIC 64-bit as 32-bit throughout).** + +- **Agree in all four**: **Null** as any argument raises 94 (MsgBox, InputBox, SendKeys' + *string*, AppActivate's *title*, Shell's both), except as below; a number beyond a **Long** + raises 6 (the conversion); InputBox's *xpos*/*ypos* of 1E+10 or more raise 6 (the twips + conversion, inside the **Double** range: listed); `"x"` as a number raises 13; Shell + *windowstyle* 0 to 9 runs; DoEvents raises nothing. +- **twinBASIC -2147467259 where VB raises 5 or 53** (the `argument-errors-unspecified-error` + family): AppActivate of a title or task id that matches no window (0, -1, 4, 2147483647, + **True**, **Empty**; VB 5); Shell of `""`, `" "`, a folder, `win.ini`, 33,000 characters (VB + 5), of a missing program or folder, 300 characters, an unbalanced quote (VB 53), and a + *windowstyle* of 11, -1, 32767, 32768, 2147483647 (VB 5); MsgBox and InputBox with a + *helpfile* and no *context* (VB 5). +- **SendKeys: twinBASIC -2147352567 (*Exception occurred.*) where VB raises 5**: an unknown or + unclosed brace (`"{"`, `"}"`, `"{}"`, `"{BAD}"`, `"{INS}"`, `"{F17}"`), a bad count (`"{LEFT x}"`, + `-1`, `32767`, `2147483648`, `"{LEFT2}"`), unbalanced parentheses (`"("`, `")"`, `"+("`, `"+(a"`, + `"a)"`), `"++"`; and for *wait*: **Null** (VB 94), `"x"` (VB 13). `"{INS}"` is in the page's + table and refused by all four (VB too): the page is wrong. +- **twinBASIC raises nothing where VB raises**: AppActivate of a hidden window (VB 5), with + *wait* **Null** (94) or `"x"` (13); AppActivate `""` (VB6 5; 64-bit VBA 0, as twinBASIC); + Shell *windowstyle* 10 (VB 5); SendKeys *wait* `"True"` (VB 13); MsgBox and InputBox with a + *context* and no *helpfile* (VB 5); InputBox *xpos*/*ypos* 2147483647 (VB 6); MsgBox and + InputBox *helpfile* **Null** raise 94 (VB 5). +- **MsgBox's *buttons*, no error either side**: VB6 and 64-bit VBA pass a style they do not + know as 0 (an OK box): 6, 7, 8, 15, two icons (&H50, &H70), &H80, &H400, -1, &H7FFFFFFF. + twinBASIC passes every style to Windows as given: 6, &H50, &H70, &H80, &H400 show a box of + Windows' making; **7, 8 and 15 show no box and return 0**; **-1 and &H7FFFFFFF carry + MB_SERVICE_NOTIFICATION** (the guard refused them; unguarded, the box goes to the user's + input desktop, from any desktop and any session's service). +- **SendKeys' keys, no error either side**: the same events in all four for every code of + the page's tables, `{n}` counts, modifiers and `~`; differences: a character outside the + ANSI keyboard: `"é"` sends virtual key &HE9 (VB: the character, as KEYEVENTF_UNICODE), + `ChrW(&H263A)` sends `?` (VB: the character), `"Ā"` sends Shift+A (VB: `?`); `"((a))"` + sends `a` (VB: Shift, then `a` three times); `"+"` and `"+a+"` send Shift once where VB + presses it twice. And VB6 and VBA keep the keys before a refused token and send them with + the next SendKeys (`"a{BAD}"`, then `"{LEFT 0}"` sends `a`); twinBASIC sends nothing. +- **AppActivate's 2 s**: in a twinBASIC exe on the private desktop, activating a new + top-level window takes 2 s from the third one on, by `CreateWindowEx` with `WS_VISIBLE` as + by AppActivate; `DoEvents` before or after changes nothing; VB6 and VBA take none. + `errors.mjs` now gives a twinBASIC probe 120 s. + +**Before the commit**: delete `errors/harnesses/trace.bas` and `errors/Explore.yml`, and take +`"trace"` out of `ATTENDED_HARNESSES` in `scripts/lib/errors-data.mjs`. + +**Questions for the owner (asked 2026-10-22), which decide the data:** + +- Q1. SendKeys' -2147352567 where VB raises 5, 13 or 94: into `argument-errors-unspecified-error` + (queued, not filed), or an entry of its own? +- Q2. Extensions or bugs, where twinBASIC raises nothing and VB raises: AppActivate `""` + (VB6 5, 64-bit VBA none) and of a hidden window (VB 5); AppActivate's *wait* not checked + (**Null**, `"x"`); Shell *windowstyle* 10 (`SW_SHOWDEFAULT`); SendKeys *wait* `"True"`; + MsgBox/InputBox *context* without *helpfile*; InputBox *xpos* 2147483647; *helpfile* + **Null** raising 94 where VB raises 5. +- Q3. MsgBox styles: twinBASIC passes every style to Windows, VB maps an unknown one to an OK + box. Bugs to queue: 7, 8 and 15 showing no box and returning 0 (silent); -1 and &H7FFFFFFF + sending the box to the user's input desktop. An extension: 6 (Cancel, Try Again, + Continue), &H50, &H70, &H80, &H400 passed to Windows? +- Q4. SendKeys of a character outside the keyboard (`"é"`, `ChrW(&H263A)`, `"Ā"`) sends the + wrong key, silently: a bug and a WARNING on the page? And `"((a))"`, the doubled Shift, VB's + keeping keys after a refused token: document nothing (VB's own oddities)? +- Q5. The 2 s window activation: try it once on your desktop, or leave it (it raises nothing)? + +**Owner's answers (2026-10-27):** Q1 join `argument-errors-unspecified-error`. Q2: InputBox's +*xpos*/*ypos* 2147483647 and MsgBox/InputBox *context* without *helpfile* must raise (bugs); +Shell *windowstyle* 10 must raise if it is not valid: it is not (`STARTUPINFO.wShowWindow` +takes any `ShowWindow` value but `SW_SHOWDEFAULT`, 10; `CreateProcessW` does not check it). +All four runtimes call `CreateProcessW` with `STARTF_USESHOWWINDOW` and the style as given; +VB6 and VBA check 0 to 9 after rounding first (9.4 passes, 9.6 raises 5), twinBASIC 0 to 10, +and nothing done first (a Shell, DoEvents, an Integer, Byte or String 10) makes VB take 10. +Q3, Q4: explained, waiting. Q5: the desktop test is built (`desktest/` in the scratchpad: +the same 8 windows by twinBASIC and VB6; on the private desktop twinBASIC takes 2 s to make +each from the third, VB6 none) and waits for the owner's go. The rest of Q2 is still open. + +**Owner's answers (2026-10-27, second round):** AppActivate `""` is an extension. AppActivate of +a hidden window: twinBASIC leaves it hidden (VB 5), so not useful: a bug. AppActivate's *wait* +must be checked (bug). *helpfile* **Null** raising 94: a bug. MsgBox *buttons*: twinBASIC should +take every style Windows takes and raise when Windows refuses one: 7, 8, 15 (silently no box) are +a bug. SendKeys of non-ASCII text: a bug. The broker race: both fixes made (client retry in +`tb-broker.mjs`, `ListenNow` in `BrokerServer.twin`, installed, `test/broker.test.mjs` 14/14; the +tblaunch session told). Still open: SendKeys *wait* `"True"`; the minor SendKeys differences; +whether to test -1/&H7FFFFFFF unguarded; the desktop test's go. + ## 5. The data - [ ] The rows and quiet cases in `errors/VBA.Interaction.yml`, after 6a's pages, each page's diff --git a/WIP.Errors.md b/WIP.Errors.md index cd64742a..1e87740a 100644 --- a/WIP.Errors.md +++ b/WIP.Errors.md @@ -350,6 +350,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: @@ -404,8 +426,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`). diff --git a/docs/Documentation/Tools-Defects.md b/docs/Documentation/Tools-Defects.md index d2082052..d7031631 100644 --- a/docs/Documentation/Tools-Defects.md +++ b/docs/Documentation/Tools-Defects.md @@ -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/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..c29efec5 --- /dev/null +++ b/errors/harnesses/keys.bas @@ -0,0 +1,201 @@ +' 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 + +' 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/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/vb6.mjs b/scripts/lib/vb6.mjs index 39457465..044133e8 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 @@ -920,13 +923,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)))); 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; From 50b04a8998401b4433f229e67bc9e494e7cc4fcf Mon Sep 17 00:00:00 2001 From: Kuba Sunderland-Ober Date: Tue, 27 Oct 2026 17:46:13 +0100 Subject: [PATCH 4/8] Errors batch 6b: data and Common Errors sections for MsgBox, InputBox, SendKeys, AppActivate, Shell; DoEvents quiet --- ERRORS-6B-PLAN.md | 9 + .../Default/VBA/Interaction/AppActivate.md | 27 +- .../Default/VBA/Interaction/InputBox.md | 27 +- .../Default/VBA/Interaction/MsgBox.md | 30 +- .../Default/VBA/Interaction/SendKeys.md | 32 +- .../Default/VBA/Interaction/Shell.md | 27 +- docs/Reference/Run-time-Errors.md | 16 +- errors/VBA.Interaction.yml | 301 +++++++++++++++++- errors/harnesses/keys.bas | 7 + 9 files changed, 459 insertions(+), 17 deletions(-) diff --git a/ERRORS-6B-PLAN.md b/ERRORS-6B-PLAN.md index ba533591..77a76b35 100644 --- a/ERRORS-6B-PLAN.md +++ b/ERRORS-6B-PLAN.md @@ -225,6 +225,15 @@ a bug. SendKeys of non-ASCII text: a bug. The broker race: both fixes made (clie tblaunch session told). Still open: SendKeys *wait* `"True"`; the minor SendKeys differences; whether to test -1/&H7FFFFFFF unguarded; the desktop test's go. +**Third round (2026-10-27):** SendKeys *wait* `"True"`: an extension. `"((a))"`, the doubled +Shift and VB's keeping keys after a refused token: VB's, nothing documented (VB's keeping is +arguably a VB bug; twinBASIC's dropping the string is right). Unguarded MsgBox -1 and +&H7FFFFFFF: Windows refuses them before any box (returns 0, nothing shown anywhere), so they are +the 7/8/15 bug; twinBASIC should raise 5 for every style Windows refuses. The private-desktop 2 s +is a twinBASIC bug to queue (owner); on the user's desktop there is none. AppActivate on the +user's desktop: VB6 made windows 2 to 8 the foreground one, twinBASIC none (the first run started +the programs hidden; a rerun with a throwaway first window waits for the owner's go). + ## 5. The data - [ ] The rows and quiet cases in `errors/VBA.Interaction.yml`, after 6a's pages, each page's 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..c913b0ee 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: pending + 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: pending + 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: pending + 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: pending + 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: pending + 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: pending + cases: + - { setup: window_Hide, run: AppActivate window_Title() } + - error: 0 + when: "*wait* is **Null**" + vb6: 94 + bug: pending + cases: + - { run: "AppActivate window_Title(), Null" } + - error: 0 + when: "*wait* is a string that is not a **Boolean**" + vb6: 13 + bug: pending + 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: pending + 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/keys.bas b/errors/harnesses/keys.bas index c29efec5..1d973c1a 100644 --- a/errors/harnesses/keys.bas +++ b/errors/harnesses/keys.bas @@ -194,6 +194,13 @@ Private Sub keys_End() 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 From 61c6265c063e038874772ad4f1963c49cac3d1ac Mon Sep 17 00:00:00 2001 From: Kuba Sunderland-Ober Date: Tue, 27 Oct 2026 17:54:39 +0100 Subject: [PATCH 5/8] Errors batch 6b: argument-errors-unspecified-error extended; interaction-missing-argument-checks queued; a VB6 reproducer may call MsgBox under the dialog harness --- BUGS-TO-REPORT.md | 273 ++++++++- ERRORS-6B-PLAN.md | 13 + ...argument-errors-unspecified-error.twinproj | Bin 7593 -> 9523 bytes .../repro.json | 10 +- .../src/Sources/RegressionTests.twin | 63 ++ .../vb6/Module1.bas | 342 +++++++++++ ...teraction-missing-argument-checks.twinproj | Bin 0 -> 29674 bytes .../repro.json | 23 + .../src/Settings | 75 +++ .../src/Sources/RegressionTests.twin | 559 ++++++++++++++++++ .../src/Sources/Startup.twin | 6 + .../vb6/Module1.bas | 503 ++++++++++++++++ .../vb6/Probe.vbp | 7 + docs/Documentation/Tools-Defects.md | 2 +- errors/VBA.Interaction.yml | 18 +- scripts/lib/vb6.mjs | 21 +- test/example-batches.test.mjs | 24 +- 17 files changed, 1922 insertions(+), 17 deletions(-) create mode 100644 bugs/interaction-missing-argument-checks/interaction-missing-argument-checks.twinproj create mode 100644 bugs/interaction-missing-argument-checks/repro.json create mode 100644 bugs/interaction-missing-argument-checks/src/Settings create mode 100644 bugs/interaction-missing-argument-checks/src/Sources/RegressionTests.twin create mode 100644 bugs/interaction-missing-argument-checks/src/Sources/Startup.twin create mode 100644 bugs/interaction-missing-argument-checks/vb6/Module1.bas create mode 100644 bugs/interaction-missing-argument-checks/vb6/Probe.vbp diff --git a/BUGS-TO-REPORT.md b/BUGS-TO-REPORT.md index e9cc9724..1a0616dc 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,203 @@ 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. + + diff --git a/ERRORS-6B-PLAN.md b/ERRORS-6B-PLAN.md index 77a76b35..c29e7758 100644 --- a/ERRORS-6B-PLAN.md +++ b/ERRORS-6B-PLAN.md @@ -234,6 +234,19 @@ is a twinBASIC bug to queue (owner); on the user's desktop there is none. AppAct user's desktop: VB6 made windows 2 to 8 the foreground one, twinBASIC none (the first run started the programs hidden; a rerun with a throwaway first window waits for the owner's go). +**Paused 2026-10-27 (owner rearranging commits).** Done since: steps 5 and 6 (data, all 355 +cases of `VBA.Interaction.yml` agree in all four runtimes; sections and page edits, committed). +`argument-errors-unspecified-error` extended (8 cases, entry text, packed, verifies). +`scripts/lib/vb6.mjs`: `reproAnswersBoxes` lets a reproducer's VB6 project that carries the +dialog harness call MsgBox and InputBox, built without Unattended Execution (needs a probe in +`test/example-batches.test.mjs` and a line in Tools-Defects' bug_repro entry). In progress: +`bugs/interaction-missing-argument-checks/` (written by a scratch generator; tB side 3 PASS and +12 FAIL, VB6 side right): set `repro.json`'s expected lines, write its entry in BUGS-TO-REPORT.md, +pack, replace `bug: pending` in the data with its slug. Left: `sendkeys-non-ascii` (reproducer +with a copy of keys.bas, entry; the WARNING on SendKeys names it), the private-desktop 2 s entry +(reproducer from the scratchpad's desktest programs), step 8 (gates, findings into +WIP.Errors.md, this file deleted). `errors/harnesses/trace.bas` is scratch, uncommitted. + ## 5. The data - [ ] The rows and quiet cases in `errors/VBA.Interaction.yml`, after 6a's pages, each page's 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 ead45fc110ad888b196b28c0965d344c8cb0da21..aa20aba3f034f3690db743ed6f6a7f94a0332b91 100644 GIT binary patch delta 680 zcmaJ<(P|Sx6eU8?sxb`-T54@?Mx{}bEoqyUR{N0Dh*26^g9M+}&F(cjWHYnO&YBIS zzaYYVfX}{F@&$f@zoI`N&StYH2+qLFFmukiXXeb8C$pEAxy+RZcW3#`r{Y`CZ4+9S zv|ZR69D;NaD3d5GThb2*zTh@Gp}@d^wxvPBq5%dl!1r7rSTNvGRZkDh<^4!bZO5 zqUV|Iu`j2mmUK0HMSZ+>a5dhp5TbtM-mN8=6B-1R4Nnsj=IgoHhAQ0X+@1p}gz;Kj zq_*&>o|Z_~zzAcN`W^9z4OzeIej PNoDmg3$xFq>r1}@Fl6Z7 delta 20 ccmdn&wbFV6FC)_|;m!Pv6NEQw%5ZT407udVzyJUM 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 0000000000000000000000000000000000000000..0e9e1b89d8ad3d0e07a30cfacc16c0dbccd88685 GIT binary patch literal 29674 zcmdsATXWk;cJ^+rb~10tTOPVNQ#O?)wIW4HmL}dRk|IY;bSqOM&enKJ1(J}2F$FLH zXh}QepOgQR-;!UE@ATFar@F8eT>i~`TKi({q2i?#b@to8icVsKDnK```$2gLeEXL z{X6RQ+ZSKq6L3fFWa9X4FiW)|aA@<7_&jz-ADxRdh=1VQFY)ia8wIm)l)nF4zE92i z^LPJ-ZvW=RzsTMfp$pmq|HO^rXf?j}eA$@*(BJ=hFJ8P6?_J$Y#MEv_G^f)hSo6t= z-HPb>(^=dKZYts+y1;+o_+!z(1Z5(0&u5V<;!9UJihGebZEeaXn~mzwi@$pH23MM@ zX+>On@ulqG&#s1U7}57z5jq~=lnD@ZpN7HD?kE;RH}b{=--|@xySVQ8vFviSQlUWz zy246=h{T3C4?^LHD88MzV&M7X;5t&HM;QLn4PD{I!Vj)RbV>L8KnxXCp&QRaKN4%J z1o#Blj6G)(T!>32^ub9C8C?_7?k6|A9I z53GMANq4;)(Bb~{)vJSGJOdjN2}?!z>XpFX8$hpC#VD9Ug+*{K+%OEn==X|NH~Kvj zzdCe?@G(S3%#=UNq)M%3ztpkGGV z6)8MJXvHWtsk1ZjKDs;5Gb!u%(uwhHGKq3%(j!P28ue$DBW-fW0t}7<(t?Oo6Ut8N z1bu-z0byvbGZ6>SKX{6kQdNCjLsz`UAgpHBgc2ITw%AAkRbM0ehpxDCok;RP5q{Qk zFFap(eiTbm95L8CYqw7H5SKylk#v=YmJr@RZLaAz5FGEYenNSx6PU+De7#=Z+FH{h zq)yyWjL;lvO>{!*-LbM{mIDkFC`cw~p|UE-(J$c+B#%fzBG(_wAA^Il_R+yX^Ke(3 zhrt!3GMvS+G&pFB7)`voG`qKs+=@>Ql!b?@B*K{>_7NMIXH>15j#V6dv}eEf>-=W(U~5 z2CkhT`B3=V3+XK-W|0eWi1X*pYy#&7YL50h&F@dv>!RH1oHRvkt+od82g>ad2~uuj z53ZU8OzenUS82gml$jx{ODmX1TrqLaV^|nG{;KF`XTh!)B!d;BV20@%iX+K~d^GUb zizk?}NMf;j10c$eXnB%5W|o|FZl;)GjQuy&j3FT&w9fjS_ouyf=j`z4q}T1Wn6;fYvZy&*qwMfV!=7QC@W2XJ;f-RAfEC-~q0ual$Wv!lcPKN>hI z&?ta$V2aYXrB_rIhKV%@OKstzO@(q59}-;~$EFv(d*T+E!1 zEZRY6z#7303QlhZ)m1Y$>)F(aA`IvFw}PifxO##q9pd@Sm*JZzlPHF_1ZPFD738Gomoo~x0;b>SsMcHnmU=_Lm~Kfk$ue}Wf=^0Z zq#COfd~Heh5zgSs;H{0+s68&wbhh=arh~$-QE)Z&CV&$7lUvEOuRG)j5$^h=NqSg@q733rk&q!bAgpsRoW~g8H&KZpp<7SRSIbVxiIZ?afI1c;HxhuL_sEXF_+?ZpS zJzzU=n*u?%D1CGhj!o9L+1)A7>T}gWh?Y`KkzRw9HVv* zJdP1GG{<9#sEe_%8W|k+tWhiCY4JMs!g%IPFl2K9Se-uFKFu@nK!vkd+@ z?FPzu{YI79%>{FhWBGF250e}fWL+KSxtTg1a~JFz1Y3Vl{@fPw-+Lo zn33VrLnMiz+HpAP?JmHD8{}eR#(toTibiGeow-;iO$C&$xr;pX33TN|qVmDZbi}B)GYR~7E-XpD%tVComkn!nB zgl^gyv|kQZB9jSTr_ zPSuK15Na=nNjgL=z$D$sU}EA}jfn|j^#!9Vbm4vx>=%q&3t~wN13MNi;E~o(HRk z29_F|MEmbArN@Ml_aALRoMc#E%=P7Cq(ad@JYqD=UNT(FqL9Raxtf>Ueh&KW&@X>@ zD|jqMV9te_z)*ANq5i@S!}6oo`7o?$5H)lAJvGuE^%22eX4J1K>)Si$$%H@O@E(Sv zQiqgvy_WkUl$HJHPO(*loj-AkQUb@1X-`pQDCe`aGF6K_v~0n-+f9=lKEW2ei%j^M zOzPKUwmOG#@-8R%ITMX770U2`E9wI2^({NgtzhdUsmjT!fy!Hwc7=C(`cy6Z&L?+V z-rkT6TgcGowxW~@8P+05hqO_+#E9R~?gA)MxfLw|B%UeFF8306&y_bAD1(lvDkctK zvqfzmnXMzC(BfjG zkBwfl^@T4Y*}4j_jVyStCIW|C(j%@+Q8s=?{s4P;aTwh47M&vR*poY%Hs+u}kDE{c zf}QB2Kx;0!xejK?zVjZf+~xA(Z}nJvR4l_=;Qko0^XicyN~jk0>{)2U2GDmeI^Wm3L=<;bR^QSG<;j|sz3)@M3=OyOla{QI#s`* zOo2BS?Tuu~e%&6+aZ-U45WK6O0;L%n2D@& zqrHiqP}`^{fnBDvt*pLtms3`(0sN4K_{Z#pxk=nCPBe^TsCDA#kZjR64qShx!C9Ak zC?CnWY^G^DU4!q;a_u<_w*wV_ciEDd!MVXqs)gaLp~@cpenTfgTJE^X?c6~%)0Pio zfoXb2RI#8JG4-d)ALixFGHr4($^kcmWudV7iWN`( z#$irNAd;bTnbe%(bjDC~DbBPpg#SetvsOymlJzy)jP*5R!x^4tb;m4!6eCkMnajph z3&TWXwf7t^vBliMlH2nmX;PQB(=4$W+snlu(`FuxdlIbeu3#{>*hi0&V_!UAUdlLY zvlu-?RPIvg#KbL?r&}9o{Z#76r6e>*rB)p2>A;9pEoIp0Qn;=vOQdot0Fp90%BRAn zUGGYyGFWDxlt-dAeeq6B@86VbYxPD&tf?$8-95zJqz)#*pjqClh<*iSMfHZ&d=67| z-$yCkH)XUvR1GN})wD4l{P_lDhEzf2y=)IPMwE2(GEq2q8CFWSEXyh(p;2xv|)UfhSFe2dtS}*EcP2=0L5-hKQdn+pvT)H*& z$TS1oz4=D-y&zyQj=iC}J6Vxe}sff!t(m=GOktTYg6aFPQ^W@^jrim28$;ajCGcVEx<%@W3S z59PL`Yg=|K6Z|!C6v}~WMYcnjB+#UtADt7RccR1z7&hX09H=M#LCtKAnA|#m6nB!= zxQi!37)JUtYn1wK(e+%BfQj`C0{cOrs?`Z%7Mc<&r?(76{PTCBmY}K{@_N)XOlGO_ zo;7Y7H%kXMH#XL7oq-ToQ&`*eAe1J{8v_!OrK#z5rP3UlDvS0Ga+ct49P@u znqJMkR&di$@!VYbMN0=}I=YkdG5K_TVOO`1fivAn_@5zNKXFk+e34cF!Hp+CP-C1_ zP-xVj1LMu-z*v*e)tEn?=}h~AJZV;4RNZ`*Je`e8t-~y1(&hH=M6*c#e7#5u+C#lu zTUhY`JT#ZgCZ@(sZN??yrZq`hCT7(wti|THP>2ee%c#)zomkHa*|l3u>fzgXvV#5p zeg#g}Zc7Hv$k0gjRbugip*Az1$F~7PLSr*1pAF* z>`j0!2FVabA;r*|!`rE1mhu{+cCe~Kxa?cAr&c5e&YyVXxBp%1=!fIx`{qG^M~sGj z?@#E88N?Tt*Z%nE+IJz)OUhxq)`_xp2+big~%GM0jjV@OTBkq$V6=Tgj3lgp+oZJZEuu%WK>;>nyP!;~^>V zyNidzta(p?VwwyCuDGR?ZeOXr$%lIF+BT$Z#>#+5L^POM3-l{bwx?+!TRJ+3JJ_7J|->IioZ z6L9nS$9XU;9n;%DwZPmlzJkeBYX*?j-wtf)dnUKTN5)7+MMYEB-w}8i8^>bc@$Rnw zt@s%VEPs#!`-0EM!Nb;AAyB)}ZigSMOulx_whq$+{Y6@wehfqFHkZWf?W%;aq&BT` z4S7+@l%PTnY)|aMde9f42-_ms%|#CCR+95@W7@3O(TCzI^2Dh}UCJd@<4>~2qluQm zL46F&!hM^&?8z*63*G z#5*}~2c;$94vOGnnP9vOKmc*|R z9R93E=S#RzUwK903cvPsE$WX%JK(STBq{v2} z5K&%H)GX&}(5leUSd)9=S?-!fizm({Co2OW8IvrVdM}zJ5CbTlNH&|DYJD~55j%a0 zIwXVHP;$K)cGd&z5%*(viXG>qBVh?Fa!LS_>7Zys`HuLQK+~VX&6>u{gr#m3N23hE zz({b)cfF)OdYMIC(|$JLww_`VhNDP+^}Rfykq$Dd2pAFV)?LVxoI>7yL*dX6yLab^ zZ8O_oel43j6P(dHmh!!#cPJ`U_dMFDzXohPfvQ>V90 zkbD`d!z6W;c+OUq;_f`dj8>^{_%iO-=M6-g%;971m;l(lpg8FL~y<* zKjH%oki5aAnJ%y!kTP(3?5*f_WHfnen+1+ zr#n-1933u*)EAv~S{F!y;Y3*pgHN|4eTVbIA$rnLqF%yNi`O^S;coVMj6AfqQ%jz6 z%aWA%5+%x1xzlc4iMfQJQT36lk1}GJ*L&?Ql}yN}2A}Kn6%&X4Oj&cX$JNc#Ud@Xvbu?o3TqtW;-u-~LH-N|{oIf!5&Ku9S~Rn523> z5##P-QMI)*4n8-YLWLGu6*7Mb#RY1yakp75piZCTd-lU|5aHP6&9{oU&8Hx)*go{Q ziG|3)(+*yBUq;58Ps4>jf(wWXW|9?fopO=!#aV%Qu1f5%o$43kh4P%rT@E--(SGzP zHNRLnvd;6tF7t_OoJf@}SH3)GK=(I(0n!GxzAIXY=T({!!0?Jgd zLuVx94a%kAUIai zlIv(071qAIu&T9ZkrwP;a7o2iukbo2y!Ppz@ri0B911_3f8EnAZgO+%b;vefy<*8& zxrYPC^R+b-eB>jj)%;NO`YLRB#YlZc_FJX?_A~DM^6F&?xsY@3V#crGS@nD*Yf-mV z+7YE)m){^#s-PK;y`h&qtvb`GTpv<{yWY-~>NuQvlQA}OFRAA@zwkS;==bLjA6j(p z!-sEvK{}g8p*oY#XW#tN3`du!FdNZ(l0L6~^9!XHIybTF)7!E>&x5D;eGz!@%^%YX zEIL1QQmw{rGzvXgR8H;QyC7>k!+8}uc*}}<)z~L_N|Ac=5YmMsI{a(?#aVR97aIs? zuvvlm)kyRZkJ)EY&sHgWQ+=WoTJ8;55;3C}oz{U_j0cHqu6tub_m@p9R64uO&FaS5 zMz`8nuWwgdyW8DrZDV_@RckfzlwK#z79X6Xu7$_{! z-FCADv2{Du?alRCwN~5S*xqe48(a0anjv1)=J$Gp>ZNlSOKAhK%Nr5fiK2tviNZ{C z?MJ*`>A1Jwc`uHe?f+_i*ZIlv$5ouKgzc&;aM2rj6ED6MY5-A2y~tIxV)2aGY+Ya` z>I;+tjo>E;jT7YBTl9*tsvcdnvKe{WQWq7wq`jlJ61!%iVr}NCW^Ib$?_JtL3VZ-r zujMkmUE8jATkG4^%|^RfZR~Ehs;$P>Rux9FR_`|6cDn8M^D`X*nYfq)L*!&f@^pq^ zNDfYO(x|j`;gP(?h~LQp<&&Vwq27o6wG^W<7qe!ku3GHRSNZL?jjd*FZMXV%`|Vb> z(P-7HZ(I1*X>M)dWlLM#+V1xAaGz6m7C)a_nNtHiheFpIq|mQk{sfkrc{fsX_$j*~ z=sn3Pxy_Nn5o;Ihk~SzPNFYX-R@ZnzA_W5IO%AH$%6AFk*N-&T%Mv#0< 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/docs/Documentation/Tools-Defects.md b/docs/Documentation/Tools-Defects.md index d7031631..a0d1954b 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`](#errorsmjs) (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. | diff --git a/errors/VBA.Interaction.yml b/errors/VBA.Interaction.yml index c913b0ee..c4773fbf 100644 --- a/errors/VBA.Interaction.yml +++ b/errors/VBA.Interaction.yml @@ -460,7 +460,7 @@ pages: - error: 94 when: "*helpfile* is **Null**" vb6: 5 - bug: pending + bug: interaction-missing-argument-checks cases: - MsgBox("x", 0, "t", Null) - error: -2147467259 @@ -472,7 +472,7 @@ pages: - error: 0 when: "*context* is given without *helpfile*" vb6: 5 - bug: pending + bug: interaction-missing-argument-checks cases: - MsgBox("x", , , , 5) quiet: @@ -517,7 +517,7 @@ pages: - error: 94 when: "*helpfile* is **Null**" vb6: 5 - bug: pending + bug: interaction-missing-argument-checks cases: - InputBox("x", , , , , Null) - error: 6 @@ -530,7 +530,7 @@ pages: - 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: pending + bug: interaction-missing-argument-checks cases: - InputBox("x", , , 32768, 0) - InputBox("x", , , 32767.6, 0) @@ -547,7 +547,7 @@ pages: - error: 0 when: "*context* is given without *helpfile*" vb6: 5 - bug: pending + bug: interaction-missing-argument-checks cases: - InputBox("x", , , , , , 5) quiet: @@ -652,19 +652,19 @@ pages: - error: 0 when: "the window *title* names is hidden" vb6: 5 - bug: pending + bug: interaction-missing-argument-checks cases: - { setup: window_Hide, run: AppActivate window_Title() } - error: 0 when: "*wait* is **Null**" vb6: 94 - bug: pending + 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: pending + bug: interaction-missing-argument-checks cases: - { run: "AppActivate window_Title(), \"x\"" } quiet: @@ -718,7 +718,7 @@ pages: - error: 0 when: "*windowstyle* is 10 after rounding (`SW_SHOWDEFAULT`, which a new program's start-up information may not hold)" vb6: 5 - bug: pending + bug: interaction-missing-argument-checks cases: - Shell("cmd.exe /c exit", 10) - Shell("cmd.exe /c exit", 9.6) diff --git a/scripts/lib/vb6.mjs b/scripts/lib/vb6.mjs index 044133e8..a83e209a 100644 --- a/scripts/lib/vb6.mjs +++ b/scripts/lib/vb6.mjs @@ -801,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))))) { @@ -933,7 +950,7 @@ export async function runRepro( 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, attended && !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/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"); From bccdbe95b39fb849a17a2c056a97dedb80d351e4 Mon Sep 17 00:00:00 2001 From: Kuba Sunderland-Ober Date: Tue, 27 Oct 2026 17:56:16 +0100 Subject: [PATCH 6/8] Errors batch 6b: sendkeys-non-ascii queued --- BUGS-TO-REPORT.md | 92 ++++++ bugs/sendkeys-non-ascii/repro.json | 13 + .../sendkeys-non-ascii.twinproj | Bin 0 -> 14944 bytes bugs/sendkeys-non-ascii/src/Settings | 75 +++++ .../src/Sources/RegressionTests.twin | 265 ++++++++++++++++++ .../src/Sources/Startup.twin | 6 + bugs/sendkeys-non-ascii/vb6/Module1.bas | 246 ++++++++++++++++ bugs/sendkeys-non-ascii/vb6/Probe.vbp | 7 + 8 files changed, 704 insertions(+) create mode 100644 bugs/sendkeys-non-ascii/repro.json create mode 100644 bugs/sendkeys-non-ascii/sendkeys-non-ascii.twinproj create mode 100644 bugs/sendkeys-non-ascii/src/Settings create mode 100644 bugs/sendkeys-non-ascii/src/Sources/RegressionTests.twin create mode 100644 bugs/sendkeys-non-ascii/src/Sources/Startup.twin create mode 100644 bugs/sendkeys-non-ascii/vb6/Module1.bas create mode 100644 bugs/sendkeys-non-ascii/vb6/Probe.vbp diff --git a/BUGS-TO-REPORT.md b/BUGS-TO-REPORT.md index 1a0616dc..533102ed 100644 --- a/BUGS-TO-REPORT.md +++ b/BUGS-TO-REPORT.md @@ -8312,3 +8312,95 @@ 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: 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. + + 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 0000000000000000000000000000000000000000..330d4228253c4f53ecc1eef0e88b9689f899a390 GIT binary patch literal 14944 zcmeHO-EJGnvDWTMPL7orI2XxXE*f0JqOznyQndbdy}*zht{Llx5G65zwUCEoQygnJ z!^{jVDUN|WL9X)xx!708ZSo|!%v0p6{+U0LGPSm|IXDqun(XPWs{X3Fx~jY8=YRh3 zKR#Lc-<6e>4tEDv{5ClBTqEe)Hk#tU|Hju(SAK@i)_CIiAs?LFPWZmv^DW=zLELd= z<%jg+)0Kz#Jg|d4cO1**-Za&R$f3{w;InP@udK^7i66UTW=b&krgo4qh>bre1>1>^>B49G0YAF?hIMpV$aRr zm}lnUN%P|LuvI^5n2f*XZn$2cac8wHX1N2lRW0`H5I+qz@CqOvDyrZejMJdZs6^!3=bq+|o#ks00w-cL5XgdEfIfU7DhhDIg9c zj)cMWT)xL%ewh&AtHDdr;pOzDoVoyE;9a|-c{(Yum#1HnU^6{a_-wEfVtO;-0C}Le zGsv%~o_2_E67&MQ9@+g-7W=<`yFrA*orlG*(zVG?LFBO(yJU%`;zA)-_v(vd~n1?O1QP3=~0yK65j|c05!^8>* zM9YOE0zSS}2{0wI@i`paaO(DHm9RWHv)(P1G9yb93WS^0#^oATLA?n7ROwfL+>f*n1M)lsCj$U?YC>)t7_c zPrrIukVXsdLT)gaV0jb+KEXx;7pIBmbLG;2Rm=2m3VEhEv1oIjTRB)B#*+KgzFT_u z6cf>#^b{L|aMqeWz{e7g2;^sWAHW88uuUs5^ru*nz#?*2WD95@f3YoBS>GE^Y$vu! z&vkAEGM||a{0IU9mrPc<0W92+2e)-iMhRcnw_HLJ7zA9cc`4{;t)Ud-1j>+2ZQp(k zq*#OZ9a2F%^gGs&v!=ESa&;G9^H6%}XOPw5218K7a#tKXnzLESF~hL|K`z@Z$MUt? zGg#T7g(Yaf>xI}5F4yVnzUN+o**&Fb!xI>T0mU1OWk__2BzTtKSzsShsxuiXfN4mM zdOkAgPLWi`9H}~U+S_Hma->)M0y)y1A~_A`??c}pDjRbB@sLjXLd z&#$KAN$`$72n}%xpktgQj#{k9@{h$4fQpSy_)TJ*S~QgCAXwYyZe9vWXBU*cyK)m3 z%$_E`KV~_WlT2xBG>D};5i{9~)D3~|l(UIk$E0HuCFnI(J07X&0daN;S#I`BET55~oZj0#`?&Pni(|s_76 zmgU%&E>d)v-g-DCL2`zLrB0;iC}*9{uxbr8`1{op|h!6LFlNS!$R7G-icy z)tL!K?Bog)2Ej-`$y1O>3z*ymX!K#^Fd|x!X+af-ax{(7_9t89r}ljMS!|mk5LdSO zaRO|T7YYV(tzPXF6G_LDJ!ak@W!3`5UaS{S;G%aM^nMZ_z%qEnF)w{TnZ^7o8 zSf>XCc9JldB*haP0!V`24Z80C3FtQOhOP_E2v9V1-FHFfiuoK@<$1O{~zB=s7Pflw#Q|CueQjga|mMo|Jvn#Z-{*l zo)%kvHeHO5z47g|O{d-1J>yn=6*c4P`@PbUq!N6jQ|WXbBu(`8c-W&Md{r7Dw^IkBbM_UI;<)Uh@6p9?3wblam3K=lVw}K;go$gEM zvdHsoT%X}|KfeB9dAfKIy%uQ_A(f6@;^aZ9iN;Y|&GQ^?xfw+r>hAI6DZ|61*H(27 z!lc_|juVd}$POteOvL7iz=0mqUy8u&=Eb#y{Q$p;4JcoN>q>|Gy4wANJ)FJjIp z`=%jn9Sg;MV+MjAu$j$Kgz6I;paimAkTxNYEhtqgS8&gzf^}lIz=#%7l7}R7DZR^< zAhfg|sa^c~SdCQK&=vljC% z<8SKqA`<+?OQ8wNYr3(qk$DKSN?8v&J$_c**_(ZY#Iw9E9@lo}P)V573{}c?G5cnL z%^R8IPfSXZOS8E^2qlGCN=vciQjg#&#BL)^=pI0Q7bMCOiA9?^EuTt7WPKuCpj>gtNYOIMCCdo|QAI(Gx2jG`6#E1)0%?4x%p38stS+LVE?qH@ zjXVd9s2a^0(xJ1ZNDM^T6wx5rJXD#;5--$msVdD}P81bs7JbBMzL>|jKzlcZgaHqy zlSP|!odzV8B#;JqI@8sQ&O|toS=1;UU80Uilrd8DNpsv_4b(tUJ<$mDCUNbNsKTQ< zQp@qVH2{1>d9X-gQ6va{nhE)Sqgt*j^Hz4saf(lR7)bvUs6tk;EE6PAYlNO3{j+6w*sorB)e}b5_E^iitt# zaX$kkYks&vF!#d^!{_F2sS-D*s<)CemV+Xbkw4c&>8+ZuC}Ql4?4d4xTxMFQlSwo! zG4>vFGrrT@vejv7Lm;g#nB!l+MOmvXsEezTC#dnpEfE!NszPZL_F3$-qZEA))tW|s z8gi*xSZH0F&C*(~kNj@_@iTKbyDu!I>{D}h!0z_~7$yc*sr2BF2ZSEBO0l=SEYCfPk3P2u3ixdH#EzNUcx|R6~dl^Jj@KygGpAH9)pa?tO$=jSzgc7Fco4RTeYN?GXJi$`w^zfbnxr~3T28;{;JQHqND zd+yRZ9&cyK(_1P+kPy|O^umVuYcthrz=OVTPiSh?@0ep6gDFb4XWjv!ReKF{x};Sv zs&12Ywe%G2$rltdZziPJ;zb9%MMINq1!om-rqbIaiuQoSc~jo1*J@^Ix7ajxpA@U* zO0BqC$Is2i){|{xYiqaBFw@g^fs~l>UC?`C!iXWTZ`$D;_NZ~^K6ilw9==$8@BoJJ z;6YAFRVtM#rRrv>h%f4+uD?-JsZ`w(QelYG7lTTe9DZr(j`mS1H4VM7Fe-uu4<~>F zWsjJ5eee8Sm5iUCcW#63QFp6)ejbDa9KTgILZ_D)vQ?coB;@1G%Df@L?YQSTErG8j zsA#?BK3UO$^~&=>u_A@it+p##OOW&}JxKx5d{V0IR2rpXqi)oS)y<|^+}+wN7t7_{ zC%cWRQQfZWXh7_sE=#C=_39INDeV(ncAsFU86C7vlw=yU7xklqc5B}}#%n9}=f>CO zH;Gd1B4Tq!qycFU+e3KE6a$t=WIqnp6PQVu6AcnX-9Q0VfOSq{oOD}<;@y>^=B|1r zfjq0JMg^BxzZk95u0d4LW?D70DZr2UYn#*oBAey8px4X0m1b>ox42cU8^vm4w^poG zx3`PNlP9H0v$|t8>-CQhx-prsOULUW4n&zcYQMc6IV_E2WYUR-_rw|;zZMMZ#7{ZM z`@mmL0e$c;_~)Da?oM^vD3=<=o!y=7VzpYU6nAR)W*Xbu4YRr3EH`#P4*D_*PvH5X zjXA~OV;FR$N(R09;2S6++BcD)iaq#Dx*^y-=_!6Jqk$u7U09ct?$9PrKt#Q+@g^T_ z<>_>p>1Vr`WpHPgHt&J||bG8{DB6|4LAM@y)96dpW!mMsF=`;Dq?p ZwW%5mF^Je(<=ddQ7*6hN^{ohH{t1+~)yn_? literal 0 HcmV?d00001 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 From 4d4e3b47f5144366390998aedc6ccf4523926bfd Mon Sep 17 00:00:00 2001 From: Kuba Sunderland-Ober Date: Tue, 27 Oct 2026 18:00:24 +0100 Subject: [PATCH 7/8] Errors batch 6b: private-desktop-window-activation-delay queued --- BUGS-TO-REPORT.md | 89 ++++++++++++++++++ ...e-desktop-window-activation-delay.twinproj | Bin 0 -> 4767 bytes .../repro.json | 13 +++ .../src/Settings | 61 ++++++++++++ .../src/Sources/Startup.twin | 50 ++++++++++ .../vb6/Module1.bas | 29 ++++++ .../vb6/Probe.vbp | 7 ++ 7 files changed, 249 insertions(+) create mode 100644 bugs/private-desktop-window-activation-delay/private-desktop-window-activation-delay.twinproj create mode 100644 bugs/private-desktop-window-activation-delay/repro.json create mode 100644 bugs/private-desktop-window-activation-delay/src/Settings create mode 100644 bugs/private-desktop-window-activation-delay/src/Sources/Startup.twin create mode 100644 bugs/private-desktop-window-activation-delay/vb6/Module1.bas create mode 100644 bugs/private-desktop-window-activation-delay/vb6/Probe.vbp diff --git a/BUGS-TO-REPORT.md b/BUGS-TO-REPORT.md index 533102ed..cd0d659e 100644 --- a/BUGS-TO-REPORT.md +++ b/BUGS-TO-REPORT.md @@ -8404,3 +8404,92 @@ 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: 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/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 0000000000000000000000000000000000000000..914d3afdcc7f194f7f4a3296cace5c7c22b77abf GIT binary patch literal 4767 zcmcIoZEqX75mwSyyUoXb>jy$HE^<#2^kyf{!6;TMDOuDnf~DA3SV6FoD2wrGS0K5T z1;an5f3Clx&yXu=SJAb1Eh+??<#0HB=HYN=)_?xTAO86w_d1u$b)|UlHE(fsucP^m z2*=UF8EF!VC~Wb-UqWm1`z>By=Kh4IH=9RN^KpMU=VxLleJQxwDCTm%p~1`CD?HDI z8u1|TLmtH$9Wn=<-{aZ!NB90+*2M4Z^dA1Z;wp;eC_Des&XZd2+u2{efc!=7k2I@& zspENBFGOe-(L(xtzn{y!VdwrmS8M_k3@nra{=fqURgj@r6msTIG?&Z|BR%D^$hbe6 zGBu4BA@emGNp9F;g`3`&Yp>@u&)P+{n2OQ#)&3jiTRO3U(1)-wW@E0jjFx3E_$QXa*tPqhCW;hW6XZ_~Y zr;9I_pZYBHXIveYnS)6gE&PSQOq^t+2vck#q|!yEL^v|`$hwiO)O%WG4KnpFV4s~EH@5Mlg@Fd)V# zJ^>tj3&n5{#zPU#W4)RMcgheF-+hrB=F79Mib+^2m53RFriYvHI4TlU>qL#goyeXg zh@=Cy0l+3Qnwib?RLC)HfJNl5VueJdhC>LV#UWy)%)HQOd#&~xySoh@VrdwQ02mNM z+ z&!cgSh)6EOt9^!Fk^oqXj{+aCx?1-931^)+MBHMvOVQ15%w=dlIt+K6S5~rXA+3qO1IrIxRbs$a6nvd@H4G{;M$EP`Pr2b(xdXm zc8_~5LmrqzO4-a>?ZrcO8SCT}`~1T- zDJ|#!d7ln{i9bkZ97e!A@B_d=N4U4+{Bp3d?6fo$;_h%MPJk zF|e$aQvf!+}*a(kRl&uk@jo5m*JKI3!<6Ld=z^+ zDG)L9^+5rFP=ew z8%H(=wiWqr=#sLZtc>qX;Z$f-lG>|Kpx4!uS}H1>RLnBv6P1k^zeV5RP@mSMD*M?A zSLKZ^8_9Jxm?>?cRBfQsg|wqJbb7Is^A(y!>L{sQ?QyM9+Elum{Pkbai9YS`2VbBT3H9f)RN=It|gk!>a|@<)N(eA0?$xx4JNi8xTH8d_rFFG7HbyN zN-9Dlt-y_En#mB-IjS_@)moKO%XONiM!nN6ogCMzrE2x$=%m$f8gFawR)h%UMzc90 zUnXCk*eeMLqDzd3cJk=l>nF%otlheo=UwlteZ{(t`#0x9`!k~t%cj%wTqM}*CL`0J zbSMI$mn_+U6)0t^!xU$h=9IvaxDrsKppZNWM*qgUFgui1yC+&{BCnf?Frmw20IW`q zeMMqI?Ur;!ZHDkG{vhZ$V5DB%NxEA-sdbw5lhSd+bxMuaNwd^!ynS18j*cp|PUBs> zySxWg6XbZ>9%ya*@JW|Xpa`+477(mcMoHM+7gJ{v!UVib+}s+8Ej94)b&?%w{h Hsj&Y7iz829 literal 0 HcmV?d00001 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 From f0b9e10d9d8ac4af2450fcc378435087684c8f33 Mon Sep 17 00:00:00 2001 From: Kuba Sunderland-Ober Date: Tue, 27 Oct 2026 18:05:01 +0100 Subject: [PATCH 8/8] Errors batch 6b done: findings in WIP.Errors.md, plan removed; Tools-Defects link to errors.mjs fixed --- ERRORS-6B-PLAN.md | 288 ---------------------------- WIP.Errors.md | 57 +++++- docs/Documentation/Tools-Defects.md | 2 +- 3 files changed, 54 insertions(+), 293 deletions(-) delete mode 100644 ERRORS-6B-PLAN.md diff --git a/ERRORS-6B-PLAN.md b/ERRORS-6B-PLAN.md deleted file mode 100644 index c29e7758..00000000 --- a/ERRORS-6B-PLAN.md +++ /dev/null @@ -1,288 +0,0 @@ -# Errors batch 6b --- plan - -The steps of batch 6b of [WIP.Errors.md](WIP.Errors.md): the run-time errors of AppActivate, -Beep, DoEvents, InputBox, MsgBox, SendKeys and Shell. *Batch 6b design* in WIP.Errors.md says -why each part is built as it is; this file says what to do, in order, and is ticked as it -goes. It is deleted when the batch is done, its findings moved to a *Batch 6b findings* -section of WIP.Errors.md. - -Read first, as for every batch: *How a batch runs* and *Harnesses* in WIP.Errors.md, the -opening comments of `scripts/lib/vb6.mjs` and `scripts/lib/vba.mjs`, and -`errors/harnesses/clock.bas`, whose patching the new harnesses reuse. - -## 0. The owner's answers - -- [x] D1: MsgBox and InputBox under the `dialog` harness --- yes (2026-10-22) -- [x] D2: SendKeys strings that send keys, under the `keys` harness --- yes (2026-10-22) -- [x] D3: Beep --- left for now: no case, no harness, no section (2026-10-22) -- [x] D4: an error Windows itself makes VB6 or VBA raise on the user's desktop --- nothing: - no row, no NOTE, not checked on the user's desktop (2026-10-22) - -## 1. Find what each runtime calls - -A temporary harness, `errors/harnesses/trace.bas` (deleted before the commit, as -`Explore.yml` is), patches each candidate export with a fake that **refuses** (returns 0 or -fails as the real one can) and records the call and its main argument; `trace_End` raises -1003 with the list of calls as its description, so the case's line in `run`'s output shows -it in every runtime. The candidates: - -- boxes: `MessageBoxA/W`, `MessageBoxExA/W`, `MessageBoxIndirectA/W`, `MessageBoxTimeoutA/W`, - `TaskDialog`, `TaskDialogIndirect` (comctl32), `DialogBoxParamA/W`, - `DialogBoxIndirectParamA/W`, `CreateDialogParamA/W`, `CreateDialogIndirectParamA/W`; -- keys: `SendInput`, `keybd_event`, `SetWindowsHookExA/W` (the `idHook` recorded); -- focus: `SetForegroundWindow`, `SetActiveWindow`, `BringWindowToTop`, `SetFocus`, - `AllowSetForegroundWindow`, `SwitchToThisWindow`. - -Runs, each through `node scripts/errors.mjs run Explore.yml`: - -- [x] 1a. No box and no key can come of these, whatever the answer: `AppActivate "x"` (a - title that is no window), `Shell("nonexistent.exe")`, and, with every candidate refused, `SendKeys ""`. -- [x] 1b. (D1) `MsgBox "x"`, `InputBox("x")` and `MsgBox("x", vbYesNo)`, with every box - candidate refused. If a runtime's case shows no call at all, its MsgBox goes some other way - and **no further MsgBox case runs in that runtime** until the way is found: a box may then - have opened on the private desktop, closed by the launcher (twinBASIC, VB6) or ending - Access (VBA), which the run reports. Also note the class of each window the runtime creates - for InputBox (a `WH_CBT` hook in the trace harness, recording `HCBT_CREATEWND`). -- [x] 1c. (D2) `SendKeys "a"` with every key candidate refused; the same check: a runtime - with no call recorded is not given another key-sending case. -- [x] 1d. `AppActivate` of a window the trace harness creates: does the real activation fail - on the private desktop (run with the focus candidates *not* patched, then patched)? - -Record in this file, per runtime: which export each procedure calls, and the InputBox -window's class. That fixes which exports the guard and the `keys` fakes must cover. - -**Step 1 done (2026-10-22, BETA 1010, all four runtimes).** 1a: none of the three calls any -candidate (AppActivate of a missing title raises -2147467259 in twinBASIC, 5 in VB6 and VBA; -Shell of a missing program -2147467259, VB 53). - -| | twinBASIC (32 and 64) | VB6 | 64-bit VBA | -|---|---|---|---| -| MsgBox | `MessageBoxIndirectW` | `MessageBoxIndirectA` (refused, called twice) | as VB6 | -| InputBox | `DialogBoxIndirectParamW` | `DialogBoxParamA`, template &HFBF; refused, it shows a `MessageBoxIndirectA` | as VB6 | -| SendKeys | `keybd_event`, one call per key down and up | `SetWindowsHookExW` 1 (journal playback); refused, `SendInput` of one event at a time; that refused, error 17 | as VB6 | -| AppActivate | `SetForegroundWindow`, `SetFocus` | the same | the same | - -1d: on the private desktop AppActivate of a window the probe made raises nothing, real calls -or refused ones, though the window never becomes the foreground one: no activation fake is -needed. A refused `DialogBoxIndirectParamW` returning -1 crashes twinBASIC 64-bit later in -OLEAUT32 (the fake's `Long` return is not a 64-bit -1): an artefact of the trace, not a finding. -So the guard covers `MessageBoxIndirectA/W` (and refuses the six other MessageBox entry points -outright, which no runtime calls); `keys` fakes `keybd_event` and `SendInput`, and refuses a -journal-playback hook with `ERROR_ACCESS_DENIED`, as Windows does for a process without -UIAccess, so VB6 and VBA take their `SendInput` path, which is the one they take on Windows 10. - -## 2. The harnesses - -Each in `errors/harnesses/`, one source for all four runtimes, with a comment at its head -saying what it does and why, as `clock.bas` and `registry.bas` have. - -- [x] `dialog.bas`: the `WH_CBT` hook (answers only boxes it saw created, of the classes step - 1 found; hides, then posts `WM_COMMAND` for Cancel, else the first button that is not - Help), the guard over the exports step 1 found (style bits &H260000 refused, error 1002 at - `dialog_End`; any other style passed to the real function), `dialog_Expect Count` (1001). - The hook's callback in a `#If VBA7` pair (`LongPtr` and `Long` signatures). -- [x] `keys.bas`: fakes for the key exports step 1 found, the recorded events as a list of - `` items (`"10d 41d 41u 10u"` for `"+a"`), `keys_Expect ""` - (1001); the journal-playback driver only if step 1 shows VB6 uses one. -- [x] `window.bas`: the window (`window_Title`, `window_Pid`), destroyed at `window_End`; the - activation fake only if step 1d shows the real call fails on the private desktop. -- [x] A quiet self-test case for each, all four runtimes: `MsgBox "x"` then - `dialog_Expect 1`; `SendKeys "a"` then `keys_Expect "41d 41u"`; `AppActivate window_Title`. - And one case that shows the guard: `MsgBox("x", &H200000)` raising 1002 (a case of - `Explore.yml` only; it is not data). - -## 3. The tooling - -- [x] `scripts/lib/vb6.mjs`: `runRepro` takes `unattended: false`; its opening comment's - section 9 gains the reason (a MsgBox under Unattended Execution goes to the event log). -- [x] `scripts/errors.mjs`: `runVb6` passes it when a case of the probe uses `dialog`. -- [x] `scripts/lib/vba.mjs`: `runModule` ends Access at a box only when it is seen at two polls - in a row; the opening comment's point 5 says why. -- [x] `scripts/check_errors.mjs`: a probe that the VB6 project of a `dialog` page has no - `Unattended=-1` and that of any other page has it. -- [x] `docs/Documentation/Tools-Defects.md`, the errors.mjs entry, if it lists the harnesses - or the VB6 build's options. -- [ ] WIP.Errors.md: *Harnesses* gains the three; *What the probes must respect* says MsgBox - and InputBox only under `dialog`, SendKeys only under `keys`. -- [ ] `node --test`, `check_errors.mjs` and `check_lint.mjs` pass. - -## 4. Explore - -`errors/Explore.yml`, every case `quiet:`, the page's harness set on the page. Probe each -boundary from both sides. Candidates (more as the answers suggest): - -- [x] **MsgBox** (`dialog`): **Null** as each argument; *helpfile* without *context* and the - reverse; *buttons* 0 to 6 (each group), 7 to 15, each icon and two icons together (&H50), - `vbDefaultButton1` to 4 and &H400, each modality and two together (&H3000), each option - flag, 32768, 2147483648# (the conversion, not listed); a *prompt* of 1,024, 100,000 and - 1,000,000 characters, with `Chr(0)`; an empty *title*. Never &H20000, &H40000, &H200000, - -1 or 2147483647 before step 1b's guard check has passed for that runtime. -- [x] **InputBox** (`dialog`): **Null** as each argument; *xpos* without *ypos* and the - reverse; *xpos*, *ypos* negative, 0, 2147483647, 1E+10, 1E+30 (a twips-to-pixels overflow is - the procedure's own work, so a 6 inside the parameter's range is listed); *helpfile* - without *context*; *default* of 300 characters. -- [x] **SendKeys** (`keys`): **Null**; `""`; `"{"`, `"}"`, `"{}"`, `"{{}"`, `"{BAD}"`, - `"{LEFT x}"`, `"{LEFT -1}"`, `"{LEFT 0}"`, `"{LEFT 2147483648}"`, `"{F16}"`, `"{F17}"`, - `"{PRTSC}"`, `"+("`, `"("`, `")"`, `"+"`, `"~"`, `"{h 10}"`; *wait* **Null**, **True** and - **False**; then (D2) a valid key before a bad token, `"a{BAD}"`, with `keys_Expect` to show - whether `a` is sent first. Every modifier and every code of the page's two tables once, - with its `keys_Expect`. -- [x] **AppActivate** (`window`): **Null**; `""`; a title that is no window; `window_Title`, - a prefix of it, the same in another case; `window_Pid`, 0, -1, 4 (the System process, which has no - window), 1E+20; a numeric string; a hidden window's title; *wait* - **Null** and **False**. *wait* **True** waits for the probe to have the focus, which on a - private desktop it never has: one such case alone, with a short `--exe-run-timeout`, and - left out if it hangs (a fact about the private desktop, so nothing goes on the page). -- [x] **Shell** (no harness): **Null**; `""`; `"nonexistent.exe"`; a missing folder in the - path; the Windows folder itself; `Environ$("windir") & "\win.ini"`; a path of 300 and - 33,000 characters; an unbalanced quote; `"cmd.exe /c exit"` with each *windowstyle* 0 to 4 - and 6, and 5, 7, 8, 10, 11, -1, 32767, 32768, **Null**. A case that starts `cmd.exe` uses - `vbHide` unless it tries *windowstyle*. -- [x] **DoEvents**: `DoEvents()` and `DoEvents` as a statement, quiet. -- [x] **Beep**: left for now (D3). - -Delete `Explore.yml` before committing. - -**Step 4 done (2026-10-22, BETA 1010, all four runtimes; twinBASIC 64-bit as 32-bit throughout).** - -- **Agree in all four**: **Null** as any argument raises 94 (MsgBox, InputBox, SendKeys' - *string*, AppActivate's *title*, Shell's both), except as below; a number beyond a **Long** - raises 6 (the conversion); InputBox's *xpos*/*ypos* of 1E+10 or more raise 6 (the twips - conversion, inside the **Double** range: listed); `"x"` as a number raises 13; Shell - *windowstyle* 0 to 9 runs; DoEvents raises nothing. -- **twinBASIC -2147467259 where VB raises 5 or 53** (the `argument-errors-unspecified-error` - family): AppActivate of a title or task id that matches no window (0, -1, 4, 2147483647, - **True**, **Empty**; VB 5); Shell of `""`, `" "`, a folder, `win.ini`, 33,000 characters (VB - 5), of a missing program or folder, 300 characters, an unbalanced quote (VB 53), and a - *windowstyle* of 11, -1, 32767, 32768, 2147483647 (VB 5); MsgBox and InputBox with a - *helpfile* and no *context* (VB 5). -- **SendKeys: twinBASIC -2147352567 (*Exception occurred.*) where VB raises 5**: an unknown or - unclosed brace (`"{"`, `"}"`, `"{}"`, `"{BAD}"`, `"{INS}"`, `"{F17}"`), a bad count (`"{LEFT x}"`, - `-1`, `32767`, `2147483648`, `"{LEFT2}"`), unbalanced parentheses (`"("`, `")"`, `"+("`, `"+(a"`, - `"a)"`), `"++"`; and for *wait*: **Null** (VB 94), `"x"` (VB 13). `"{INS}"` is in the page's - table and refused by all four (VB too): the page is wrong. -- **twinBASIC raises nothing where VB raises**: AppActivate of a hidden window (VB 5), with - *wait* **Null** (94) or `"x"` (13); AppActivate `""` (VB6 5; 64-bit VBA 0, as twinBASIC); - Shell *windowstyle* 10 (VB 5); SendKeys *wait* `"True"` (VB 13); MsgBox and InputBox with a - *context* and no *helpfile* (VB 5); InputBox *xpos*/*ypos* 2147483647 (VB 6); MsgBox and - InputBox *helpfile* **Null** raise 94 (VB 5). -- **MsgBox's *buttons*, no error either side**: VB6 and 64-bit VBA pass a style they do not - know as 0 (an OK box): 6, 7, 8, 15, two icons (&H50, &H70), &H80, &H400, -1, &H7FFFFFFF. - twinBASIC passes every style to Windows as given: 6, &H50, &H70, &H80, &H400 show a box of - Windows' making; **7, 8 and 15 show no box and return 0**; **-1 and &H7FFFFFFF carry - MB_SERVICE_NOTIFICATION** (the guard refused them; unguarded, the box goes to the user's - input desktop, from any desktop and any session's service). -- **SendKeys' keys, no error either side**: the same events in all four for every code of - the page's tables, `{n}` counts, modifiers and `~`; differences: a character outside the - ANSI keyboard: `"é"` sends virtual key &HE9 (VB: the character, as KEYEVENTF_UNICODE), - `ChrW(&H263A)` sends `?` (VB: the character), `"Ā"` sends Shift+A (VB: `?`); `"((a))"` - sends `a` (VB: Shift, then `a` three times); `"+"` and `"+a+"` send Shift once where VB - presses it twice. And VB6 and VBA keep the keys before a refused token and send them with - the next SendKeys (`"a{BAD}"`, then `"{LEFT 0}"` sends `a`); twinBASIC sends nothing. -- **AppActivate's 2 s**: in a twinBASIC exe on the private desktop, activating a new - top-level window takes 2 s from the third one on, by `CreateWindowEx` with `WS_VISIBLE` as - by AppActivate; `DoEvents` before or after changes nothing; VB6 and VBA take none. - `errors.mjs` now gives a twinBASIC probe 120 s. - -**Before the commit**: delete `errors/harnesses/trace.bas` and `errors/Explore.yml`, and take -`"trace"` out of `ATTENDED_HARNESSES` in `scripts/lib/errors-data.mjs`. - -**Questions for the owner (asked 2026-10-22), which decide the data:** - -- Q1. SendKeys' -2147352567 where VB raises 5, 13 or 94: into `argument-errors-unspecified-error` - (queued, not filed), or an entry of its own? -- Q2. Extensions or bugs, where twinBASIC raises nothing and VB raises: AppActivate `""` - (VB6 5, 64-bit VBA none) and of a hidden window (VB 5); AppActivate's *wait* not checked - (**Null**, `"x"`); Shell *windowstyle* 10 (`SW_SHOWDEFAULT`); SendKeys *wait* `"True"`; - MsgBox/InputBox *context* without *helpfile*; InputBox *xpos* 2147483647; *helpfile* - **Null** raising 94 where VB raises 5. -- Q3. MsgBox styles: twinBASIC passes every style to Windows, VB maps an unknown one to an OK - box. Bugs to queue: 7, 8 and 15 showing no box and returning 0 (silent); -1 and &H7FFFFFFF - sending the box to the user's input desktop. An extension: 6 (Cancel, Try Again, - Continue), &H50, &H70, &H80, &H400 passed to Windows? -- Q4. SendKeys of a character outside the keyboard (`"é"`, `ChrW(&H263A)`, `"Ā"`) sends the - wrong key, silently: a bug and a WARNING on the page? And `"((a))"`, the doubled Shift, VB's - keeping keys after a refused token: document nothing (VB's own oddities)? -- Q5. The 2 s window activation: try it once on your desktop, or leave it (it raises nothing)? - -**Owner's answers (2026-10-27):** Q1 join `argument-errors-unspecified-error`. Q2: InputBox's -*xpos*/*ypos* 2147483647 and MsgBox/InputBox *context* without *helpfile* must raise (bugs); -Shell *windowstyle* 10 must raise if it is not valid: it is not (`STARTUPINFO.wShowWindow` -takes any `ShowWindow` value but `SW_SHOWDEFAULT`, 10; `CreateProcessW` does not check it). -All four runtimes call `CreateProcessW` with `STARTF_USESHOWWINDOW` and the style as given; -VB6 and VBA check 0 to 9 after rounding first (9.4 passes, 9.6 raises 5), twinBASIC 0 to 10, -and nothing done first (a Shell, DoEvents, an Integer, Byte or String 10) makes VB take 10. -Q3, Q4: explained, waiting. Q5: the desktop test is built (`desktest/` in the scratchpad: -the same 8 windows by twinBASIC and VB6; on the private desktop twinBASIC takes 2 s to make -each from the third, VB6 none) and waits for the owner's go. The rest of Q2 is still open. - -**Owner's answers (2026-10-27, second round):** AppActivate `""` is an extension. AppActivate of -a hidden window: twinBASIC leaves it hidden (VB 5), so not useful: a bug. AppActivate's *wait* -must be checked (bug). *helpfile* **Null** raising 94: a bug. MsgBox *buttons*: twinBASIC should -take every style Windows takes and raise when Windows refuses one: 7, 8, 15 (silently no box) are -a bug. SendKeys of non-ASCII text: a bug. The broker race: both fixes made (client retry in -`tb-broker.mjs`, `ListenNow` in `BrokerServer.twin`, installed, `test/broker.test.mjs` 14/14; the -tblaunch session told). Still open: SendKeys *wait* `"True"`; the minor SendKeys differences; -whether to test -1/&H7FFFFFFF unguarded; the desktop test's go. - -**Third round (2026-10-27):** SendKeys *wait* `"True"`: an extension. `"((a))"`, the doubled -Shift and VB's keeping keys after a refused token: VB's, nothing documented (VB's keeping is -arguably a VB bug; twinBASIC's dropping the string is right). Unguarded MsgBox -1 and -&H7FFFFFFF: Windows refuses them before any box (returns 0, nothing shown anywhere), so they are -the 7/8/15 bug; twinBASIC should raise 5 for every style Windows refuses. The private-desktop 2 s -is a twinBASIC bug to queue (owner); on the user's desktop there is none. AppActivate on the -user's desktop: VB6 made windows 2 to 8 the foreground one, twinBASIC none (the first run started -the programs hidden; a rerun with a throwaway first window waits for the owner's go). - -**Paused 2026-10-27 (owner rearranging commits).** Done since: steps 5 and 6 (data, all 355 -cases of `VBA.Interaction.yml` agree in all four runtimes; sections and page edits, committed). -`argument-errors-unspecified-error` extended (8 cases, entry text, packed, verifies). -`scripts/lib/vb6.mjs`: `reproAnswersBoxes` lets a reproducer's VB6 project that carries the -dialog harness call MsgBox and InputBox, built without Unattended Execution (needs a probe in -`test/example-batches.test.mjs` and a line in Tools-Defects' bug_repro entry). In progress: -`bugs/interaction-missing-argument-checks/` (written by a scratch generator; tB side 3 PASS and -12 FAIL, VB6 side right): set `repro.json`'s expected lines, write its entry in BUGS-TO-REPORT.md, -pack, replace `bug: pending` in the data with its slug. Left: `sendkeys-non-ascii` (reproducer -with a copy of keys.bas, entry; the WARNING on SendKeys names it), the private-desktop 2 s entry -(reproducer from the scratchpad's desktest programs), step 8 (gates, findings into -WIP.Errors.md, this file deleted). `errors/harnesses/trace.bas` is scratch, uncommitted. - -## 5. The data - -- [ ] The rows and quiet cases in `errors/VBA.Interaction.yml`, after 6a's pages, each page's - `harness:` set; `node scripts/errors.mjs run VBA.Interaction.yml --only - "(AppActivate|DoEvents|InputBox|MsgBox|SendKeys|Shell)\.md$"` until all agree in all four - runtimes. -- [ ] Afterwards, `run` of the whole file, so that 6a's pages still agree beside the new ones. -- [ ] Check that no `tbdocsErrorsProbe*` window, process or registry key is left, and that - the Application event log has no new entries from a VB6 probe (Unattended Execution off). - -## 6. The pages - -- [ ] `node scripts/errors.mjs write`. -- [ ] Shell: its opening says it returns zero when the program cannot be started, and its text - that an error is raised; the table settles which, and the other goes (or becomes a - `` comment if both VB runtimes contradict it). -- [ ] MsgBox and InputBox: the sentences "If *helpfile* is supplied, *context* must also be - supplied" (and the reverse) go into the table if an error is raised, and stay as prose if - none is. -- [ ] SendKeys: the NOTE on `{PRTSC}` checked against the cases. -- [ ] The module's `index.md` for the same claims. - -## 7. Differences - -- [ ] Each difference from VB6 or 64-bit VBA: `bug: pending`, then a `tests` reproducer - with a `vb6/` side (`node scripts/bug_repro.mjs new --template tests`; one that needs - a harness carries a copy of its code), the entry in BUGS-TO-REPORT.md, the slug in the - data. A reproducer for MsgBox or InputBox needs the same hook, since it must not open a box - either. -- [ ] Where twinBASIC accepts what VB6 refuses: ask the owner before queuing. -- [ ] Group as 6a did where the cause is one (an argument error raised as -2147467259 joins - `argument-errors-unspecified-error`). - -## 8. Gates and the end - -- [ ] `build.bat` (0 broken), `node scripts/check_errors.mjs`, `test.bat`, `check.bat`. -- [ ] Commit on `staging` by path, one-line message. -- [ ] WIP.Errors.md: *Where things stand*, *Batch 6b findings*, the batch row; this file - deleted; the questions for the owner listed. diff --git a/WIP.Errors.md b/WIP.Errors.md index 1e87740a..30fd8e94 100644 --- a/WIP.Errors.md +++ b/WIP.Errors.md @@ -64,9 +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. Its design is *Batch 6b design* -below, and its steps are in [ERRORS-6B-PLAN.md](ERRORS-6B-PLAN.md). The owner answered D1 -to D4 on 2026-10-22. +**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 @@ -815,6 +819,51 @@ document VB6, and such an error is a VB6 bug for practical purposes; it is not c 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 @@ -895,7 +944,7 @@ each can be run when there is budget. Status is kept here. | 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 | done: 27 sections, 302 cases; four entries queued 2026-10-22 | -| 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`; *Batch 6b design* proposes the `dialog`, `keys` and `window` harnesses to replace the first two limits) | 7 | design 2026-10-22, plan in ERRORS-6B-PLAN.md; D1--D4 answered; not started | +| 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/docs/Documentation/Tools-Defects.md b/docs/Documentation/Tools-Defects.md index a0d1954b..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`, unless the project carries a copy of the dialog harness of [`errors.mjs`](#errorsmjs) (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`. | +| `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. |