1# 2# Copyright (c) 2010, Ashok P. Nadkarni 3# All rights reserved. 4# 5# See the file LICENSE for license 6 7# Remote Desktop Services - TBD - document and test 8 9namespace eval twapi {} 10 11proc twapi::rds_enumerate_sessions {args} { 12 array set opts [parseargs args { 13 {hserver.arg 0} 14 state.arg 15 } -maxleftover 0] 16 17 set states {active connected connectquery shadow disconnected idle listen reset down init} 18 if {[info exists opts(state)]} { 19 if {[string is integer -strict $opts(state)]} { 20 set state $opts(state) 21 } else { 22 set state [lsearch -exact $states $opts(state)] 23 if {$state < 0} { 24 error "Invalid value '$opts(state)' specified for -state option." 25 } 26 } 27 } 28 29 set sessions [WTSEnumerateSessions $opts(hserver)] 30 31 if {[info exists state]} { 32 set sessions [recordarray get $sessions -filter [list [list State == $state]]] 33 } 34 35 set result {} 36 foreach {sess rec} [recordarray getdict $sessions -key SessionId -format dict] { 37 set state [lindex $states [kl_get $rec State]] 38 if {$state eq ""} { 39 set state [kl_get $rec State] 40 } 41 lappend result $sess [list -tssession [kl_get $rec SessionId] \ 42 -winstaname [kl_get $rec pWinStationName] \ 43 -state $state] 44 } 45 return $result 46} 47 48proc twapi::rds_disconnect_session args { 49 array set opts [parseargs args { 50 {hserver.arg 0} 51 {tssession.int -1} 52 {async.bool false} 53 } -maxleftover 0] 54 55 WTSDisconnectSession $opts(hserver) $opts(tssession) [expr {! $opts(async)}] 56 57} 58 59proc twapi::rds_logoff_session args { 60 array set opts [parseargs args { 61 {hserver.arg 0} 62 {tssession.int -1} 63 {async.bool false} 64 } -maxleftover 0] 65 66 WTSLogoffSession $opts(hserver) $opts(tssession) [expr {! $opts(async)}] 67} 68 69proc twapi::rds_query_session_information {infoclass args} { 70 array set opts [parseargs args { 71 {hserver.arg 0} 72 {tssession.int -1} 73 } -maxleftover 0] 74 75 return [WTSQuerySessionInformation $opts(hserver) $opts(tssession) $infoclass] 76} 77 78interp alias {} twapi::rds_get_session_appname {} twapi::rds_query_session_information 1 79interp alias {} twapi::rds_get_session_clientdir {} twapi::rds_query_session_information 11 80interp alias {} twapi::rds_get_session_clientname {} twapi::rds_query_session_information 10 81interp alias {} twapi::rds_get_session_userdomain {} twapi::rds_query_session_information 7 82interp alias {} twapi::rds_get_session_initialprogram {} twapi::rds_query_session_information 0 83interp alias {} twapi::rds_get_session_oemid {} twapi::rds_query_session_information 3 84interp alias {} twapi::rds_get_session_user {} twapi::rds_query_session_information 5 85interp alias {} twapi::rds_get_session_winsta {} twapi::rds_query_session_information 6 86interp alias {} twapi::rds_get_session_intialdir {} twapi::rds_query_session_information 2 87interp alias {} twapi::rds_get_session_clientbuild {} twapi::rds_query_session_information 9 88interp alias {} twapi::rds_get_session_clienthwid {} twapi::rds_query_session_information 13 89interp alias {} twapi::rds_get_session_state {} twapi::rds_query_session_information 8 90interp alias {} twapi::rds_get_session_id {} twapi::rds_query_session_information 4 91interp alias {} twapi::rds_get_session_productid {} twapi::rds_query_session_information 12 92interp alias {} twapi::rds_get_session_protocol {} twapi::rds_query_session_information 16 93 94 95proc twapi::rds_send_message {args} { 96 97 array set opts [parseargs args { 98 {hserver.arg 0} 99 tssession.int 100 title.arg 101 message.arg 102 {buttons.arg ok} 103 {icon.arg information} 104 defaultbutton.arg 105 {modality.arg task {task appl application system}} 106 {justify.arg left {left right}} 107 rtl.bool 108 foreground.bool 109 topmost.bool 110 showhelp.bool 111 service.bool 112 timeout.int 113 async.bool 114 } -maxleftover 0 -nulldefault] 115 116 if {![kl_vget { 117 ok {0 {ok}} 118 okcancel {1 {ok cancel}} 119 abortretryignore {2 {abort retry ignore}} 120 yesnocancel {3 {yes no cancel}} 121 yesno {4 {yes no}} 122 retrycancel {5 {retry cancel}} 123 canceltrycontinue {6 {cancel try continue}} 124 } $opts(buttons) buttons]} { 125 error "Invalid value '$opts(buttons)' specified for option -buttons." 126 } 127 128 set style [lindex $buttons 0] 129 switch -exact -- $opts(icon) { 130 warning - 131 exclamation {setbits style 0x30} 132 asterisk - 133 information {setbits style 0x40} 134 question {setbits style 0x20} 135 error - 136 hand - 137 stop {setbits style 0x10} 138 default { 139 error "Invalid value '$opts(icon)' specified for option -icon." 140 } 141 } 142 143 # Map the default button 144 switch -exact -- [lsearch -exact [lindex $buttons 1] $opts(defaultbutton)] { 145 1 {setbits style 0x100 } 146 2 {setbits style 0x200 } 147 3 {setbits style 0x300 } 148 default { 149 # First button, 150 # setbits style 0x000 151 } 152 } 153 154 switch -exact -- $opts(modality) { 155 system { setbits style 0x1000 } 156 task { setbits style 0x2000 } 157 appl - 158 application - 159 default { 160 # setbits style 0x0000 161 } 162 } 163 164 if {$opts(showhelp)} { setbits style 0x00004000 } 165 if {$opts(rtl)} { setbits style 0x00100000 } 166 if {$opts(justify) eq "right"} { setbits style 0x00080000 } 167 if {$opts(topmost)} { setbits style 0x00040000 } 168 if {$opts(foreground)} { setbits style 0x00010000 } 169 if {$opts(service)} { setbits style 0x00200000 } 170 171 set response [WTSSendMessage $opts(hserver) $opts(tssession) $opts(title) \ 172 $opts(message) $style $opts(timeout) \ 173 [expr {!$opts(async)}]] 174 175 switch -exact -- $response { 176 1 { return ok } 177 2 { return cancel } 178 3 { return abort } 179 4 { return retry } 180 5 { return ignore } 181 6 { return yes } 182 7 { return no } 183 8 { return close } 184 9 { return help } 185 10 { return tryagain } 186 11 { return continue } 187 32000 { return timeout } 188 32001 { return async } 189 default { return $response } 190 } 191} 192