Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Backport "registry" version 1.3.3, so all active branches now have the same registry version. (this commit must -eventually- be merge-marked to core-8-6-branch, since everything is there already) |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | core-8-5-branch |
| Files: | files | file ages | folders |
| SHA3-256: |
e4761eb0a8434af30ea554566d851b67 |
| User & Date: | jan.nijtmans 2018-10-24 21:22:18 |
Context
|
2018-10-27
| ||
| 07:53 | tclWinDde.c: Backport version 1.4.1 from Tcl 8.6. check-in: 714f445acf user: jan.nijtmans tags: core-8-5-branch | |
|
2018-10-24
| ||
| 21:22 | Backport "registry" version 1.3.3, so all active branches now have the same registry version. (this... check-in: e4761eb0a8 user: jan.nijtmans tags: core-8-5-branch | |
|
2018-10-23
| ||
| 11:14 | Enable CI builds with Travis. check-in: 0386db909a user: dkf tags: core-8-5-branch | |
Changes
Changes to library/reg/pkgIndex.tcl.
1 1 if {![package vsatisfies [package provide Tcl] 8]} return 2 2 if {[info sharedlibextension] != ".dll"} return 3 3 if {[info exists ::tcl_platform(debug)]} { 4 - package ifneeded registry 1.2.2 \ 5 - [list load [file join $dir tclreg12g.dll] registry] 4 + package ifneeded registry 1.3.3 \ 5 + [list load [file join $dir tclreg13g.dll] registry] 6 6 } else { 7 - package ifneeded registry 1.2.2 \ 8 - [list load [file join $dir tclreg12.dll] registry] 7 + package ifneeded registry 1.3.3 \ 8 + [list load [file join $dir tclreg13.dll] registry] 9 9 }
Changes to tests/registry.test.
15 15 namespace import -force ::tcltest::* 16 16 } 17 17 18 18 testConstraint reg 0 19 19 if {[testConstraint win]} { 20 20 if {![catch { 21 21 ::tcltest::loadTestedCommands 22 - package require registry 22 + set ::regver [package require registry 1.3.3] 23 23 }]} { 24 24 testConstraint reg 1 25 25 } 26 26 } 27 27 28 28 # determine the current locale 29 29 testConstraint english [expr { 30 30 [llength [info commands testlocale]] 31 31 && [string match "English*" [testlocale all ""]] 32 32 }] 33 - 33 + 34 +test registry-1.0 {check if we are testing the right dll} {win reg} { 35 + set ::regver 36 +} {1.3.3} 34 37 test registry-1.1 {argument parsing for registry command} {win reg} { 35 38 list [catch {registry} msg] $msg 36 -} {1 {wrong # args: should be "registry option ?arg arg ...?"}} 39 +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} 40 +test registry-1.1a {argument parsing for registry command} {win reg} { 41 + list [catch {registry -32bit} msg] $msg 42 +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} 43 +test registry-1.1b {argument parsing for registry command} {win reg} { 44 + list [catch {registry -64bit} msg] $msg 45 +} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}} 37 46 test registry-1.2 {argument parsing for registry command} {win reg} { 38 47 list [catch {registry foo} msg] $msg 39 48 } {1 {bad option "foo": must be broadcast, delete, get, keys, set, type, or values}} 49 +test registry-1.2a {argument parsing for registry command} {win reg} { 50 + list [catch {registry -33bit foo} msg] $msg 51 +} {1 {bad mode "-33bit": must be -32bit or -64bit}} 40 52 41 53 test registry-1.3 {argument parsing for registry command} {win reg} { 42 54 list [catch {registry d} msg] $msg 43 55 } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} 56 +test registry-1.3a {argument parsing for registry command} {win reg} { 57 + list [catch {registry -32bit d} msg] $msg 58 +} {1 {wrong # args: should be "registry -32bit delete keyName ?valueName?"}} 59 +test registry-1.3b {argument parsing for registry command} {win reg} { 60 + list [catch {registry -64bit d} msg] $msg 61 +} {1 {wrong # args: should be "registry -64bit delete keyName ?valueName?"}} 44 62 test registry-1.4 {argument parsing for registry command} {win reg} { 45 63 list [catch {registry delete} msg] $msg 46 64 } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} 47 65 test registry-1.5 {argument parsing for registry command} {win reg} { 48 66 list [catch {registry delete foo bar baz} msg] $msg 49 67 } {1 {wrong # args: should be "registry delete keyName ?valueName?"}} 50 68 51 69 test registry-1.6 {argument parsing for registry command} {win reg} { 52 70 list [catch {registry g} msg] $msg 53 71 } {1 {wrong # args: should be "registry get keyName valueName"}} 72 +test registry-1.6a {argument parsing for registry command} {win reg} { 73 + list [catch {registry -32bit g} msg] $msg 74 +} {1 {wrong # args: should be "registry -32bit get keyName valueName"}} 75 +test registry-1.6b {argument parsing for registry command} {win reg} { 76 + list [catch {registry -64bit g} msg] $msg 77 +} {1 {wrong # args: should be "registry -64bit get keyName valueName"}} 54 78 test registry-1.7 {argument parsing for registry command} {win reg} { 55 79 list [catch {registry get} msg] $msg 56 80 } {1 {wrong # args: should be "registry get keyName valueName"}} 57 81 test registry-1.8 {argument parsing for registry command} {win reg} { 58 82 list [catch {registry get foo} msg] $msg 59 83 } {1 {wrong # args: should be "registry get keyName valueName"}} 60 84 test registry-1.9 {argument parsing for registry command} {win reg} { 61 85 list [catch {registry get foo bar baz} msg] $msg 62 86 } {1 {wrong # args: should be "registry get keyName valueName"}} 63 87 64 88 test registry-1.10 {argument parsing for registry command} {win reg} { 65 89 list [catch {registry k} msg] $msg 66 90 } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} 91 +test registry-1.10a {argument parsing for registry command} {win reg} { 92 + list [catch {registry -32bit k} msg] $msg 93 +} {1 {wrong # args: should be "registry -32bit keys keyName ?pattern?"}} 94 +test registry-1.10b {argument parsing for registry command} {win reg} { 95 + list [catch {registry -64bit k} msg] $msg 96 +} {1 {wrong # args: should be "registry -64bit keys keyName ?pattern?"}} 67 97 test registry-1.11 {argument parsing for registry command} {win reg} { 68 98 list [catch {registry keys} msg] $msg 69 99 } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} 70 100 test registry-1.12 {argument parsing for registry command} {win reg} { 71 101 list [catch {registry keys foo bar baz} msg] $msg 72 102 } {1 {wrong # args: should be "registry keys keyName ?pattern?"}} 73 103 74 104 test registry-1.13 {argument parsing for registry command} {win reg} { 75 105 list [catch {registry s} msg] $msg 76 106 } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} 107 +test registry-1.13a {argument parsing for registry command} {win reg} { 108 + list [catch {registry -32bit s} msg] $msg 109 +} {1 {wrong # args: should be "registry -32bit set keyName ?valueName data ?type??"}} 110 +test registry-1.13b {argument parsing for registry command} {win reg} { 111 + list [catch {registry -64bit s} msg] $msg 112 +} {1 {wrong # args: should be "registry -64bit set keyName ?valueName data ?type??"}} 77 113 test registry-1.14 {argument parsing for registry command} {win reg} { 78 114 list [catch {registry set} msg] $msg 79 115 } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} 80 116 test registry-1.15 {argument parsing for registry command} {win reg} { 81 117 list [catch {registry set foo bar} msg] $msg 82 118 } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} 83 119 test registry-1.16 {argument parsing for registry command} {win reg} { 84 120 list [catch {registry set foo bar baz blat gorp} msg] $msg 85 121 } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}} 86 122 87 123 test registry-1.17 {argument parsing for registry command} {win reg} { 88 124 list [catch {registry t} msg] $msg 89 125 } {1 {wrong # args: should be "registry type keyName valueName"}} 126 +test registry-1.17a {argument parsing for registry command} {win reg} { 127 + list [catch {registry -32bit t} msg] $msg 128 +} {1 {wrong # args: should be "registry -32bit type keyName valueName"}} 129 +test registry-1.17b {argument parsing for registry command} {win reg} { 130 + list [catch {registry -64bit t} msg] $msg 131 +} {1 {wrong # args: should be "registry -64bit type keyName valueName"}} 90 132 test registry-1.18 {argument parsing for registry command} {win reg} { 91 133 list [catch {registry type} msg] $msg 92 134 } {1 {wrong # args: should be "registry type keyName valueName"}} 93 135 test registry-1.19 {argument parsing for registry command} {win reg} { 94 136 list [catch {registry type foo} msg] $msg 95 137 } {1 {wrong # args: should be "registry type keyName valueName"}} 96 138 test registry-1.20 {argument parsing for registry command} {win reg} { 97 139 list [catch {registry type foo bar baz} msg] $msg 98 140 } {1 {wrong # args: should be "registry type keyName valueName"}} 99 141 100 142 test registry-1.21 {argument parsing for registry command} {win reg} { 101 143 list [catch {registry v} msg] $msg 102 144 } {1 {wrong # args: should be "registry values keyName ?pattern?"}} 145 +test registry-1.21a {argument parsing for registry command} {win reg} { 146 + list [catch {registry -32bit v} msg] $msg 147 +} {1 {wrong # args: should be "registry -32bit values keyName ?pattern?"}} 148 +test registry-1.21b {argument parsing for registry command} {win reg} { 149 + list [catch {registry -64bit v} msg] $msg 150 +} {1 {wrong # args: should be "registry -64bit values keyName ?pattern?"}} 103 151 test registry-1.22 {argument parsing for registry command} {win reg} { 104 152 list [catch {registry values} msg] $msg 105 153 } {1 {wrong # args: should be "registry values keyName ?pattern?"}} 106 154 test registry-1.23 {argument parsing for registry command} {win reg} { 107 155 list [catch {registry values foo bar baz} msg] $msg 108 156 } {1 {wrong # args: should be "registry values keyName ?pattern?"}} 109 157 110 158 test registry-2.1 {DeleteKey: bad key} {win reg} { 111 159 list [catch {registry delete foo} msg] $msg 112 160 } {1 {bad root name "foo": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} 113 161 test registry-2.2 {DeleteKey: bad key} {win reg} { 114 - list [catch {registry delete HKEY_CURRENT_USER} msg] $msg 162 + list [catch {registry delete HKEY_CLASSES_ROOT} msg] $msg 115 163 } {1 {bad key: cannot delete root keys}} 116 164 test registry-2.3 {DeleteKey: bad key} {win reg} { 117 - list [catch {registry delete HKEY_CURRENT_USER\\} msg] $msg 165 + list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg 118 166 } {1 {bad key: cannot delete root keys}} 119 167 test registry-2.4 {DeleteKey: subkey at root level} {win reg} { 120 168 registry set HKEY_CURRENT_USER\\TclFoobar 121 169 registry delete HKEY_CURRENT_USER\\TclFoobar 122 170 registry keys HKEY_CURRENT_USER TclFoobar 123 171 } {} 124 172 test registry-2.5 {DeleteKey: subkey below root level} {win reg} { ................................................................................ 231 279 registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u00c7bar 232 280 registry set HKEY_CURRENT_USER\\TclFoobar\\blat 233 281 registry set HKEY_CURRENT_USER\\TclFoobar\\foo 234 282 set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] 235 283 registry delete HKEY_CURRENT_USER\\TclFoobar 236 284 set result 237 285 } "baz\u00c7bar blat" 238 -test registry-4.8 {GetKeyNames: Unicode} {win reg nt} { 286 +test registry-4.8 {GetKeyNames: Unicode} {win reg} { 239 287 registry delete HKEY_CURRENT_USER\\TclFoobar 240 288 registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar 241 289 registry set HKEY_CURRENT_USER\\TclFoobar\\blat 242 290 registry set HKEY_CURRENT_USER\\TclFoobar\\foo 243 291 set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]] 244 292 registry delete HKEY_CURRENT_USER\\TclFoobar 245 293 set result ................................................................................ 435 483 } 1 436 484 test registry-6.17 {GetValue: Unicode value names} {win reg} { 437 485 registry set HKEY_CURRENT_USER\\TclFoobar val\u00c71 foobar multi_sz 438 486 set result [registry get HKEY_CURRENT_USER\\TclFoobar val\u00c71] 439 487 registry delete HKEY_CURRENT_USER\\TclFoobar 440 488 set result 441 489 } foobar 442 -test registry-6.18 {GetValue: values with Unicode strings} {win reg nt} { 490 +test registry-6.18 {GetValue: values with Unicode strings} {win reg} { 443 491 registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz 444 492 set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] 445 493 registry delete HKEY_CURRENT_USER\\TclFoobar 446 494 set result 447 495 } "foo ba\u30b7r baz" 448 496 test registry-6.19 {GetValue: values with Unicode strings} {win reg english} { 449 497 registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz ................................................................................ 453 501 } "foo ba\u00c7r baz" 454 502 test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {win reg} { 455 503 registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz 456 504 set result [registry get HKEY_CURRENT_USER\\TclFoobar val1] 457 505 registry delete HKEY_CURRENT_USER\\TclFoobar 458 506 set result 459 507 } "foo ba r baz" 460 -test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} { 461 - registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 199] [string repeat x 199] multi_sz 462 - set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 199]] 508 +test registry-6.21 {GetValue: very long value names and values} {win reg} { 509 + registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz 510 + set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]] 463 511 registry delete HKEY_CURRENT_USER\\TclFoobar 464 512 set result 465 -} [string repeat x 199] 513 +} [string repeat x 16383] 466 514 467 -test registry-7.1 {GetValueNames: bad key} {win reg english} { 515 +test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup { 468 516 registry delete HKEY_CURRENT_USER\\TclFoobar 469 - list [catch {registry values HKEY_CURRENT_USER\\TclFoobar} msg] $msg 470 -} {1 {unable to open key: The system cannot find the file specified.}} 471 -test registry-7.2 {GetValueNames} {win reg} { 517 +} -body { 518 + registry values HKEY_CURRENT_USER\\TclFoobar 519 +} -returnCodes error -result {unable to open key: The system cannot find the file specified.} 520 +test registry-7.2 {GetValueNames} -constraints {win reg} -setup { 472 521 registry delete HKEY_CURRENT_USER\\TclFoobar 473 522 registry set HKEY_CURRENT_USER\\TclFoobar baz foobar 474 - set result [registry values HKEY_CURRENT_USER\\TclFoobar] 523 +} -body { 524 + registry values HKEY_CURRENT_USER\\TclFoobar 525 +} -cleanup { 475 526 registry delete HKEY_CURRENT_USER\\TclFoobar 476 - set result 477 -} baz 478 -test registry-7.3 {GetValueNames} {win reg} { 527 +} -result baz 528 +test registry-7.3 {GetValueNames} -constraints {win reg} -setup { 479 529 registry delete HKEY_CURRENT_USER\\TclFoobar 480 530 registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1 481 531 registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2 482 532 registry set HKEY_CURRENT_USER\\TclFoobar {} foobar3 483 - set result [lsort [registry values HKEY_CURRENT_USER\\TclFoobar]] 533 +} -body { 534 + lsort [registry values HKEY_CURRENT_USER\\TclFoobar] 535 +} -cleanup { 484 536 registry delete HKEY_CURRENT_USER\\TclFoobar 485 - set result 486 -} {{} baz blat} 487 -test registry-7.4 {GetValueNames: remote key} {win reg nonPortable english} { 537 +} -result {{} baz blat} 538 +test registry-7.4 {GetValueNames: remote key} -constraints {win reg nonPortable english} -body { 488 539 set hostname [info hostname] 489 540 registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar baz blat 490 541 set result [registry values \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar] 491 542 registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar 492 543 set result 493 -} baz 494 -test registry-7.5 {GetValueNames: empty key} {win reg} { 544 +} -result baz 545 +test registry-7.5 {GetValueNames: empty key} -constraints {win reg} -setup { 495 546 registry delete HKEY_CURRENT_USER\\TclFoobar 496 547 registry set HKEY_CURRENT_USER\\TclFoobar 497 - set result [registry values HKEY_CURRENT_USER\\TclFoobar] 548 +} -body { 549 + registry values HKEY_CURRENT_USER\\TclFoobar 550 +} -cleanup { 498 551 registry delete HKEY_CURRENT_USER\\TclFoobar 499 - set result 500 -} {} 501 -test registry-7.6 {GetValueNames: patterns} {win reg} { 552 +} -result {} 553 +test registry-7.6 {GetValueNames: patterns} -constraints {win reg} -setup { 502 554 registry delete HKEY_CURRENT_USER\\TclFoobar 503 555 registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1 504 556 registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2 505 557 registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3 506 - set result [lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]] 558 +} -body { 559 + lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*] 560 +} -cleanup { 507 561 registry delete HKEY_CURRENT_USER\\TclFoobar 508 - set result 509 -} {baz blat} 510 -test registry-7.7 {GetValueNames: names with spaces} {win reg} { 562 +} -result {baz blat} 563 +test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -setup { 511 564 registry delete HKEY_CURRENT_USER\\TclFoobar 512 565 registry set HKEY_CURRENT_USER\\TclFoobar baz\ bar foobar1 513 566 registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2 514 567 registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3 515 - set result [lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]] 568 +} -body { 569 + lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*] 570 +} -cleanup { 516 571 registry delete HKEY_CURRENT_USER\\TclFoobar 517 - set result 518 -} {{baz bar} blat} 572 +} -result {{baz bar} blat} 519 573 520 -test registry-8.1 {OpenSubKey} {win reg nonPortable english} { 521 - # This test will only succeed if the current user does not have registry 522 - # access on the specified machine. 523 - list [catch {registry keys {\\mom\HKEY_LOCAL_MACHINE}} msg] $msg 524 -} {1 {unable to open key: Access is denied.}} 525 -test registry-8.2 {OpenSubKey} {win reg} { 574 +test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} \ 575 + -body { 576 + # This test will only succeed if the current user does not have 577 + # registry access on the specified machine. 578 + registry keys {\\mom\HKEY_LOCAL_MACHINE} 579 + } -returnCodes error -result "unable to open key: Access is denied." 580 +test registry-8.2 {OpenSubKey} -constraints {win reg} -setup { 526 581 registry delete HKEY_CURRENT_USER\\TclFoobar 527 582 registry set HKEY_CURRENT_USER\\TclFoobar 528 - set result [registry keys HKEY_CURRENT_USER TclFoobar] 583 +} -body { 584 + registry keys HKEY_CURRENT_USER TclFoobar 585 +} -cleanup { 529 586 registry delete HKEY_CURRENT_USER\\TclFoobar 530 - set result 531 -} TclFoobar 532 -test registry-8.3 {OpenSubKey} {win reg english} { 587 +} -result {TclFoobar} 588 +test registry-8.3 {OpenSubKey} -constraints {win reg english} -setup { 533 589 registry delete HKEY_CURRENT_USER\\TclFoobar 534 - list [catch {registry keys HKEY_CURRENT_USER\\TclFoobar} msg] $msg 535 -} {1 {unable to open key: The system cannot find the file specified.}} 590 +} -body { 591 + registry keys HKEY_CURRENT_USER\\TclFoobar 592 +} -returnCodes error \ 593 + -result "unable to open key: The system cannot find the file specified." 536 594 537 -test registry-9.1 {ParseKeyName: bad keys} {win reg} { 538 - list [catch {registry values \\} msg] $msg 539 -} "1 {bad key \"\\\": must start with a valid root}" 540 -test registry-9.2 {ParseKeyName: bad keys} {win reg} { 541 - list [catch {registry values \\foobar} msg] $msg 542 -} {1 {bad key "\foobar": must start with a valid root}} 543 -test registry-9.3 {ParseKeyName: bad keys} {win reg} { 544 - list [catch {registry values \\\\} msg] $msg 545 -} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} 546 -test registry-9.4 {ParseKeyName: bad keys} {win reg} { 547 - list [catch {registry values \\\\\\} msg] $msg 548 -} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} 549 -test registry-9.5 {ParseKeyName: bad keys} {win reg english nt} { 550 - list [catch {registry values \\\\\\HKEY_CURRENT_USER} msg] $msg 551 -} {1 {unable to open key: The network address is invalid.}} 552 -test registry-9.6 {ParseKeyName: bad keys} {win reg} { 553 - list [catch {registry values \\\\gaspode} msg] $msg 554 -} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} 555 -test registry-9.7 {ParseKeyName: bad keys} {win reg} { 556 - list [catch {registry values foobar} msg] $msg 557 -} {1 {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}} 558 -test registry-9.8 {ParseKeyName: null keys} {win reg} { 559 - list [catch {registry delete HKEY_CURRENT_USER\\} msg] $msg 560 -} {1 {bad key: cannot delete root keys}} 561 -test registry-9.9 {ParseKeyName: null keys} {win reg english} { 562 - list [catch {registry keys HKEY_CURRENT_USER\\TclFoobar\\baz} msg] $msg 563 -} {1 {unable to open key: The system cannot find the file specified.}} 595 +test registry-9.1 {ParseKeyName: bad keys} -constraints {win reg} -body { 596 + registry values \\ 597 +} -returnCodes error -result "bad key \"\\\": must start with a valid root" 598 +test registry-9.2 {ParseKeyName: bad keys} -constraints {win reg} -body { 599 + registry values \\foobar 600 +} -returnCodes error -result {bad key "\foobar": must start with a valid root} 601 +test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body { 602 + registry values \\\\ 603 +} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} 604 +test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body { 605 + registry values \\\\\\ 606 +} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} 607 +test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english} -body { 608 + registry values \\\\\\HKEY_CLASSES_ROOT 609 +} -returnCodes error -result {unable to open key: The network address is invalid.} 610 +test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body { 611 + registry values \\\\gaspode 612 +} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} 613 +test registry-9.7 {ParseKeyName: bad keys} -constraints {win reg} -body { 614 + registry values foobar 615 +} -returnCodes error -result {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA} 616 +test registry-9.8 {ParseKeyName: null keys} -constraints {win reg} -body { 617 + registry delete HKEY_CLASSES_ROOT\\ 618 +} -returnCodes error -result {bad key: cannot delete root keys} 619 +test registry-9.9 {ParseKeyName: null keys} \ 620 + -constraints {win reg english} \ 621 + -body {registry keys HKEY_CLASSES_ROOT\\TclFoobar\\baz} \ 622 + -returnCodes error \ 623 + -result {unable to open key: The system cannot find the file specified.} 564 624 565 -test registry-10.1 {RecursiveDeleteKey} {win reg} { 625 +test registry-10.1 {RecursiveDeleteKey} -constraints {win reg} -setup { 566 626 registry delete HKEY_CURRENT_USER\\TclFoobar 627 +} -body { 567 628 registry set HKEY_CURRENT_USER\\TclFoobar\\test1 568 629 registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3 569 630 registry delete HKEY_CURRENT_USER\\TclFoobar 570 631 set result [registry keys HKEY_CURRENT_USER TclFoobar] 571 632 set result 572 -} {} 573 -test registry-10.2 {RecursiveDeleteKey} {win reg} { 633 +} -result {} 634 +test registry-10.2 {RecursiveDeleteKey} -constraints {win reg} -setup { 574 635 registry delete HKEY_CURRENT_USER\\TclFoobar 575 636 registry set HKEY_CURRENT_USER\\TclFoobar\\test1 576 637 registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3 577 - set result [registry delete HKEY_CURRENT_USER\\TclFoobar\\test2\\test4] 638 +} -body { 639 + registry delete HKEY_CURRENT_USER\\TclFoobar\\test2\\test4 640 +} -cleanup { 578 641 registry delete HKEY_CURRENT_USER\\TclFoobar 579 - set result 580 -} {} 642 +} -result {} 581 643 582 -test registry-11.1 {SetValue: recursive creation} {win reg} { 583 - registry delete HKEY_CURRENT_USER\\TclFoobar 584 - registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar 585 - set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] 586 -} foobar 587 -test registry-11.2 {SetValue: modification} {win reg} { 588 - registry delete HKEY_CURRENT_USER\\TclFoobar 589 - registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar 590 - registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat frob 591 - set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] 592 -} frob 593 -test registry-11.3 {SetValue: failure} {win reg nonPortable english} { 594 - # This test will only succeed if the current user does not have registry 595 - # access on the specified machine. 596 - list [catch {registry set {\\mom\HKEY_CURRENT_USER\TclFoobar} bar foobar} msg] $msg 597 -} {1 {unable to open key: Access is denied.}} 644 +test registry-11.1 {SetValue: recursive creation} \ 645 + -constraints {win reg} -setup { 646 + registry delete HKEY_CURRENT_USER\\TclFoobar 647 + } -body { 648 + registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar 649 + set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] 650 + } -result {foobar} 651 +test registry-11.2 {SetValue: modification} -constraints {win reg} \ 652 + -setup { 653 + registry delete HKEY_CURRENT_USER\\TclFoobar 654 + } -body { 655 + registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar 656 + registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat frob 657 + set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat] 658 + } -result {frob} 659 +test registry-11.3 {SetValue: failure} \ 660 + -constraints {win reg nonPortable english} \ 661 + -body { 662 + # This test will only succeed if the current user does not have 663 + # registry access on the specified machine. 664 + registry set {\\mom\HKEY_CURRENT_USER\TclFoobar} bar foobar 665 + } -returnCodes error -result {unable to open key: Access is denied.} 598 666 599 -test registry-12.1 {BroadcastValue} {win reg} { 600 - list [catch {registry broadcast} msg] $msg 601 -} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}} 602 -test registry-12.2 {BroadcastValue} {win reg} { 603 - list [catch {registry broadcast "" -time} msg] $msg 604 -} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}} 605 -test registry-12.3 {BroadcastValue} {win reg} { 606 - list [catch {registry broadcast "" - 500} msg] $msg 607 -} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}} 608 -test registry-12.4 {BroadcastValue} {win reg} { 609 - list [catch {registry broadcast {Environment}} msg] $msg 610 -} {0 {1 0}} 611 -test registry-12.5 {BroadcastValue} {win reg} { 612 - list [catch {registry b {}} msg] $msg 613 -} {0 {1 0}} 614 - 667 +test registry-12.1 {BroadcastValue} -constraints {win reg} -body { 668 + registry broadcast 669 +} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\"" 670 +test registry-12.2 {BroadcastValue} -constraints {win reg} -body { 671 + registry broadcast "" -time 672 +} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\"" 673 +test registry-12.3 {BroadcastValue} -constraints {win reg} -body { 674 + registry broadcast "" - 500 675 +} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\"" 676 +test registry-12.4 {BroadcastValue} -constraints {win reg} -body { 677 + registry broadcast {Environment} 678 +} -result {1 0} 679 +test registry-12.5 {BroadcastValue} -constraints {win reg} -body { 680 + registry b {} 681 +} -result {1 0} 682 + 615 683 # cleanup 616 684 ::tcltest::cleanupTests 617 685 return 618 686 619 687 # Local Variables: 620 688 # mode: tcl 621 689 # tcl-indent-level: 4 622 690 # fill-column: 78 623 691 # End:
Changes to win/Makefile.in.
491 491 492 492 tclAppInit.${OBJEXT} : tclAppInit.c 493 493 $(CC) -c $(CC_SWITCHES) @[email protected] $(CC_OBJNAME) 494 494 495 495 # The following objects should be built using the stub interfaces 496 496 497 497 tclWinReg.${OBJEXT} : tclWinReg.c 498 - $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @[email protected] $(CC_OBJNAME) 498 + $(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE -DUSE_TCL_STUBS @[email protected] $(CC_OBJNAME) 499 499 500 500 tclWinDde.${OBJEXT} : tclWinDde.c 501 501 $(CC) -c $(CC_SWITCHES) -DUSE_TCL_STUBS @[email protected] $(CC_OBJNAME) 502 502 503 503 # TIP #59, embedding of configuration information into the binary library. 504 504 # 505 505 # Part of Tcl's configuration information are the paths where it was installed ................................................................................ 706 706 # tcltest, i.e.: 707 707 # % make test TESTFLAGS="-verbose bps -file fileName.test" 708 708 709 709 test: binaries $(TCLTEST) 710 710 TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ 711 711 ./$(TCLTEST) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \ 712 712 -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ 713 - package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) 713 + package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32) 714 714 715 715 # Useful target to launch a built tcltest with the proper path,... 716 716 runtest: binaries $(TCLTEST) 717 717 @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ 718 718 ./$(TCLTEST) $(TESTFLAGS) -load "package ifneeded dde 1.3.3 [list load [file normalize ${DDE_DLL_FILE}] dde]; \ 719 - package ifneeded registry 1.2.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) 719 + package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT) 720 720 721 721 # This target can be used to run tclsh from the build directory via 722 722 # `make shell SCRIPT=foo.tcl` 723 723 shell: binaries 724 724 @TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \ 725 725 ./$(TCLSH) $(SCRIPT) 726 726
Changes to win/configure.in.
18 18 VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION 19 19 20 20 TCL_DDE_VERSION=1.3 21 21 TCL_DDE_MAJOR_VERSION=1 22 22 TCL_DDE_MINOR_VERSION=3 23 23 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION 24 24 25 -TCL_REG_VERSION=1.2 25 +TCL_REG_VERSION=1.3 26 26 TCL_REG_MAJOR_VERSION=1 27 -TCL_REG_MINOR_VERSION=2 27 +TCL_REG_MINOR_VERSION=3 28 28 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION 29 29 30 30 #------------------------------------------------------------------------ 31 31 # Handle the --prefix=... option 32 32 #------------------------------------------------------------------------ 33 33 34 34 if test "${prefix}" = "NONE"; then
Changes to win/makefile.bc.
126 126 STUBPREFIX = $(NAMEPREFIX)stub 127 127 DOTVERSION = 8.5 128 128 VERSION = 85 129 129 130 130 DDEVERSION = 13 131 131 DDEDOTVERSION = 1.3 132 132 133 -REGVERSION = 12 134 -REGDOTVERSION = 1.2 133 +REGVERSION = 13 134 +REGDOTVERSION = 1.3 135 135 136 136 BINROOT = .. 137 137 !IF "$(NODEBUG)" == "1" 138 138 TMPDIRNAME = Release 139 139 DBGX = 140 140 SYMDEFINES = -DNDEBUG 141 141 !ELSE
Changes to win/makefile.vc.
181 181 STUBPREFIX = $(PROJECT)stub 182 182 DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION) 183 183 VERSION = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION) 184 184 185 185 DDEDOTVERSION = 1.3 186 186 DDEVERSION = $(DDEDOTVERSION:.=) 187 187 188 -REGDOTVERSION = 1.2 188 +REGDOTVERSION = 1.3 189 189 REGVERSION = $(REGDOTVERSION:.=) 190 190 191 191 BINROOT = . 192 192 ROOT = .. 193 193 194 194 TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib 195 195 TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT) ................................................................................ 535 535 536 536 test: test-core 537 537 test-core: setup $(TCLTEST) dlls $(CAT32) 538 538 set TCL_LIBRARY=$(ROOT:\=/)/library 539 539 !if "$(OS)" == "Windows_NT" || "$(MSVCDIR)" == "IDE" 540 540 $(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << 541 541 package ifneeded dde 1.3.3 [list load "$(TCLDDELIB:\=/)" dde] 542 - package ifneeded registry 1.2.2 [list load "$(TCLREGLIB:\=/)" registry] 542 + package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry] 543 543 << 544 544 !else 545 545 @echo Please wait while the tests are collected... 546 546 $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log 547 547 package ifneeded dde 1.3.3 "$(TCLDDELIB:\=/)" dde] 548 - package ifneeded registry 1.2.2 "$(TCLREGLIB:\=/)" registry] 548 + package ifneeded registry 1.3.3 "$(TCLREGLIB:\=/)" registry] 549 549 << 550 550 type tests.log | more 551 551 !endif 552 552 553 553 runtest: setup $(TCLTEST) dlls $(CAT32) 554 554 set TCL_LIBRARY=$(ROOT:\=/)/library 555 555 $(DEBUGGER) $(TCLTEST) $(SCRIPT) ................................................................................ 881 881 [email protected] $? 882 882 883 883 ### The following objects should be built using the stub interfaces 884 884 ### *ALL* extensions need to built with -DTCL_THREADS=1 885 885 886 886 $(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c 887 887 !if $(STATIC_BUILD) 888 - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD [email protected] $? 888 + $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD -DUNICODE -D_UNICODE [email protected] $? 889 889 !else 890 - $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS [email protected] $? 890 + $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DUSE_TCL_STUBS -DUNICODE -D_UNICODE [email protected] $? 891 891 !endif 892 892 893 893 894 894 $(TMP_DIR)\tclWinDde.obj: $(WINDIR)\tclWinDde.c 895 895 !if $(STATIC_BUILD) 896 896 $(cc32) $(TCL_CFLAGS) -DTCL_THREADS=1 -DSTATIC_BUILD [email protected] $? 897 897 !else
Changes to win/rules.vc.
586 586 TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe" 587 587 !if !exist($(TCLSH)) && $(TCL_THREADS) 588 588 TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe" 589 589 !endif 590 590 TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib" 591 591 TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" 592 592 TCL_LIBRARY = $(_TCLDIR)\lib 593 -TCLREGLIB = "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib" 593 +TCLREGLIB = "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib" 594 594 TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib" 595 595 COFFBASE = \must\have\tcl\sources\to\build\this\target 596 596 TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target 597 597 TCL_INCLUDES = -I"$(_TCLDIR)\include" 598 598 !else 599 599 TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe" 600 600 !if !exist($(TCLSH)) && $(TCL_THREADS) 601 601 TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe" 602 602 !endif 603 603 TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" 604 604 TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" 605 605 TCL_LIBRARY = $(_TCLDIR)\library 606 -TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib" 606 +TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib" 607 607 TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib" 608 608 COFFBASE = "$(_TCLDIR)\win\coffbase.txt" 609 609 TCLTOOLSDIR = $(_TCLDIR)\tools 610 610 TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" 611 611 !endif 612 612 613 613 !endif
Changes to win/tclWinReg.c.
8 8 * Copyright (c) 1997 by Sun Microsystems, Inc. 9 9 * Copyright (c) 1998-1999 by Scriptics Corporation. 10 10 * 11 11 * See the file "license.terms" for information on usage and redistribution of 12 12 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 13 */ 14 14 15 +#undef STATIC_BUILD 16 +#ifndef USE_TCL_STUBS 17 +# define USE_TCL_STUBS 18 +#endif 15 19 #include "tclInt.h" 16 -#include "tclPort.h" 17 20 #ifdef _MSC_VER 18 21 # pragma comment (lib, "advapi32.lib") 19 22 #endif 20 23 #include <stdlib.h> 21 24 22 25 /* 23 - * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the 24 - * Registry_Init declaration is in the source file itself, which is only 25 - * accessed when we are building a library. 26 + * Ensure that we can say which registry is being accessed. 26 27 */ 27 28 28 -#undef TCL_STORAGE_CLASS 29 -#define TCL_STORAGE_CLASS DLLEXPORT 29 +#ifndef KEY_WOW64_64KEY 30 +# define KEY_WOW64_64KEY (0x0100) 31 +#endif 32 +#ifndef KEY_WOW64_32KEY 33 +# define KEY_WOW64_32KEY (0x0200) 34 +#endif 30 35 31 36 /* 32 37 * The maximum length of a sub-key name. 33 38 */ 34 39 35 40 #ifndef MAX_KEY_LENGTH 36 -#define MAX_KEY_LENGTH 256 41 +# define MAX_KEY_LENGTH 256 37 42 #endif 38 43 39 44 /* 40 45 * The following macros convert between different endian ints. 41 46 */ 42 47 43 -#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) 44 -#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) 48 +#define SWAPWORD(x) MAKEWORD(HIBYTE(x), LOBYTE(x)) 49 +#define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x))) 45 50 46 51 /* 47 52 * The following flag is used in OpenKeys to indicate that the specified key 48 53 * should be created if it doesn't currently exist. 49 54 */ 50 55 51 56 #define REG_CREATE 1 52 57 53 58 /* 54 59 * The following tables contain the mapping from registry root names to the 55 60 * system predefined keys. 56 61 */ 57 62 58 -static CONST char *rootKeyNames[] = { 63 +static const char *const rootKeyNames[] = { 59 64 "HKEY_LOCAL_MACHINE", "HKEY_USERS", "HKEY_CLASSES_ROOT", 60 65 "HKEY_CURRENT_USER", "HKEY_CURRENT_CONFIG", 61 66 "HKEY_PERFORMANCE_DATA", "HKEY_DYN_DATA", NULL 62 67 }; 63 68 64 69 static const HKEY rootKeys[] = { 65 70 HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, 66 71 HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA 67 72 }; 68 73 69 -static CONST char REGISTRY_ASSOC_KEY[] = "registry::command"; 74 +static const char REGISTRY_ASSOC_KEY[] = "registry::command"; 70 75 71 76 /* 72 77 * The following table maps from registry types to strings. Note that the 73 78 * indices for this array are the same as the constants for the known registry 74 79 * types so we don't need a separate table to hold the mapping. 75 80 */ 76 81 77 -static CONST char *typeNames[] = { 82 +static const char *const typeNames[] = { 78 83 "none", "sz", "expand_sz", "binary", "dword", 79 84 "dword_big_endian", "link", "multi_sz", "resource_list", NULL 80 85 }; 81 86 82 87 static DWORD lastType = REG_RESOURCE_LIST; 83 - 84 -/* 85 - * The following structures allow us to select between the Unicode and ASCII 86 - * interfaces at run time based on whether Unicode APIs are available. The 87 - * Unicode APIs are preferable because they will handle characters outside of 88 - * the current code page. 89 - */ 90 - 91 -typedef struct RegWinProcs { 92 - int useWide; 93 - 94 - LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY); 95 - LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *, 96 - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *); 97 - LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *); 98 - LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *); 99 - LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD); 100 - LONG (WINAPI *regEnumKeyExProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, 101 - TCHAR *, DWORD *, FILETIME *); 102 - LONG (WINAPI *regEnumValueProc)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, 103 - DWORD *, BYTE *, DWORD *); 104 - LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM, 105 - HKEY *); 106 - LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *, 107 - BYTE *, DWORD *); 108 - LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD, 109 - CONST BYTE*, DWORD); 110 -} RegWinProcs; 111 - 112 -static RegWinProcs *regWinProcs; 113 - 114 -static RegWinProcs asciiProcs = { 115 - 0, 116 - 117 - (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA, 118 - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, 119 - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, 120 - DWORD *)) RegCreateKeyExA, 121 - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA, 122 - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA, 123 - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA, 124 - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, 125 - TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExA, 126 - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, 127 - DWORD *, BYTE *, DWORD *)) RegEnumValueA, 128 - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, 129 - HKEY *)) RegOpenKeyExA, 130 - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, 131 - BYTE *, DWORD *)) RegQueryValueExA, 132 - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, 133 - CONST BYTE*, DWORD)) RegSetValueExA, 134 -}; 135 - 136 -static RegWinProcs unicodeProcs = { 137 - 1, 138 - 139 - (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW, 140 - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *, 141 - DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, 142 - DWORD *)) RegCreateKeyExW, 143 - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW, 144 - (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW, 145 - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW, 146 - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, 147 - TCHAR *, DWORD *, FILETIME *)) RegEnumKeyExW, 148 - (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD *, DWORD *, 149 - DWORD *, BYTE *, DWORD *)) RegEnumValueW, 150 - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM, 151 - HKEY *)) RegOpenKeyExW, 152 - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *, 153 - BYTE *, DWORD *)) RegQueryValueExW, 154 - (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD, 155 - CONST BYTE*, DWORD)) RegSetValueExW, 156 -}; 157 - 158 88 159 89 /* 160 90 * Declarations for functions defined in this file. 161 91 */ 162 92 163 93 static void AppendSystemError(Tcl_Interp *interp, DWORD error); 164 94 static int BroadcastValue(Tcl_Interp *interp, int objc, 165 - Tcl_Obj * CONST objv[]); 95 + Tcl_Obj *const objv[]); 166 96 static DWORD ConvertDWORD(DWORD type, DWORD value); 167 97 static void DeleteCmd(ClientData clientData); 168 -static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj); 98 +static int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, 99 + REGSAM mode); 169 100 static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, 170 - Tcl_Obj *valueNameObj); 101 + Tcl_Obj *valueNameObj, REGSAM mode); 171 102 static int GetKeyNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, 172 - Tcl_Obj *patternObj); 103 + Tcl_Obj *patternObj, REGSAM mode); 173 104 static int GetType(Tcl_Interp *interp, Tcl_Obj *keyNameObj, 174 - Tcl_Obj *valueNameObj); 105 + Tcl_Obj *valueNameObj, REGSAM mode); 175 106 static int GetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, 176 - Tcl_Obj *valueNameObj); 107 + Tcl_Obj *valueNameObj, REGSAM mode); 177 108 static int GetValueNames(Tcl_Interp *interp, Tcl_Obj *keyNameObj, 178 - Tcl_Obj *patternObj); 109 + Tcl_Obj *patternObj, REGSAM mode); 179 110 static int OpenKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj, 180 111 REGSAM mode, int flags, HKEY *keyPtr); 181 112 static DWORD OpenSubKey(char *hostName, HKEY rootKey, 182 113 char *keyName, REGSAM mode, int flags, 183 114 HKEY *keyPtr); 184 115 static int ParseKeyName(Tcl_Interp *interp, char *name, 185 116 char **hostNamePtr, HKEY *rootKeyPtr, 186 117 char **keyNamePtr); 187 118 static DWORD RecursiveDeleteKey(HKEY hStartKey, 188 - CONST TCHAR * pKeyName); 119 + const TCHAR * pKeyName, REGSAM mode); 189 120 static int RegistryObjCmd(ClientData clientData, 190 121 Tcl_Interp *interp, int objc, 191 - Tcl_Obj * CONST objv[]); 122 + Tcl_Obj *const objv[]); 192 123 static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj, 193 124 Tcl_Obj *valueNameObj, Tcl_Obj *dataObj, 194 - Tcl_Obj *typeObj); 125 + Tcl_Obj *typeObj, REGSAM mode); 195 126 196 -EXTERN int Registry_Init(Tcl_Interp *interp); 197 -EXTERN int Registry_Unload(Tcl_Interp *interp, int flags); 127 +DLLEXPORT int Registry_Init(Tcl_Interp *interp); 128 +DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags); 198 129 199 130 /* 200 131 *---------------------------------------------------------------------- 201 132 * 202 133 * Registry_Init -- 203 134 * 204 135 * This function initializes the registry command. ................................................................................ 214 145 215 146 int 216 147 Registry_Init( 217 148 Tcl_Interp *interp) 218 149 { 219 150 Tcl_Command cmd; 220 151 221 - if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { 152 + if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { 222 153 return TCL_ERROR; 223 154 } 224 155 225 - /* 226 - * Determine if the unicode interfaces are available and select the 227 - * appropriate registry function table. 228 - */ 229 - 230 - if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) { 231 - regWinProcs = &unicodeProcs; 232 - } else { 233 - regWinProcs = &asciiProcs; 234 - } 235 - 236 156 cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, 237 - (ClientData)interp, DeleteCmd); 238 - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd); 239 - return Tcl_PkgProvide(interp, "registry", "1.2.2"); 157 + interp, DeleteCmd); 158 + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd); 159 + return Tcl_PkgProvide(interp, "registry", "1.3.3"); 240 160 } 241 161 242 162 /* 243 163 *---------------------------------------------------------------------- 244 164 * 245 165 * Registry_Unload -- 246 166 * ................................................................................ 272 192 objv[2] = Tcl_NewStringObj("registry", -1); 273 193 Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL); 274 194 275 195 /* 276 196 * Delete the originally registered command. 277 197 */ 278 198 279 - cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); 199 + cmd = Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL); 280 200 if (cmd != NULL) { 281 201 Tcl_DeleteCommandFromToken(interp, cmd); 282 202 } 283 203 284 204 return TCL_OK; 285 205 } 286 206 ................................................................................ 302 222 */ 303 223 304 224 static void 305 225 DeleteCmd( 306 226 ClientData clientData) 307 227 { 308 228 Tcl_Interp *interp = clientData; 309 - Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL); 229 + 230 + Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, NULL); 310 231 } 311 232 312 233 /* 313 234 *---------------------------------------------------------------------- 314 235 * 315 236 * RegistryObjCmd -- 316 237 * ................................................................................ 326 247 */ 327 248 328 249 static int 329 250 RegistryObjCmd( 330 251 ClientData clientData, /* Not used. */ 331 252 Tcl_Interp *interp, /* Current interpreter. */ 332 253 int objc, /* Number of arguments. */ 333 - Tcl_Obj * CONST objv[]) /* Argument values. */ 254 + Tcl_Obj *const objv[]) /* Argument values. */ 334 255 { 335 - int index; 336 - char *errString = NULL; 256 + int n = 1; 257 + int index, argc; 258 + REGSAM mode = 0; 259 + const char *errString = NULL; 337 260 338 - static CONST char *subcommands[] = { 261 + static const char *const subcommands[] = { 339 262 "broadcast", "delete", "get", "keys", "set", "type", "values", NULL 340 263 }; 341 264 enum SubCmdIdx { 342 265 BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx 343 266 }; 267 + static const char *const modes[] = { 268 + "-32bit", "-64bit", NULL 269 + }; 344 270 345 271 if (objc < 2) { 346 - Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?"); 272 + wrongArgs: 273 + Tcl_WrongNumArgs(interp, 1, objv, "?-32bit|-64bit? option ?arg ...?"); 347 274 return TCL_ERROR; 348 275 } 349 276 350 - if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "option", 0, &index) 351 - != TCL_OK) { 277 + if (Tcl_GetString(objv[n])[0] == '-') { 278 + if (Tcl_GetIndexFromObj(interp, objv[n++], modes, "mode", 0, 279 + &index) != TCL_OK) { 280 + return TCL_ERROR; 281 + } 282 + switch (index) { 283 + case 0: /* -32bit */ 284 + mode |= KEY_WOW64_32KEY; 285 + break; 286 + case 1: /* -64bit */ 287 + mode |= KEY_WOW64_64KEY; 288 + break; 289 + } 290 + if (objc < 3) { 291 + goto wrongArgs; 292 + } 293 + } 294 + 295 + if (Tcl_GetIndexFromObj(interp, objv[n++], subcommands, "option", 0, 296 + &index) != TCL_OK) { 352 297 return TCL_ERROR; 353 298 } 354 299 300 + argc = (objc - n); 355 301 switch (index) { 356 302 case BroadcastIdx: /* broadcast */ 357 - return BroadcastValue(interp, objc, objv); 303 + if (argc == 1 || argc == 3) { 304 + int res = BroadcastValue(interp, argc, objv + n); 305 + 306 + if (res != TCL_BREAK) { 307 + return res; 308 + } 309 + } 310 + errString = "keyName ?-timeout milliseconds?"; 358 311 break; 359 312 case DeleteIdx: /* delete */ 360 - if (objc == 3) { 361 - return DeleteKey(interp, objv[2]); 362 - } else if (objc == 4) { 363 - return DeleteValue(interp, objv[2], objv[3]); 313 + if (argc == 1) { 314 + return DeleteKey(interp, objv[n], mode); 315 + } else if (argc == 2) { 316 + return DeleteValue(interp, objv[n], objv[n+1], mode); 364 317 } 365 318 errString = "keyName ?valueName?"; 366 319 break; 367 320 case GetIdx: /* get */ 368 - if (objc == 4) { 369 - return GetValue(interp, objv[2], objv[3]); 321 + if (argc == 2) { 322 + return GetValue(interp, objv[n], objv[n+1], mode); 370 323 } 371 324 errString = "keyName valueName"; 372 325 break; 373 326 case KeysIdx: /* keys */ 374 - if (objc == 3) { 375 - return GetKeyNames(interp, objv[2], NULL); 376 - } else if (objc == 4) { 377 - return GetKeyNames(interp, objv[2], objv[3]); 327 + if (argc == 1) { 328 + return GetKeyNames(interp, objv[n], NULL, mode); 329 + } else if (argc == 2) { 330 + return GetKeyNames(interp, objv[n], objv[n+1], mode); 378 331 } 379 332 errString = "keyName ?pattern?"; 380 333 break; 381 334 case SetIdx: /* set */ 382 - if (objc == 3) { 335 + if (argc == 1) { 383 336 HKEY key; 384 337 385 338 /* 386 339 * Create the key and then close it immediately. 387 340 */ 388 341 389 - if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) { 342 + mode |= KEY_ALL_ACCESS; 343 + if (OpenKey(interp, objv[n], mode, 1, &key) != TCL_OK) { 390 344 return TCL_ERROR; 391 345 } 392 346 RegCloseKey(key); 393 347 return TCL_OK; 394 - } else if (objc == 5 || objc == 6) { 395 - Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5]; 396 - return SetValue(interp, objv[2], objv[3], objv[4], typeObj); 348 + } else if (argc == 3) { 349 + return SetValue(interp, objv[n], objv[n+1], objv[n+2], NULL, 350 + mode); 351 + } else if (argc == 4) { 352 + return SetValue(interp, objv[n], objv[n+1], objv[n+2], objv[n+3], 353 + mode); 397 354 } 398 355 errString = "keyName ?valueName data ?type??"; 399 356 break; 400 357 case TypeIdx: /* type */ 401 - if (objc == 4) { 402 - return GetType(interp, objv[2], objv[3]); 358 + if (argc == 2) { 359 + return GetType(interp, objv[n], objv[n+1], mode); 403 360 } 404 361 errString = "keyName valueName"; 405 362 break; 406 363 case ValuesIdx: /* values */ 407 - if (objc == 3) { 408 - return GetValueNames(interp, objv[2], NULL); 409 - } else if (objc == 4) { 410 - return GetValueNames(interp, objv[2], objv[3]); 364 + if (argc == 1) { 365 + return GetValueNames(interp, objv[n], NULL, mode); 366 + } else if (argc == 2) { 367 + return GetValueNames(interp, objv[n], objv[n+1], mode); 411 368 } 412 369 errString = "keyName ?pattern?"; 413 370 break; 414 371 } 415 - Tcl_WrongNumArgs(interp, 2, objv, errString); 372 + Tcl_WrongNumArgs(interp, (mode ? 3 : 2), objv, errString); 416 373 return TCL_ERROR; 417 374 } 418 375 419 376 /* 420 377 *---------------------------------------------------------------------- 421 378 * 422 379 * DeleteKey -- ................................................................................ 431 388 * 432 389 *---------------------------------------------------------------------- 433 390 */ 434 391 435 392 static int 436 393 DeleteKey( 437 394 Tcl_Interp *interp, /* Current interpreter. */ 438 - Tcl_Obj *keyNameObj) /* Name of key to delete. */ 395 + Tcl_Obj *keyNameObj, /* Name of key to delete. */ 396 + REGSAM mode) /* Mode flags to pass. */ 439 397 { 440 398 char *tail, *buffer, *hostName, *keyName; 441 - CONST char *nativeTail; 399 + const TCHAR *nativeTail; 442 400 HKEY rootKey, subkey; 443 401 DWORD result; 444 - int length; 445 402 Tcl_DString buf; 403 + REGSAM saveMode = mode; 446 404 447 405 /* 448 406 * Find the parent of the key being deleted and open it. 449 407 */ 450 408 451 - keyName = Tcl_GetStringFromObj(keyNameObj, &length); 452 - buffer = ckalloc((unsigned int) length + 1); 409 + keyName = Tcl_GetString(keyNameObj); 410 + buffer = Tcl_Alloc(keyNameObj->length + 1); 453 411 strcpy(buffer, keyName); 454 412 455 413 if (ParseKeyName(interp, buffer, &hostName, &rootKey, 456 414 &keyName) != TCL_OK) { 457 - ckfree(buffer); 415 + Tcl_Free(buffer); 458 416 return TCL_ERROR; 459 417 } 460 418 461 419 if (*keyName == '\0') { 462 - Tcl_SetObjResult(interp, Tcl_NewStringObj( 463 - "bad key: cannot delete root keys", -1)); 464 - ckfree(buffer); 420 + Tcl_SetObjResult(interp, 421 + Tcl_NewStringObj("bad key: cannot delete root keys", -1)); 422 + Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL); 423 + Tcl_Free(buffer); 465 424 return TCL_ERROR; 466 425 } 467 426 468 427 tail = strrchr(keyName, '\\'); 469 428 if (tail) { 470 429 *tail++ = '\0'; 471 430 } else { 472 431 tail = keyName; 473 432 keyName = NULL; 474 433 } 475 434 476 - result = OpenSubKey(hostName, rootKey, keyName, 477 - KEY_ENUMERATE_SUB_KEYS | DELETE, 0, &subkey); 435 + mode |= KEY_ENUMERATE_SUB_KEYS | DELETE; 436 + result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey); 478 437 if (result != ERROR_SUCCESS) { 479 - ckfree(buffer); 438 + Tcl_Free(buffer); 480 439 if (result == ERROR_FILE_NOT_FOUND) { 481 440 return TCL_OK; 482 441 } 483 - Tcl_SetObjResult(interp, Tcl_NewStringObj( 484 - "unable to delete key: ", -1)); 442 + Tcl_SetObjResult(interp, 443 + Tcl_NewStringObj("unable to delete key: ", -1)); 485 444 AppendSystemError(interp, result); 486 445 return TCL_ERROR; 487 446 } 488 447 489 448 /* 490 449 * Now we recursively delete the key and everything below it. 491 450 */ 492 451 493 452 nativeTail = Tcl_WinUtfToTChar(tail, -1, &buf); 494 - result = RecursiveDeleteKey(subkey, nativeTail); 453 + result = RecursiveDeleteKey(subkey, nativeTail, saveMode); 495 454 Tcl_DStringFree(&buf); 496 455 497 456 if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) { 498 457 Tcl_SetObjResult(interp, 499 458 Tcl_NewStringObj("unable to delete key: ", -1)); 500 459 AppendSystemError(interp, result); 501 460 result = TCL_ERROR; 502 461 } else { 503 462 result = TCL_OK; 504 463 } 505 464 506 465 RegCloseKey(subkey); 507 - ckfree(buffer); 466 + Tcl_Free(buffer); 508 467 return result; 509 468 } 510 469 511 470 /* 512 471 *---------------------------------------------------------------------- 513 472 * 514 473 * DeleteValue -- ................................................................................ 524 483 *---------------------------------------------------------------------- 525 484 */ 526 485 527 486 static int 528 487 DeleteValue( 529 488 Tcl_Interp *interp, /* Current interpreter. */ 530 489 Tcl_Obj *keyNameObj, /* Name of key. */ 531 - Tcl_Obj *valueNameObj) /* Name of value to delete. */ 490 + Tcl_Obj *valueNameObj, /* Name of value to delete. */ 491 + REGSAM mode) /* Mode flags to pass. */ 532 492 { 533 493 HKEY key; 534 494 char *valueName; 535 - int length; 495 + size_t length; 536 496 DWORD result; 537 497 Tcl_DString ds; 538 498 539 499 /* 540 500 * Attempt to open the key for deletion. 541 501 */ 542 502 543 - if (OpenKey(interp, keyNameObj, KEY_SET_VALUE, 0, &key) 544 - != TCL_OK) { 503 + mode |= KEY_SET_VALUE; 504 + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { 545 505 return TCL_ERROR; 546 506 } 547 507 548 - valueName = Tcl_GetStringFromObj(valueNameObj, &length); 508 + valueName = Tcl_GetString(valueNameObj); 509 + length = valueNameObj->length; 549 510 Tcl_WinUtfToTChar(valueName, length, &ds); 550 - result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds)); 511 + result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds)); 551 512 Tcl_DStringFree(&ds); 552 513 if (result != ERROR_SUCCESS) { 553 - Tcl_AppendResult(interp, "unable to delete value \"", 554 - Tcl_GetString(valueNameObj), "\" from key \"", 555 - Tcl_GetString(keyNameObj), "\": ", NULL); 514 + Tcl_SetObjResult(interp, Tcl_ObjPrintf( 515 + "unable to delete value \"%s\" from key \"%s\": ", 516 + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); 556 517 AppendSystemError(interp, result); 557 518 result = TCL_ERROR; 558 519 } else { 559 520 result = TCL_OK; 560 521 } 561 522 RegCloseKey(key); 562 523 return result; ................................................................................ 581 542 *---------------------------------------------------------------------- 582 543 */ 583 544 584 545 static int 585 546 GetKeyNames( 586 547 Tcl_Interp *interp, /* Current interpreter. */ 587 548 Tcl_Obj *keyNameObj, /* Key to enumerate. */ 588 - Tcl_Obj *patternObj) /* Optional match pattern. */ 549 + Tcl_Obj *patternObj, /* Optional match pattern. */ 550 + REGSAM mode) /* Mode flags to pass. */ 589 551 { 590 - char *pattern; /* Pattern being matched against subkeys */ 552 + const char *pattern; /* Pattern being matched against subkeys */ 591 553 HKEY key; /* Handle to the key being examined */ 592 - TCHAR buffer[MAX_KEY_LENGTH*2]; /* Buffer to hold the subkey name */ 554 + TCHAR buffer[MAX_KEY_LENGTH]; 555 + /* Buffer to hold the subkey name */ 593 556 DWORD bufSize; /* Size of the buffer */ 594 557 DWORD index; /* Position of the current subkey */ 595 558 char *name; /* Subkey name */ 596 559 Tcl_Obj *resultPtr; /* List of subkeys being accumulated */ 597 560 int result = TCL_OK; /* Return value from this command */ 598 561 Tcl_DString ds; /* Buffer to translate subkey name to UTF-8 */ 599 562 600 563 if (patternObj) { 601 564 pattern = Tcl_GetString(patternObj); 602 565 } else { 603 566 pattern = NULL; 604 567 } 605 568 606 - /* Attempt to open the key for enumeration. */ 569 + /* 570 + * Attempt to open the key for enumeration. 571 + */ 607 572 608 - if (OpenKey(interp, keyNameObj, 609 - KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS, 610 - 0, &key) != TCL_OK) { 573 + mode |= KEY_QUERY_VALUE | KEY_ENUMERATE_SUB_KEYS; 574 + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { 611 575 return TCL_ERROR; 612 576 } 613 577 614 - /* Enumerate the subkeys */ 578 + /* 579 + * Enumerate the subkeys. 580 + */ 615 581 616 582 resultPtr = Tcl_NewObj(); 617 583 for (index = 0;; ++index) { 618 584 bufSize = MAX_KEY_LENGTH; 619 - result = (*regWinProcs->regEnumKeyExProc) 620 - (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL); 585 + result = RegEnumKeyEx(key, index, buffer, &bufSize, 586 + NULL, NULL, NULL, NULL); 621 587 if (result != ERROR_SUCCESS) { 622 588 if (result == ERROR_NO_MORE_ITEMS) { 623 589 result = TCL_OK; 624 590 } else { 625 - Tcl_SetObjResult(interp, Tcl_NewObj()); 626 - Tcl_AppendResult(interp, 627 - "unable to enumerate subkeys of \"", 628 - Tcl_GetString(keyNameObj), "\": ", NULL); 591 + Tcl_SetObjResult(interp, Tcl_ObjPrintf( 592 + "unable to enumerate subkeys of \"%s\": ", 593 + Tcl_GetString(keyNameObj))); 629 594 AppendSystemError(interp, result); 630 595 result = TCL_ERROR; 631 596 } 632 597 break; 633 598 } 634 - if (regWinProcs->useWide) { 635 - Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize * sizeof(WCHAR), &ds); 636 - } else { 637 - Tcl_WinTCharToUtf((TCHAR *) buffer, bufSize, &ds); 638 - } 639 - name = Tcl_DStringValue(&ds); 599 + name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds); 640 600 if (pattern && !Tcl_StringMatch(name, pattern)) { 641 601 Tcl_DStringFree(&ds); 642 602 continue; 643 603 } 644 604 result = Tcl_ListObjAppendElement(interp, resultPtr, 645 605 Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); 646 606 Tcl_DStringFree(&ds); ................................................................................ 675 635 *---------------------------------------------------------------------- 676 636 */ 677 637 678 638 static int 679 639 GetType( 680 640 Tcl_Interp *interp, /* Current interpreter. */ 681 641 Tcl_Obj *keyNameObj, /* Name of key. */ 682 - Tcl_Obj *valueNameObj) /* Name of value to get. */ 642 + Tcl_Obj *valueNameObj, /* Name of value to get. */ 643 + REGSAM mode) /* Mode flags to pass. */ 683 644 { 684 645 HKEY key; 685 - DWORD result; 686 - DWORD type; 646 + DWORD result, type; 687 647 Tcl_DString ds; 688 - char *valueName; 689 - CONST char *nativeValue; 690 - int length; 648 + const char *valueName; 649 + const TCHAR *nativeValue; 650 + size_t length; 691 651 692 652 /* 693 653 * Attempt to open the key for reading. 694 654 */ 695 655 696 - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) 697 - != TCL_OK) { 656 + mode |= KEY_QUERY_VALUE; 657 + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { 698 658 return TCL_ERROR; 699 659 } 700 660 701 661 /* 702 662 * Get the type of the value. 703 663 */ 704 664 705 - valueName = Tcl_GetStringFromObj(valueNameObj, &length); 665 + valueName = Tcl_GetString(valueNameObj); 666 + length = valueNameObj->length; 706 667 nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds); 707 - result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, 668 + result = RegQueryValueEx(key, nativeValue, NULL, &type, 708 669 NULL, NULL); 709 670 Tcl_DStringFree(&ds); 710 671 RegCloseKey(key); 711 672 712 673 if (result != ERROR_SUCCESS) { 713 - Tcl_AppendResult(interp, "unable to get type of value \"", 714 - Tcl_GetString(valueNameObj), "\" from key \"", 715 - Tcl_GetString(keyNameObj), "\": ", NULL); 674 + Tcl_SetObjResult(interp, Tcl_ObjPrintf( 675 + "unable to get type of value \"%s\" from key \"%s\": ", 676 + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); 716 677 AppendSystemError(interp, result); 717 678 return TCL_ERROR; 718 679 } 719 680 720 681 /* 721 682 * Set the type into the result. Watch out for unknown types. If we don't 722 683 * know about the type, just use the numeric value. ................................................................................ 747 708 *---------------------------------------------------------------------- 748 709 */ 749 710 750 711 static int 751 712 GetValue( 752 713 Tcl_Interp *interp, /* Current interpreter. */ 753 714 Tcl_Obj *keyNameObj, /* Name of key. */ 754 - Tcl_Obj *valueNameObj) /* Name of value to get. */ 715 + Tcl_Obj *valueNameObj, /* Name of value to get. */ 716 + REGSAM mode) /* Mode flags to pass. */ 755 717 { 756 718 HKEY key; 757 - char *valueName; 758 - CONST char *nativeValue; 719 + const char *valueName; 720 + const TCHAR *nativeValue; 759 721 DWORD result, length, type; 760 722 Tcl_DString data, buf; 761 - int nameLen; 723 + size_t nameLen; 762 724 763 725 /* 764 726 * Attempt to open the key for reading. 765 727 */ 766 728 767 - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) { 729 + mode |= KEY_QUERY_VALUE; 730 + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { 768 731 return TCL_ERROR; 769 732 } 770 733 771 734 /* 772 735 * Initialize a Dstring to maximum statically allocated size we could get 773 736 * one more byte by avoiding Tcl_DStringSetLength() and just setting 774 737 * length to TCL_DSTRING_STATIC_SIZE, but this should be safer if the ................................................................................ 776 739 * 777 740 * This allows short values to be read from the registy in one call. 778 741 * Longer values need a second call with an expanded DString. 779 742 */ 780 743 781 744 Tcl_DStringInit(&data); 782 745 Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1); 783 - length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1; 746 + length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1; 784 747 785 - valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen); 748 + valueName = Tcl_GetString(valueNameObj); 749 + nameLen = valueNameObj->length; 786 750 nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf); 787 751 788 - result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type, 752 + result = RegQueryValueEx(key, nativeValue, NULL, &type, 789 753 (BYTE *) Tcl_DStringValue(&data), &length); 790 754 while (result == ERROR_MORE_DATA) { 791 755 /* 792 756 * The Windows docs say that in this error case, we just need to 793 757 * expand our buffer and request more data. Required for 794 758 * HKEY_PERFORMANCE_DATA 795 759 */ 796 760 797 - length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2); 798 - Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1)); 799 - result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue, 761 + length = Tcl_DStringLength(&data) * (2 / sizeof(TCHAR)); 762 + Tcl_DStringSetLength(&data, (int) length * sizeof(TCHAR)); 763 + result = RegQueryValueEx(key, nativeValue, 800 764 NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length); 801 765 } 802 766 Tcl_DStringFree(&buf); 803 767 RegCloseKey(key); 804 768 if (result != ERROR_SUCCESS) { 805 - Tcl_AppendResult(interp, "unable to get value \"", 806 - Tcl_GetString(valueNameObj), "\" from key \"", 807 - Tcl_GetString(keyNameObj), "\": ", NULL); 769 + Tcl_SetObjResult(interp, Tcl_ObjPrintf( 770 + "unable to get value \"%s\" from key \"%s\": ", 771 + Tcl_GetString(valueNameObj), Tcl_GetString(keyNameObj))); 808 772 AppendSystemError(interp, result); 809 773 Tcl_DStringFree(&data); 810 774 return TCL_ERROR; 811 775 } 812 776 813 777 /* 814 778 * If the data is a 32-bit quantity, store it as an integer object. If it ................................................................................ 815 779 * is a multi-string, store it as a list of strings. For null-terminated 816 780 * strings, append up the to first null. Otherwise, store it as a binary 817 781 * string. 818 782 */ 819 783 820 784 if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { 821 785 Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type, 822 - *((DWORD*) Tcl_DStringValue(&data))))); 786 + *((DWORD *) Tcl_DStringValue(&data))))); 823 787 } else if (type == REG_MULTI_SZ) { 824 788 char *p = Tcl_DStringValue(&data); 825 789 char *end = Tcl_DStringValue(&data) + length; 826 790 Tcl_Obj *resultPtr = Tcl_NewObj(); 827 791 828 792 /* 829 793 * Multistrings are stored as an array of null-terminated strings, 830 794 * terminated by two null characters. Also do a bounds check in case 831 795 * we get bogus data. 832 796 */ 833 797 834 - while (p < end && ((regWinProcs->useWide) 835 - ? *((Tcl_UniChar *)p) : *p) != 0) { 798 + while ((p < end) && *((WCHAR *) p) != 0) { 799 + WCHAR *wp; 800 + 836 801 Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf); 837 802 Tcl_ListObjAppendElement(interp, resultPtr, 838 803 Tcl_NewStringObj(Tcl_DStringValue(&buf), 839 804 Tcl_DStringLength(&buf))); 840 - if (regWinProcs->useWide) { 841 - Tcl_UniChar* up = (Tcl_UniChar*) p; 842 - while (*up++ != 0) {} 843 - p = (char*) up; 844 - } else { 845 - while (*p++ != '\0') {} 846 - } 805 + wp = (WCHAR *) p; 806 + 807 + while (*wp++ != 0) {/* empty body */} 808 + p = (char *) wp; 847 809 Tcl_DStringFree(&buf); 848 810 } 849 811 Tcl_SetObjResult(interp, resultPtr); 850 812 } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) { 851 813 Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf); 852 814 Tcl_DStringResult(interp, &buf); 853 815 } else { ................................................................................ 881 843 *---------------------------------------------------------------------- 882 844 */ 883 845 884 846 static int 885 847 GetValueNames( 886 848 Tcl_Interp *interp, /* Current interpreter. */ 887 849 Tcl_Obj *keyNameObj, /* Key to enumerate. */ 888 - Tcl_Obj *patternObj) /* Optional match pattern. */ 850 + Tcl_Obj *patternObj, /* Optional match pattern. */ 851 + REGSAM mode) /* Mode flags to pass. */ 889 852 { 890 853 HKEY key; 891 854 Tcl_Obj *resultPtr; 892 855 DWORD index, size, result; 893 856 Tcl_DString buffer, ds; 894 - char *pattern, *name; 857 + const char *pattern, *name; 895 858 896 859 /* 897 860 * Attempt to open the key for enumeration. 898 861 */ 899 862 900 - if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) 901 - != TCL_OK) { 863 + mode |= KEY_QUERY_VALUE; 864 + if (OpenKey(interp, keyNameObj, mode, 0, &key) != TCL_OK) { 902 865 return TCL_ERROR; 903 866 } 904 867 905 868 resultPtr = Tcl_NewObj(); 906 869 Tcl_DStringInit(&buffer); 907 - Tcl_DStringSetLength(&buffer, 908 - (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH*2 : MAX_KEY_LENGTH)); 870 + Tcl_DStringSetLength(&buffer, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); 909 871 index = 0; 910 872 result = TCL_OK; 911 873 912 874 if (patternObj) { 913 875 pattern = Tcl_GetString(patternObj); 914 876 } else { 915 877 pattern = NULL; ................................................................................ 918 880 /* 919 881 * Enumerate the values under the given subkey until we get an error, 920 882 * indicating the end of the list. Note that we need to reset size after 921 883 * each iteration because RegEnumValue smashes the old value. 922 884 */ 923 885 924 886 size = MAX_KEY_LENGTH; 925 - while ((*regWinProcs->regEnumValueProc)(key, index, 926 - Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL) 927 - == ERROR_SUCCESS) { 928 - 929 - if (regWinProcs->useWide) { 930 - size *= 2; 931 - } 887 + while (RegEnumValue(key,index, (TCHAR *)Tcl_DStringValue(&buffer), 888 + &size, NULL, NULL, NULL, NULL) == ERROR_SUCCESS) { 889 + size *= sizeof(TCHAR); 932 890 933 891 Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, 934 892 &ds); 935 893 name = Tcl_DStringValue(&ds); 936 894 if (!pattern || Tcl_StringMatch(name, pattern)) { 937 895 result = Tcl_ListObjAppendElement(interp, resultPtr, 938 896 Tcl_NewStringObj(name, Tcl_DStringLength(&ds))); ................................................................................ 974 932 Tcl_Interp *interp, /* Current interpreter. */ 975 933 Tcl_Obj *keyNameObj, /* Key to open. */ 976 934 REGSAM mode, /* Access mode. */ 977 935 int flags, /* 0 or REG_CREATE. */ 978 936 HKEY *keyPtr) /* Returned HKEY. */ 979 937 { 980 938 char *keyName, *buffer, *hostName; 981 - int length; 939 + size_t length; 982 940 HKEY rootKey; 983 941 DWORD result; 984 942 985 - keyName = Tcl_GetStringFromObj(keyNameObj, &length); 986 - buffer = ckalloc((unsigned int) length + 1); 943 + keyName = Tcl_GetString(keyNameObj); 944 + length = keyNameObj->length; 945 + buffer = Tcl_Alloc(length + 1); 987 946 strcpy(buffer, keyName); 988 947 989 948 result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName); 990 949 if (result == TCL_OK) { 991 950 result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr); 992 951 if (result != ERROR_SUCCESS) { 993 952 Tcl_SetObjResult(interp, ................................................................................ 995 954 AppendSystemError(interp, result); 996 955 result = TCL_ERROR; 997 956 } else { 998 957 result = TCL_OK; 999 958 } 1000 959 } 1001 960 1002 - ckfree(buffer); 961 + Tcl_Free(buffer); 1003 962 return result; 1004 963 } 1005 964 1006 965 /* 1007 966 *---------------------------------------------------------------------- 1008 967 * 1009 968 * OpenSubKey -- ................................................................................ 1035 994 1036 995 /* 1037 996 * Attempt to open the root key on a remote host if necessary. 1038 997 */ 1039 998 1040 999 if (hostName) { 1041 1000 hostName = (char *) Tcl_WinUtfToTChar(hostName, -1, &buf); 1042 - result = (*regWinProcs->regConnectRegistryProc)(hostName, rootKey, 1001 + result = RegConnectRegistry((TCHAR *)hostName, rootKey, 1043 1002 &rootKey); 1044 1003 Tcl_DStringFree(&buf); 1045 1004 if (result != ERROR_SUCCESS) { 1046 1005 return result; 1047 1006 } 1048 1007 } 1049 1008 1050 1009 /* 1051 1010 * Now open the specified key with the requested permissions. Note that 1052 1011 * this key must be closed by the caller. 1053 1012 */ 1054 1013 1055 - keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); 1014 + if (keyName) { 1015 + keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf); 1016 + } 1056 1017 if (flags & REG_CREATE) { 1057 1018 DWORD create; 1058 - result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL, 1019 + 1020 + result = RegCreateKeyEx(rootKey, (TCHAR *)keyName, 0, NULL, 1059 1021 REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create); 1060 1022 } else if (rootKey == HKEY_PERFORMANCE_DATA) { 1061 1023 /* 1062 1024 * Here we fudge it for this special root key. See MSDN for more info 1063 1025 * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it. 1064 1026 */ 1027 + 1065 1028 *keyPtr = HKEY_PERFORMANCE_DATA; 1066 1029 result = ERROR_SUCCESS; 1067 1030 } else { 1068 - result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode, 1031 + result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode, 1069 1032 keyPtr); 1070 1033 } 1071 - Tcl_DStringFree(&buf); 1034 + if (keyName) { 1035 + Tcl_DStringFree(&buf); 1036 + } 1072 1037 1073 1038 /* 1074 1039 * Be sure to close the root key since we are done with it now. 1075 1040 */ 1076 1041 1077 1042 if (hostName) { 1078 1043 RegCloseKey(rootKey); ................................................................................ 1125 1090 } 1126 1091 } 1127 1092 } 1128 1093 } else { 1129 1094 rootName = name; 1130 1095 } 1131 1096 if (!rootName) { 1132 - Tcl_AppendResult(interp, "bad key \"", name, 1133 - "\": must start with a valid root", NULL); 1097 + Tcl_SetObjResult(interp, Tcl_ObjPrintf( 1098 + "bad key \"%s\": must start with a valid root", name)); 1099 + Tcl_SetErrorCode(interp, "WIN_REG", "NO_ROOT_KEY", NULL); 1134 1100 return TCL_ERROR; 1135 1101 } 1136 1102 1137 1103 /* 1138 1104 * Split the root into root and subkey portions. 1139 1105 */ 1140 1106 ................................................................................ 1178 1144 * 1179 1145 *---------------------------------------------------------------------- 1180 1146 */ 1181 1147 1182 1148 static DWORD 1183 1149 RecursiveDeleteKey( 1184 1150 HKEY startKey, /* Parent of key to be deleted. */ 1185 - CONST char *keyName) /* Name of key to be deleted in external 1151 + const TCHAR *keyName, /* Name of key to be deleted in external 1186 1152 * encoding, not UTF. */ 1153 + REGSAM mode) /* Mode flags to pass. */ 1187 1154 { 1188 1155 DWORD result, size; 1189 1156 Tcl_DString subkey; 1190 1157 HKEY hKey; 1158 + REGSAM saveMode = mode; 1159 + static int checkExProc = 0; 1160 + static FARPROC regDeleteKeyExProc = NULL; 1191 1161 1192 1162 /* 1193 1163 * Do not allow NULL or empty key name. 1194 1164 */ 1195 1165 1196 1166 if (!keyName || *keyName == '\0') { 1197 1167 return ERROR_BADKEY; 1198 1168 } 1199 1169 1200 - result = (*regWinProcs->regOpenKeyExProc)(startKey, keyName, 0, 1201 - KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE, &hKey); 1170 + mode |= KEY_ENUMERATE_SUB_KEYS | DELETE | KEY_QUERY_VALUE; 1171 + result = RegOpenKeyEx(startKey, keyName, 0, mode, &hKey); 1202 1172 if (result != ERROR_SUCCESS) { 1203 1173 return result; 1204 1174 } 1205 1175 1206 1176 Tcl_DStringInit(&subkey); 1207 - Tcl_DStringSetLength(&subkey, 1208 - (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH * 2 : MAX_KEY_LENGTH)); 1177 + Tcl_DStringSetLength(&subkey, (int) (MAX_KEY_LENGTH * sizeof(TCHAR))); 1209 1178 1179 + mode = saveMode; 1210 1180 while (result == ERROR_SUCCESS) { 1211 1181 /* 1212 1182 * Always get index 0 because key deletion changes ordering. 1213 1183 */ 1214 1184 1215 1185 size = MAX_KEY_LENGTH; 1216 - result=(*regWinProcs->regEnumKeyExProc)(hKey, 0, 1217 - Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL); 1186 + result = RegEnumKeyEx(hKey, 0, (TCHAR *)Tcl_DStringValue(&subkey), 1187 + &size, NULL, NULL, NULL, NULL); 1218 1188 if (result == ERROR_NO_MORE_ITEMS) { 1219 - result = (*regWinProcs->regDeleteKeyProc)(startKey, keyName); 1189 + /* 1190 + * RegDeleteKeyEx doesn't exist on non-64bit XP platforms, so we 1191 + * can't compile with it in. We need to check for it at runtime 1192 + * and use it if we find it. 1193 + */ 1194 + 1195 + if (mode && !checkExProc) { 1196 + HMODULE handle; 1197 + 1198 + checkExProc = 1; 1199 + handle = GetModuleHandle(TEXT("ADVAPI32")); 1200 + regDeleteKeyExProc = (FARPROC) 1201 + GetProcAddress(handle, "RegDeleteKeyExW"); 1202 + } 1203 + if (mode && regDeleteKeyExProc) { 1204 + result = regDeleteKeyExProc(startKey, keyName, mode, 0); 1205 + } else { 1206 + result = RegDeleteKey(startKey, keyName); 1207 + } 1220 1208 break; 1221 1209 } else if (result == ERROR_SUCCESS) { 1222 - result = RecursiveDeleteKey(hKey, Tcl_DStringValue(&subkey)); 1210 + result = RecursiveDeleteKey(hKey, 1211 + (const TCHAR *) Tcl_DStringValue(&subkey), mode); 1223 1212 } 1224 1213 } 1225 1214 Tcl_DStringFree(&subkey); 1226 1215 RegCloseKey(hKey); 1227 1216 return result; 1228 1217 } 1229 1218 ................................................................................ 1247 1236 1248 1237 static int 1249 1238 SetValue( 1250 1239 Tcl_Interp *interp, /* Current interpreter. */ 1251 1240 Tcl_Obj *keyNameObj, /* Name of key. */ 1252 1241 Tcl_Obj *valueNameObj, /* Name of value to set. */ 1253 1242 Tcl_Obj *dataObj, /* Data to be written. */ 1254 - Tcl_Obj *typeObj) /* Type of data to be written. */ 1243 + Tcl_Obj *typeObj, /* Type of data to be written. */ 1244 + REGSAM mode) /* Mode flags to pass. */ 1255 1245 { 1256 1246 int type; 1247 + size_t length; 1257 1248 DWORD result; 1258 1249 HKEY key; 1259 - int length; 1260 - char *valueName; 1250 + const char *valueName; 1261 1251 Tcl_DString nameBuf; 1262 1252 1263 1253 if (typeObj == NULL) { 1264 1254 type = REG_SZ; 1265 1255 } else if (Tcl_GetIndexFromObj(interp, typeObj, typeNames, "type", 1266 1256 0, (int *) &type) != TCL_OK) { 1267 - if (Tcl_GetIntFromObj(NULL, typeObj, (int*) &type) != TCL_OK) { 1257 + if (Tcl_GetIntFromObj(NULL, typeObj, (int *) &type) != TCL_OK) { 1268 1258 return TCL_ERROR; 1269 1259 } 1270 1260 Tcl_ResetResult(interp); 1271 1261 } 1272 - if (OpenKey(interp, keyNameObj, KEY_ALL_ACCESS, 1, &key) != TCL_OK) { 1262 + mode |= KEY_ALL_ACCESS; 1263 + if (OpenKey(interp, keyNameObj, mode, 1, &key) != TCL_OK) { 1273 1264 return TCL_ERROR; 1274 1265 } 1275 1266 1276 - valueName = Tcl_GetStringFromObj(valueNameObj, &length); 1267 + valueName = Tcl_GetString(valueNameObj); 1268 + length = valueNameObj->length; 1277 1269 valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf); 1278 1270 1279 1271 if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) { 1280 1272 int value; 1281 1273 1282 1274 if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) { 1283 1275 RegCloseKey(key); 1284 1276 Tcl_DStringFree(&nameBuf); 1285 1277 return TCL_ERROR; 1286 1278 } 1287 1279 1288 - value = ConvertDWORD((DWORD)type, (DWORD)value); 1289 - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, 1280 + value = ConvertDWORD((DWORD) type, (DWORD) value); 1281 + result = RegSetValueEx(key, (TCHAR *) valueName, 0, 1290 1282 (DWORD) type, (BYTE *) &value, sizeof(DWORD)); 1291 1283 } else if (type == REG_MULTI_SZ) { 1292 1284 Tcl_DString data, buf; 1293 1285 int objc, i; 1294 1286 Tcl_Obj **objv; 1295 1287 1296 1288 if (Tcl_ListObjGetElements(interp, dataObj, &objc, &objv) != TCL_OK) { ................................................................................ 1303 1295 * Append the elements as null terminated strings. Note that we must 1304 1296 * not assume the length of the string in case there are embedded 1305 1297 * nulls, which aren't allowed in REG_MULTI_SZ values. 1306 1298 */ 1307 1299 1308 1300 Tcl_DStringInit(&data); 1309 1301 for (i = 0; i < objc; i++) { 1310 - Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1); 1302 + const char *bytes = Tcl_GetString(objv[i]); 1303 + 1304 + length = objv[i]->length; 1305 + Tcl_DStringAppend(&data, bytes, length); 1311 1306 1312 1307 /* 1313 - * Add a null character to separate this value from the next. We 1314 - * accomplish this by growing the string by one byte. Since the 1315 - * DString always tacks on an extra null byte, the new byte will 1316 - * already be set to null. 1308 + * Add a null character to separate this value from the next. 1317 1309 */ 1318 1310 1319 - Tcl_DStringSetLength(&data, Tcl_DStringLength(&data)+1); 1311 + Tcl_DStringAppend(&data, "", 1); /* NUL-terminated string */ 1320 1312 } 1321 1313 1322 1314 Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1, 1323 1315 &buf); 1324 - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, 1325 - (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), 1316 + result = RegSetValueEx(key, (TCHAR *) valueName, 0, 1317 + (DWORD) type, (BYTE *) Tcl_DStringValue(&buf), 1326 1318 (DWORD) Tcl_DStringLength(&buf)); 1327 1319 Tcl_DStringFree(&data); 1328 1320 Tcl_DStringFree(&buf); 1329 1321 } else if (type == REG_SZ || type == REG_EXPAND_SZ) { 1330 1322 Tcl_DString buf; 1331 - CONST char *data = Tcl_GetStringFromObj(dataObj, &length); 1323 + const char *data = Tcl_GetString(dataObj); 1332 1324 1333 - data = Tcl_WinUtfToTChar(data, length, &buf); 1325 + length = dataObj->length; 1326 + data = (char *) Tcl_WinUtfToTChar(data, length, &buf); 1334 1327 1335 1328 /* 1336 - * Include the null in the length, padding if needed for Unicode. 1329 + * Include the null in the length, padding if needed for WCHAR. 1337 1330 */ 1338 1331 1339 - if (regWinProcs->useWide) { 1340 - Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); 1341 - } 1332 + Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1); 1342 1333 length = Tcl_DStringLength(&buf) + 1; 1343 1334 1344 - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, 1345 - (DWORD) type, (BYTE *) data, (DWORD) length); 1335 + result = RegSetValueEx(key, (TCHAR *) valueName, 0, 1336 + (DWORD) type, (BYTE *) data, (DWORD) length); 1346 1337 Tcl_DStringFree(&buf); 1347 1338 } else { 1348 1339 BYTE *data; 1340 + int bytelength; 1349 1341 1350 1342 /* 1351 1343 * Store binary data in the registry. 1352 1344 */ 1353 1345 1354 - data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length); 1355 - result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, 1356 - (DWORD) type, data, (DWORD) length); 1346 + data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength); 1347 + result = RegSetValueEx(key, (TCHAR *) valueName, 0, 1348 + (DWORD) type, data, (DWORD) bytelength); 1357 1349 } 1358 1350 1359 1351 Tcl_DStringFree(&nameBuf); 1360 1352 RegCloseKey(key); 1361 1353 1362 1354 if (result != ERROR_SUCCESS) { 1363 1355 Tcl_SetObjResult(interp, ................................................................................ 1385 1377 *---------------------------------------------------------------------- 1386 1378 */ 1387 1379 1388 1380 static int 1389 1381 BroadcastValue( 1390 1382 Tcl_Interp *interp, /* Current interpreter. */ 1391 1383 int objc, /* Number of arguments. */ 1392 - Tcl_Obj *CONST objv[]) /* Argument values. */ 1384 + Tcl_Obj *const objv[]) /* Argument values. */ 1393 1385 { 1394 1386 LRESULT result; 1395 1387 DWORD_PTR sendResult; 1396 - UINT timeout = 3000; 1397 - int len; 1398 - CONST char *str; 1388 + int timeout = 3000; 1389 + size_t len; 1390 + const char *str; 1399 1391 Tcl_Obj *objPtr; 1392 + WCHAR *wstr; 1393 + Tcl_DString ds; 1400 1394 1401 - if ((objc != 3) && (objc != 5)) { 1402 - Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); 1403 - return TCL_ERROR; 1404 - } 1405 - 1406 - if (objc > 3) { 1407 - str = Tcl_GetStringFromObj(objv[3], &len); 1408 - if ((len < 2) || (*str != '-') 1409 - || strncmp(str, "-timeout", (size_t) len)) { 1410 - Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?"); 1411 - return TCL_ERROR; 1395 + if (objc == 3) { 1396 + str = Tcl_GetString(objv[1]); 1397 + len = objv[1]->length; 1398 + if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) { 1399 + return TCL_BREAK; 1412 1400 } 1413 - if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) { 1401 + if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) { 1414 1402 return TCL_ERROR; 1415 1403 } 1416 1404 } 1417 1405 1418 - str = Tcl_GetStringFromObj(objv[2], &len); 1419 - if (len == 0) { 1420 - str = NULL; 1406 + str = Tcl_GetString(objv[0]); 1407 + len = objv[0]->length; 1408 + wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds); 1409 + if (Tcl_DStringLength(&ds) == 0) { 1410 + wstr = NULL; 1421 1411 } 1422 1412 1423 1413 /* 1424 1414 * Use the ignore the result. 1425 1415 */ 1426 1416 1427 1417 result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 1428 - (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult); 1418 + (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult); 1419 + Tcl_DStringFree(&ds); 1429 1420 1430 1421 objPtr = Tcl_NewObj(); 1431 - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result)); 1432 - Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult)); 1422 + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result)); 1423 + Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult)); 1433 1424 Tcl_SetObjResult(interp, objPtr); 1434 1425 1435 1426 return TCL_OK; 1436 1427 } 1437 1428 1438 1429 /* 1439 1430 *---------------------------------------------------------------------- ................................................................................ 1454 1445 1455 1446 static void 1456 1447 AppendSystemError( 1457 1448 Tcl_Interp *interp, /* Current interpreter. */ 1458 1449 DWORD error) /* Result code from error. */ 1459 1450 { 1460 1451 int length; 1461 - WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr; 1462 - char *msg; 1452 + TCHAR *tMsgPtr, **tMsgPtrPtr = &tMsgPtr; 1453 + const char *msg; 1463 1454 char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE]; 1464 1455 Tcl_DString ds; 1465 1456 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp); 1466 1457 1467 1458 if (Tcl_IsShared(resultPtr)) { 1468 1459 resultPtr = Tcl_DuplicateObj(resultPtr); 1469 1460 } 1470 - length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM 1461 + length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM 1471 1462 | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, 1472 - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr, 1463 + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (TCHAR *) tMsgPtrPtr, 1473 1464 0, NULL); 1474 1465 if (length == 0) { 1466 + sprintf(msgBuf, "unknown error: %ld", error); 1467 + msg = msgBuf; 1468 + } else { 1475 1469 char *msgPtr; 1476 1470 1477 - length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM 1478 - | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error, 1479 - MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (char *) &msgPtr, 1480 - 0, NULL); 1481 - if (length > 0) { 1482 - wMsgPtr = (WCHAR *) LocalAlloc(LPTR, (length + 1) * sizeof(WCHAR)); 1483 - MultiByteToWideChar(CP_ACP, 0, msgPtr, length + 1, wMsgPtr, 1484 - length + 1); 1485 - LocalFree(msgPtr); 1486 - } 1487 - } 1488 - if (length == 0) { 1489 - if (error == ERROR_CALL_NOT_IMPLEMENTED) { 1490 - msg = "function not supported under Win32s"; 1491 - } else { 1492 - sprintf(msgBuf, "unknown error: %ld", error); 1493 - msg = msgBuf; 1494 - } 1495 - } else { 1496 - Tcl_Encoding encoding; 1471 + Tcl_WinTCharToUtf(tMsgPtr, -1, &ds); 1472 + LocalFree(tMsgPtr); 1497 1473 1498 - encoding = Tcl_GetEncoding(NULL, "unicode"); 1499 - Tcl_ExternalToUtfDString(encoding, (char *) wMsgPtr, -1, &ds); 1500 - Tcl_FreeEncoding(encoding); 1501 - LocalFree(wMsgPtr); 1502 - 1503 - msg = Tcl_DStringValue(&ds); 1474 + msgPtr = Tcl_DStringValue(&ds); 1504 1475 length = Tcl_DStringLength(&ds); 1505 1476 1506 1477 /* 1507 1478 * Trim the trailing CR/LF from the system message. 1508 1479 */ 1509 1480 1510 - if (msg[length-1] == '\n') { 1511 - msg[--length] = 0; 1481 + if (msgPtr[length-1] == '\n') { 1482 + --length; 1512 1483 } 1513 - if (msg[length-1] == '\r') { 1514 - msg[--length] = 0; 1484 + if (msgPtr[length-1] == '\r') { 1485 + --length; 1515 1486 } 1487 + msgPtr[length] = 0; 1488 + msg = msgPtr; 1516 1489 } 1517 1490 1518 1491 sprintf(id, "%ld", error); 1519 1492 Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL); 1520 1493 Tcl_AppendToObj(resultPtr, msg, length); 1521 1494 Tcl_SetObjResult(interp, resultPtr); 1522 1495 ................................................................................ 1543 1516 */ 1544 1517 1545 1518 static DWORD 1546 1519 ConvertDWORD( 1547 1520 DWORD type, /* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */ 1548 1521 DWORD value) /* The value to be converted. */ 1549 1522 { 1550 - DWORD order = 1; 1523 + const DWORD order = 1; 1551 1524 DWORD localType; 1552 1525 1553 1526 /* 1554 1527 * Check to see if the low bit is in the first byte. 1555 1528 */ 1556 1529 1557 - localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN; 1530 + localType = (*((const char *) &order) == 1) 1531 + ? REG_DWORD : REG_DWORD_BIG_ENDIAN; 1558 1532 return (type != localType) ? (DWORD) SWAPLONG(value) : value; 1559 1533 } 1560 1534 1561 1535 /* 1562 1536 * Local Variables: 1563 1537 * mode: c 1564 1538 * c-basic-offset: 4 1565 1539 * fill-column: 78 1566 1540 * End: 1567 1541 */