# winapi.tcl --
#
# This modules provides an interface to a number of low level
# WIN32 functions.
#
# Copyright (c) 2004-2006 by the Swedish Institute of Computer Science.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# We need Ffidl since we will be creating loads of callouts
package require Ffidl
# Create the namespace, further initialisation will be done at the end
# of this file.
namespace eval ::winapi {
}
# ::winapi::GetClassName -- Get window class name wrapper
#
# This procedure extracts the class of a window and returns it
#
# Arguments:
# w Handle of window to get information from
# bufsize Max number of characters when asking for the class name
#
# Results:
# Returns class of window.
#
# Side Effects:
# None.
proc ::winapi::GetClassName { w { bufsize 1024 } } {
set buf [binary format x$bufsize]
__GetClassName $w buf $bufsize
binary scan $buf A* buf
return $buf
}
# ::winapi::GetWindowText -- Get window text
#
# This procedure extracts the text of a window (usually title bar).
#
# Arguments:
# w Handle of window to get information from
# bufsize Max number of characters when asking for the class name
#
# Results:
# Returns text of window.
#
# Side Effects:
# None.
proc ::winapi::GetWindowText { w { bufsize 1024 } } {
set buf [binary format x$bufsize]
__GetWindowText $w buf $bufsize
binary scan $buf A* buf
return $buf
}
# ::winapi::GetWindowRect -- Get window rect
#
# This procedure extracts the rectangle enclosing a window.
#
# Arguments:
# w Handle of window to get information from
#
# Results:
# Return a list form of, respectively, the left, top, right and
# bottom pixel position of the rectangle.
#
# Side Effects:
# None.
proc ::winapi::GetWindowRect { w } {
# Initialise a "RECT" structure, pass it to __GetWindowRect and
# extract and return values.
set buf [binary format [::ffidl::info format ::winapi::RECT] 0 0 0 0]
__GetWindowRect $w buf
binary scan $buf [::ffidl::info format ::winapi::RECT] \
left top right bottom
return [list $left $top $right $bottom]
}
# ::winapi::GetClientRect -- Get window rect
#
# This procedure extracts the rectangle enclosing a window in
# client coordinates.
#
# Arguments:
# w Handle of window to get information from
#
# Results:
# Return a list form of, respectively, the left, top, right and
# bottom pixel position of the rectangle. left and top always 0
#
# Side Effects:
# None.
proc ::winapi::GetClientRect { w } {
# Initialise a "RECT" structure, pass it to __GetClientRect and
# extract and return values.
set buf [binary format [::ffidl::info format ::winapi::RECT] 0 0 0 0]
__GetClientRect $w buf
binary scan $buf [::ffidl::info format ::winapi::RECT] \
left top right bottom
return [list $left $top $right $bottom]
}
# ::winapi::GetWindowPlacement -- Get window show state and minimised info
#
# This procedure retrieves the show state and the restored,
# minimized, and maximized positions of the specified window.
#
# Arguments:
# w Handle of window to get information from
#
# Results:
# Return a list ready for an array set command with the
# following keys: flags showCmd ptMinPosX ptMinPosY ptMaxPosX
# ptMaxPosY rcNormalPosLeft rcNormalPosTop rcNormalPosRight
# rcNormalPosBottom, where flags and showCmd are textual list
#
# Side Effects:
# None.
proc ::winapi::GetWindowPlacement { w } {
set buf [binary format [::ffidl::info format ::winapi::WINDOWPLACEMENT] \
[::ffidl::info sizeof ::winapi::WINDOWPLACEMENT] \
0 0 0 0 0 0 0 0 0 0]
if { [__GetWindowPlacement $w buf] } {
binary scan $buf [::ffidl::info format ::winapi::WINDOWPLACEMENT] \
len flags showCmd ptMinPosX ptMinPosY ptMaxPosX ptMaxPosY \
rcPosLeft rcPosTop rcPosRight rcPosBottom
set flags_l [__tflags $flags [list \
WPF_ASYNCWINDOWPLACEMENT 4\
WPF_RESTORETOMAXIMIZED 2 \
WPF_SETMINPOSITION 1]]
set cmd [__tflag $showCmd [list \
SW_HIDE 0 \
SW_MAXIMIZE 3 \
SW_MINIMIZE 6 \
SW_RESTORE 9 \
SW_SHOW 5 \
SW_SHOWMINIMIZED 2 \
SW_SHOWMAXIMIZED 3 \
SW_SHOWMINNOACTIVE 7 \
SW_SHOWNA 8 \
SW_SHOWNOACTIVATE 4 \
SW_SHOWNORMAL 1 \
SW_NORMAL 1 \
SW_SHOWDEFAULT 10 \
SW_FORCEMINIMIZE 11 \
SW_MAX 11 \
SW_NORMALNA [expr {0xCC}]]]
return [list flags "$flags_l" showCmd $cmd \
ptMinPosX $ptMinPosX ptMinPosY $ptMinPosY \
ptMaxPosX $ptMaxPosX ptMaxPosY $ptMaxPosY \
rcNormalPosLeft $rcPosLeft rcNormalPosTop $rcPosTop \
rcNormalPosRight $rcPosRight \
rcNormalPosBottom $rcPosBottom]
}
return ""
}
# ::winapi::SetWindowPlacement -- Set window show state and minimised info
#
# This procedure sets the show state and the restored,
# minimized, and maximized positions of the specified window.
#
# Arguments:
# w Handle of window to set information from
# wndpl Array describing the window placement, the recognised
# values are flags showCmd ptMinPosX ptMinPosY ptMaxPosX
# ptMaxPosY rcNormalPosLeft rcNormalPosTop rcNormalPosRight
# rcNormalPosBottom, where flags and showCmd are textual.
# Missing value will be default to current (GetWindowPlacment)
#
# Results:
# Return boolean telling success.
#
# Side Effects:
# None.
proc ::winapi::SetWindowPlacement { w wndpl } {
array set placement [GetWindowPlacement $w]
array set placement $wndpl
set placement(flags) [__flags $placement(flags) [list \
*ASYNCWINDOWPLACEMENT 4\
*RESTORETOMAXIMIZED 2 \
*SETMINPOSITION 1]]
set placement(showCmd) [__flag $placement(showCmd) [list \
*HIDE 0 \
*MAXIMIZE 3 \
*MINIMIZE 6 \
*RESTORE 9 \
*SHOW 5 \
*SHOWMINIMIZED 2 \
*SHOWMAXIMIZED 3 \
*SHOWMINNOACTIVE 7 \
*SHOWNA 8 \
*SHOWNOACTIVATE 4 \
*SHOWNORMAL 1 \
*NORMAL 1 \
*SHOWDEFAULT 10 \
*FORCEMINIMIZE 11 \
*MAX 11 \
*NORMALNA [expr {0xCC}]]]
set buf [binary format [::ffidl::info format ::winapi::WINDOWPLACEMENT] \
[::ffidl::info sizeof ::winapi::WINDOWPLACEMENT] \
$placement(flags) \
$placement(showCmd) \
$placement(ptMinPosX) \
$placement(ptMinPosY) \
$placement(ptMaxPosX) \
$placement(ptMaxPosY) \
$placement(rcNormalPosLeft) \
$placement(rcNormalPosTop) \
$placement(rcNormalPosRight) \
$placement(rcNormalPosBottom)]
return [__SetWindowPlacement $w buf]
}
# ::winapi::ShowWindow -- Set window show state
#
# This procedure sets the show state
#
# Arguments:
# w Handle of window to set information from
# cmd Any valid SW_ command (see win API).
#
# Results:
# Return boolean telling success.
#
# Side Effects:
# None.
proc ::winapi::ShowWindow { w cmd } {
set cmd [__flag $cmd [list \
*HIDE 0 \
*MAXIMIZE 3 \
*MINIMIZE 6 \
*RESTORE 9 \
*SHOW 5 \
*SHOWMINIMIZED 2 \
*SHOWMAXIMIZED 3 \
*SHOWMINNOACTIVE 7 \
*SHOWNA 8 \
*SHOWNOACTIVATE 4 \
*SHOWNORMAL 1 \
*NORMAL 1 \
*SHOWDEFAULT 10 \
*FORCEMINIMIZE 11 \
*MAX 11 \
*NORMALNA [expr {0xCC}]]]
__ShowWindow $w $cmd
}
# ::winapi::SetWindowPos -- Set window size, position and z-order
#
# This procedure changes the size, position, and Z order of a
# child, pop-up, or top-level window. Child, pop-up, and
# top-level windows are ordered according to their appearance on
# the screen. The topmost window receives the highest rank and
# is the first window in the Z order.
#
# Arguments:
# w Handle of window to set information from
# w_after Handle of the window to precede the positioned window
# x New X position
# y New Y position
# cx New width
# cy New height
# f Flags (see API doc)
#
# Results:
# Return boolean telling success.
#
# Side Effects:
# None.
proc ::winapi::SetWindowPos { w w_after {x -1} {y -1} {cx -1} {cy -1} {f ""}} {
# Fix some decent default values so that we can skip passing
# parameters sometimes.
if { $f == "" } {
if { $x < 0 && $y < 0 } {
lappend f SWP_NOMOVE
}
if { $cx < 0 && $cy < 0 } {
lappend f SWP_NOSIZE
}
}
set w_after [__flag $w_after [list \
*TOP 0 \
*BOTTOM 1 \
*NOTOPMOST -2 \
*TOPMOST -1 \
*MESSAGE -3]]
set f [__flags $f [list \
*NOSIZE [expr {0x0001}]\
*NOMOVE [expr {0x0002}]\
*NOZORDER [expr {0x0004}]\
*NOREDRAW [expr {0x0008}]\
*NOACTIVATE [expr {0x0010}]\
*FRAMECHANGED [expr {0x0020}]\
*SHOWWINDOW [expr {0x0040}]\
*HIDEWINDOW [expr {0x0080}]\
*NOCOPYBITS [expr {0x0100}]\
*NOOWNERZORDER [expr {0x0200}]]]
__SetWindowPos $w $w_after $x $y $cx $cy $f
}
# ::winapi::GetWindowInfo -- Get window information.
#
# This procedure retrieves information about the specified window
#
# Arguments:
# w Handle of window to get information from
#
# Results:
# Return a list ready for an array set command with the following keys.
#
# Side Effects:
# None.
proc ::winapi::GetWindowInfo { w } {
set buf [binary format [::ffidl::info format ::winapi::WINDOWINFO] \
[::ffidl::info sizeof ::winapi::WINDOWINFO] \
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
if { [__GetWindowInfo $w buf] } {
array set res {}
binary scan $buf [::::ffidl::info format ::winapi::WINDOWINFO] \
len \
res(rcWindowLeft) res(rcWindowTop) \
res(rcWindowRight) res(rcWindowBottom) \
res(rcClientLeft) res(rcClientTop) \
res(rcClientRight) res(rcClientBottom) \
res(dwStyle) res(dwExStyle) res(dwWindowStatus) \
res(cxWindowBorders) res(cyWindowBorders) \
res(atomWindowType) res(wCreatorVersion)
set res(dwStyle) [__tflags $res(dwStyle) \
[list \
WS_OVERLAPPED [expr {0x00000000}] \
WS_POPUP [expr {0x80000000}] \
WS_CHILD [expr {0x40000000}] \
WS_MINIMIZE [expr {0x20000000}] \
WS_VISIBLE [expr {0x10000000}] \
WS_DISABLED [expr {0x08000000}] \
WS_CLIPSIBLINGS [expr {0x04000000}] \
WS_CLIPCHILDREN [expr {0x02000000}] \
WS_MAXIMIZE [expr {0x01000000}] \
WS_CAPTION [expr {0x00C00000}] \
WS_BORDER [expr {0x00800000}] \
WS_DLGFRAME [expr {0x00400000}] \
WS_VSCROLL [expr {0x00200000}] \
WS_HSCROLL [expr {0x00100000}] \
WS_SYSMENU [expr {0x00080000}] \
WS_THICKFRAME [expr {0x00040000}] \
WS_GROUP [expr {0x00020000}] \
WS_TABSTOP [expr {0x00010000}] \
WS_MINIMIZEBOX [expr {0x00020000}] \
WS_MAXIMIZEBOX [expr {0x00010000}]]]
set res(dwExStyle) [__tflags $res(dwExStyle) \
[list \
WS_EX_DLGMODALFRAME [expr {0x00000001}] \
WS_EX_DRAGDETECT [expr {0x00000002}] \
WS_EX_NOPARENTNOTIFY [expr {0x00000004}] \
WS_EX_TOPMOST [expr {0x00000008}] \
WS_EX_ACCEPTFILES [expr {0x00000010}] \
WS_EX_TRANSPARENT [expr {0x00000020}] \
WS_EX_MDICHILD [expr {0x00000040}] \
WS_EX_TOOLWINDOW [expr {0x00000080}] \
WS_EX_WINDOWEDGE [expr {0x00000100}] \
WS_EX_CLIENTEDGE [expr {0x00000200}] \
WS_EX_CONTEXTHELP [expr {0x00000400}] \
WS_EX_RIGHT [expr {0x00001000}] \
WS_EX_LEFT [expr {0x00000000}] \
WS_EX_RTLREADING [expr {0x00002000}] \
WS_EX_LTRREADING [expr {0x00000000}] \
WS_EX_LEFTSCROLLBAR [expr {0x00004000}] \
WS_EX_RIGHTSCROLLBAR [expr {0x00000000}] \
WS_EX_CONTROLPARENT [expr {0x00010000}] \
WS_EX_STATICEDGE [expr {0x00020000}] \
WS_EX_APPWINDOW [expr {0x00040000}] \
WS_EX_LAYERED [expr {0x00080000}] \
WS_EX_NOINHERITLAYOUT [expr {0x00100000}]\
WS_EX_LAYOUTRTL [expr {0x00400000}] \
WS_EX_COMPOSITED [expr {0x02000000}] \
WS_EX_NOACTIVATE [expr {0x08000000}]]]
return [array get res]
}
return ""
}
# ::winapi::FindWindow -- Wrapper around FindWindow
#
# This procedure finds a (toplevel) window that exactly matches
# a class (optional) or title (optional).
#
# Arguments:
# class Class of window, can be empty
# title Title of window, can be empty
#
# Results:
# Returns the handle of the window or 0
#
# Side Effects:
# None.
proc ::winapi::FindWindow { class title } {
if { [string length $class] == 0 && [string length $title] == 0} {
__FindWindowTitleNone 0 0
} elseif { [string length $class] == 0 } {
__FindWindowTitle 0 $title
} elseif { [string length $title] == 0 } {
__FindWindowClass $class 0
} else {
__FindWindow $class $title
}
}
# ::winapi::FindWindowEx -- Wrapper around FindWindowEx
#
# This procedure finds a children window that exactly matches
# a class (optional) or title (optional).
#
# Arguments:
# parent Parent top window under which to look for window.
# child Handle of child window to start search for after.
# class Class of window, can be empty
# title Title of window, can be empty
#
# Results:
# Returns the handle of the window or 0
#
# Side Effects:
# None.
proc ::winapi::FindWindowEx { parent child class title } {
if { [string length $class] == 0 && [string length $title] == 0} {
__FindWindowExNone $parent $child 0 0
} elseif { [string length $class] == 0 } {
__FindWindowExTitle $parent $child 0 $title
} elseif { [string length $title] == 0 } {
__FindWindowExClass $parent $child $class 0
} else {
__FindWindowEx $parent $child $class $title
}
}
# ::winapi::FindWindows -- Find sub windows by pattern.
#
# This procedure finds all direct sub windows of a window that
# matches a given pattern.
#
# Arguments:
# parent Parent top window under which to look for window.
# class Class pattern (string match-like) of window.
# title Title pattern (string match-like) of window.
#
# Results:
# Returns the handles of the windows that match the input patterns.
#
# Side Effects:
# None.
proc ::winapi::FindWindows { parent class title } {
set wins ""
set w [FindWindowEx $parent 0 "" ""]
for { } { $w != 0 } { set w [FindWindowEx $parent $w "" ""] } {
if { [string match $class [GetClassName $w]] \
&& [string match $title [GetWindowText $w]] } {
lappend wins $w
}
}
return $wins
}
# ::winapi::WindowTree -- Return whole window tree
#
# This procedure finds all the windows that are a descendant of
# a given window.
#
# Arguments:
# w Parent top window for which to return the tree.
#
# Results:
# Returns the handles of all descendant of the window which
# handle is passed as a parameter.
#
# Side Effects:
# None.
proc ::winapi::WindowTree { w } {
set subs [FindWindows $w * *]
set res $subs
foreach s $subs {
set res [concat $res [WindowTree $s]]
}
return $res
}
# ::winapi::FindDescendantWindows -- Find descendant windows by pattern.
#
# This procedure finds all descendant windows (whole tree!) of a
# window that matches a given pattern.
#
# Arguments:
# parent Parent top window under which to look for window.
# class Class pattern (string match-like) of window.
# text Text pattern (string match-like) of window.
#
# Results:
# Returns the handles of the windows that match the input patterns.
#
# Side Effects:
# None.
proc ::winapi::FindDescendantWindows { parent class text } {
set wins ""
foreach w [WindowTree $parent] {
if { [string match $class [GetClassName $w]] \
&& [string match $text [GetWindowText $w]] } {
lappend wins $w
}
}
return $wins
}
# ::winapi::__flag -- Transcript a textual flag to its integer value
#
# This procedure looks in a flag list for a given flag and
# return the (integer) value that is associated to it. The flag
# specification list is any repetition of key value where the
# key is ready for string matching. Matching on incoming flag
# and keys is made careless of the case.
#
# Arguments:
# f Flag to convert to integer
# specs List of specification key1 val1 key2 val2 ...
#
# Results:
# Returns the first matching value of the flag, if the flag was
# already an integer it is returned, empty flags will lead to 0.
#
# Side Effects:
# None.
proc ::winapi::__flag { f specs } {
# Empty flag
if { [string length $f] == 0 } {
return 0
}
# Already an integer, return it
if { [string is integer $f] } {
return $f
}
# Otherwise look for first matching key in specification list and
# return it.
set f [string toupper $f]
foreach {spec val} $specs {
if { [string match [string toupper $spec] $f] } {
return $val
}
}
return 0
}
# ::winapi::__tflag -- Transcript an integer constant to its textual value
#
# This procedure looks in a flag list for a given flag and
# return the (textual) value that is associated to it. The flag
# specification list is any repetition of key value where the
# key is ready for string matching.
#
# Arguments:
# f Flag to convert to string
# specs List of specification key1 val1 key2 val2 ...
#
# Results:
# Returns the first matching value of the flag
#
# Side Effects:
# None.
proc ::winapi::__tflag { f specs } {
foreach {spec val} $specs {
if { $val == $f } {
return $spec
}
}
return ""
}
# ::winapi::__flags -- Transcript a textual flag to its integer value
#
# This procedure looks in a flag list for several flags (like a
# C masked flag) and return the (integer) value that is
# associated to them. The flag specification list is any
# repetition of key value where the key is ready for string
# matching. Matching on incoming flag and keys is made careless
# of the case.
#
# Arguments:
# f List of flags to convert to integer
# specs List of specification key1 val1 key2 val2 ...
#
# Results:
# Returns the added value of all flags (which is equivalent to
# an OR operation), if the flag was already an integer it is
# returned, empty flags will lead to 0.
#
# Side Effects:
# None.
proc ::winapi::__flags { flagsl specs } {
# Empty flag, 0
if { [string length $flagsl] == 0 } {
return 0
}
# Otherwise perform the addition
set flags 0
foreach f $flagsl {
incr flags [__flag $f $specs]
}
return $flags
}
# ::winapi::__tflags -- Transcript an integer mask flag to its string list
#
# This procedure considers the incoming integer as a flag mask
# and return the list of textual value that is associated to
# them. The flag specification list is any repetition of key
# value where the key is ready for string matching.
#
# Arguments:
# f Flag mask to convert to list of values
# specs List of specification key1 val1 key2 val2 ...
#
# Results:
# Returns the list of flags contained in the mask, empty possibly
#
# Side Effects:
# None.
proc ::winapi::__tflags { f specs } {
set vals ""
foreach {spec val} $specs {
if { [expr {$f & $val}] } {
lappend vals $spec
}
}
return $vals
}
# ::winapi::GetSytemMetrics -- Return system metrics
#
# This procedure is a wrapper around the GetSystemMetrics. It
# recognises all the SM_ flags as an argument.
#
# Arguments:
# metric Name of metric to get.
#
# Results:
# The value of the metric or 0
#
# Side Effects:
# None.
proc ::winapi::GetSystemMetrics { metric } {
set m [__flag $metric [list *CXSCREEN 0 \
*CYSCREEN 1 \
*CXVSCROLL 2 \
*CYHSCROLL 3 \
*CYCAPTION 4 \
*CXBORDER 5 \
*CYBORDER 6 \
*CXDLGFRAME 7 \
*CYDLGFRAME 8 \
*CYVTHUMB 9 \
*CXHTHUMB 10 \
*CXICON 11 \
*CYICON 12 \
*CXCURSOR 13 \
*CYCURSOR 14 \
*CYMENU 15 \
*CXFULLSCREEN 16 \
*CYFULLSCREEN 17 \
*CYKANJIWINDOW 18 \
*MOUSEPRESENT 19 \
*CYVSCROLL 20 \
*CXHSCROLL 21 \
*DEBUG 22 \
*SWAPBUTTON 23 \
*RESERVED1 24 \
*RESERVED2 25 \
*RESERVED3 26 \
*RESERVED4 27 \
*CXMIN 28 \
*CYMIN 29 \
*CXSIZE 30 \
*CYSIZE 31 \
*CXFRAME 32 \
*CYFRAME 33 \
*CXMINTRACK 34 \
*CYMINTRACK 35 \
*CXDOUBLECLK 36 \
*CYDOUBLECLK 37 \
*CXICONSPACING 38 \
*CYICONSPACING 39 \
*MENUDROPALIGNMENT 40 \
*PENWINDOWS 41 \
*DBCSENABLED 42 \
*CMOUSEBUTTONS 43 \
*CXFIXEDFRAME 7 \
*CYFIXEDFRAME 8 \
*CXSIZEFRAME 32 \
*CYSIZEFRAME 33 \
*SECURE 44 \
*CXEDGE 45 \
*CYEDGE 46 \
*CXMINSPACING 47 \
*CYMINSPACING 48 \
*CXSMICON 49 \
*CYSMICON 50 \
*CYSMCAPTION 51 \
*CXSMSIZE 52 \
*CYSMSIZE 53 \
*CXMENUSIZE 54 \
*CYMENUSIZE 55 \
*ARRANGE 56 \
*CXMINIMIZED 57 \
*CYMINIMIZED 58 \
*CXMAXTRACK 59 \
*CYMAXTRACK 60 \
*CXMAXIMIZED 61 \
*CYMAXIMIZED 62 \
*NETWORK 63 \
*CLEANBOOT 67 \
*CXDRAG 68 \
*CYDRAG 69 \
*SHOWSOUNDS 70 \
*CXMENUCHECK 71 \
*CYMENUCHECK 72 \
*SLOWMACHINE 73 \
*MIDEASTENABLED 74 \
*MOUSEWHEELPRESENT 75 \
*XVIRTUALSCREEN 76 \
*YVIRTUALSCREEN 77 \
*CXVIRTUALSCREEN 78 \
*CYVIRTUALSCREEN 79 \
*CMONITORS 80 \
*SAMEDISPLAYFORMAT 81 \
*IMMENABLED 82 \
*CXFOCUSBORDER 83 \
*CYFOCUSBORDER 84 \
*TABLETPC 86 \
*MEDIACENTER 87 \
*STARTER 88 \
*SERVERR2 89 \
*CMETRICS 90]]
__GetSystemMetrics $m
}
# ::winapi::SendMouseInput -- Send simulated mouse input
#
# This procedure is a wrapper around (the deprecated)
# mouse_event function that is able to understand all the
# MOUSEEVENTF_ flags as input. It is called that way to hint to
# the (new) SendInput function that replaces mouse_event.
#
# Arguments:
# dx Absolute or relative deplacement in X
# dy Absolute or relative deplacement in Y
# flagsl List of MOUSEEVENTF_ flags that describe the event.
# dwData Additional data to the event.
#
# Results:
# None
#
# Side Effects:
# None.
proc ::winapi::SendMouseInput { dx dy flagsl { dwData "" } } {
set flags [__flags $flagsl { "*ABSOLUTE" 32768 "*MOVE" 1 \
"*LEFTDOWN" 2 "*LEFTUP" 4 \
"*RIGHTDOWN" 8 "*RIGHTUP" 16 \
"*MIDDLEDOWN" 32 "*MIDDLEUP" 64 \
"*WHEEL" 2048 "*XDOWN" 128 "*XUP" 256}]
set dwData [__flags $dwData { "XBUTTON1" 1 "XBUTTON2" 2}]
# Ideally, we would like to call SendInput, but it requires a
# pointer to an structure that contains itself a pointer to an
# array and I don't know how to imlement that with ffidl.
mouse_event $flags $dx $dy $dwData 0
}
# ::winapi::SendKeyboardInput -- Send simulated keyboard input
#
# This procedure is a wrapper around (the deprecated)
# keybd_event function that is able to understand all the
# VK_ flags as input. It is called that way to hint to
# the (new) SendInput function that replaces keybd_event.
#
# Arguments:
# vk Virtual key of the event
# dwFlags Flags describing the key event
#
# Results:
# None
#
# Side Effects:
# None.
proc ::winapi::SendKeyboardInput { vk { dwFlags ""} } {
set flags [__flags $dwFlags { "*EXTENDEDKEY" 1 "*KEYUP" 2}]
set vk [__flags $vk [list "*LBUTTON" [expr {0x01}] \
"*RBUTTON" [expr {0x02}] \
"*CANCEL" [expr {0x03}] \
"*MBUTTON" [expr {0x04}] \
"*XBUTTON1" [expr {0x05}] \
"*XBUTTON2" [expr {0x06}] \
"*BACK" [expr {0x08}] \
"*TAB" [expr {0x09}] \
"*CLEAR" [expr {0x0C}] \
"*RETURN" [expr {0x0D}] \
"*SHIFT" [expr {0x10}] \
"*CONTROL" [expr {0x11}] \
"*MENU" [expr {0x12}] \
"*PAUSE" [expr {0x13}] \
"*CAPITAL" [expr {0x14}] \
"*KANA" [expr {0x15}] \
"*HANGUEL" [expr {0x15}] \
"*HANGUL" [expr {0x15}] \
"*JUNJA" [expr {0x17}] \
"*FINAL" [expr {0x18}] \
"*HANJA" [expr {0x19}] \
"*KANJI" [expr {0x19}] \
"*ESCAPE" [expr {0x1B}] \
"*CONVERT" [expr {0x1C}] \
"*NONCONVERT" [expr {0x1D}] \
"*ACCEPT" [expr {0x1E}] \
"*MODECHANGE" [expr {0x1F}] \
"*SPACE" [expr {0x20}] \
"*PRIOR" [expr {0x21}] \
"*NEXT" [expr {0x22}] \
"*END" [expr {0x23}] \
"*HOME" [expr {0x24}] \
"*LEFT" [expr {0x25}] \
"*UP" [expr {0x26}] \
"*RIGHT" [expr {0x27}] \
"*DOWN" [expr {0x28}] \
"*SELECT" [expr {0x29}] \
"*PRINT" [expr {0x2A}] \
"*EXECUTE" [expr {0x2B}] \
"*SNAPSHOT" [expr {0x2C}] \
"*INSERT" [expr {0x2D}] \
"*DELETE" [expr {0x2E}] \
"*HELP" [expr {0x2F}] \
0 [expr {0x30}] \
1 [expr {0x31}] \
2 [expr {0x32}] \
3 [expr {0x33}] \
4 [expr {0x34}] \
5 [expr {0x35}] \
6 [expr {0x36}] \
7 [expr {0x37}] \
8 [expr {0x38}] \
9 [expr {0x39}] \
A [expr {0x41}] \
B [expr {0x42}] \
C [expr {0x43}] \
D [expr {0x44}] \
E [expr {0x45}] \
F [expr {0x46}] \
G [expr {0x47}] \
H [expr {0x48}] \
I [expr {0x49}] \
J [expr {0x4A}] \
K [expr {0x4B}] \
L [expr {0x4C}] \
M [expr {0x4D}] \
N [expr {0x4E}] \
O [expr {0x4F}] \
P [expr {0x50}] \
Q [expr {0x51}] \
R [expr {0x52}] \
S [expr {0x53}] \
T [expr {0x54}] \
U [expr {0x55}] \
V [expr {0x56}] \
W [expr {0x57}] \
X [expr {0x58}] \
Y [expr {0x59}] \
Z [expr {0x5A}] \
"*LWIN" [expr {0x5B}] \
"*RWIN" [expr {0x5C}] \
"*APPS" [expr {0x5D}] \
"*SLEEP" [expr {0x5F}] \
"*NUMPAD0" [expr {0x60}] \
"*NUMPAD1" [expr {0x61}] \
"*NUMPAD2" [expr {0x62}] \
"*NUMPAD3" [expr {0x63}] \
"*NUMPAD4" [expr {0x64}] \
"*NUMPAD5" [expr {0x65}] \
"*NUMPAD6" [expr {0x66}] \
"*NUMPAD7" [expr {0x67}] \
"*NUMPAD8" [expr {0x68}] \
"*NUMPAD9" [expr {0x69}] \
"*MULTIPLY" [expr {0x6A}] \
"*ADD" [expr {0x6B}] \
"*SEPARATOR" [expr {0x6C}] \
"*SUBTRACT" [expr {0x6D}] \
"*DECIMAL" [expr {0x6E}] \
"*DIVIDE" [expr {0x6F}] \
"*F1" [expr {0x70}] \
"*F2" [expr {0x71}] \
"*F3" [expr {0x72}] \
"*F4" [expr {0x73}] \
"*F5" [expr {0x74}] \
"*F6" [expr {0x75}] \
"*F7" [expr {0x76}] \
"*F8" [expr {0x77}] \
"*F9" [expr {0x78}] \
"*F10" [expr {0x79}] \
"*F11" [expr {0x7A}] \
"*F12" [expr {0x7B}] \
"*F13" [expr {0x7C}] \
"*F14" [expr {0x7D}] \
"*F15" [expr {0x7E}] \
"*F16" [expr {0x7F}] \
"*F17" [expr {0x80}] \
"*F18" [expr {0x81}] \
"*F19" [expr {0x82}] \
"*F20" [expr {0x83}] \
"*F21" [expr {0x84}] \
"*F22" [expr {0x85}] \
"*F23" [expr {0x86}] \
"*F24" [expr {0x87}] \
"*NUMLOCK" [expr {0x90}] \
"*SCROLL" [expr {0x91}] \
"*LSHIFT" [expr {0xA0}] \
"*RSHIFT" [expr {0xA1}] \
"*LCONTROL" [expr {0xA2}] \
"*RCONTROL" [expr {0xA3}] \
"*LMENU" [expr {0xA4}] \
"*RMENU" [expr {0xA5}] \
"*BROWSER_BACK" [expr {0xA6}] \
"*BROWSER_FORWARD" [expr {0xA7}] \
"*BROWSER_REFRESH" [expr {0xA8}] \
"*BROWSER_STOP" [expr {0xA9}] \
"*BROWSER_SEARCH" [expr {0xAA}] \
"*BROWSER_FAVORITES" [expr {0xAB}] \
"*BROWSER_HOME" [expr {0xAC}] \
"*VOLUME_MUTE" [expr {0xAD}] \
"*VOLUME_DOWN" [expr {0xAE}] \
"*VOLUME_UP" [expr {0xAF}] \
"*MEDIA_NEXT_TRACK" [expr {0xB0}] \
"*MEDIA_PREV_TRACK" [expr {0xB1}] \
"*MEDIA_STOP" [expr {0xB2}] \
"*MEDIA_PLAY_PAUSE" [expr {0xB3}] \
"*LAUNCH_MAIL" [expr {0xB4}] \
"*LAUNCH_MEDIA_SELECT" [expr {0xB5}] \
"*LAUNCH_APP1" [expr {0xB6}] \
"*LAUNCH_APP2" [expr {0xB7}] \
"*OEM_1" [expr {0xBA}] \
"*OEM_PLUS" [expr {0xBB}] \
"*OEM_COMMA" [expr {0xBC}] \
"*OEM_MINUS" [expr {0xBD}] \
"*OEM_PERIOD" [expr {0xBE}] \
"*OEM_2" [expr {0xBF}] \
"*OEM_3" [expr {0xC0}] \
"*OEM_4" [expr {0xDB}] \
"*OEM_5" [expr {0xDC}] \
"*OEM_6" [expr {0xDD}] \
"*OEM_7" [expr {0xDE}] \
"*OEM_8" [expr {0xDF}] \
"*OEM_102" [expr {0xE2}] \
"*PROCESSKEY" [expr {0xE5}] \
"*PACKET" [expr {0xE7}] \
"*ATTN" [expr {0xF6}] \
"*CRSEL" [expr {0xF7}] \
"*EXSEL" [expr {0xF8}] \
"*EREOF" [expr {0xF9}] \
"*PLAY" [expr {0xFA}] \
"*ZOOM" [expr {0xFB}] \
"*NONAME" [expr {0xFC}] \
"*PA1" [expr {0xFD}] \
"*OEM_CLEAR" [expr {0xFE}]]]
keybd_event $vk 0 $flags 0
}
# ::winapi::api -- Declare callout for DLL functions.
#
# This procedure declares a callout in this namespace for a
# given function from one DLL.
#
# Arguments:
# apiname Name of command to be created (::winapi:: will be prefixed)
# argl List of arguments to the callout
# ret Type of value returned
# dllname Name of corresponding function in DLL (empty means same as api)
# dll DLL in which to get the function from
#
# Results:
# None.
#
# Side Effects:
# None.
proc ::winapi::api { apiname argl ret { dllname "" } { dll "user32.dll" } } {
if { $dllname == "" } {
set dllname $apiname
# Get rid of lead underscore whenever possible.
if { [string match "__*" $dllname] } {
set dllname [string range $dllname 2 end]
}
}
# Look for the function by its name, alernatively by its name
# followed by the letter "A" as it seems the case sometimes.
foreach n [list $dllname "${dllname}A"] {
if { [catch {::ffidl::symbol $dll $n} addr] } {
set addr ""
} else {
break
}
}
if { $addr != "" } {
::ffidl::callout ::winapi::$apiname $argl $ret $addr
}
}
# ::winapi::__init -- Initialise all known callouts
#
# This procedure initialises this module by declaring a whole
# lot of callouts to functions in user32.dll. All callouts
# prefixed by __ will be internals for which wrappers are
# provided.
#
# Arguments:
# None.
#
# Results:
# Boolean describe success or failure.
#
# Side Effects:
# None.
proc ::winapi::__init { } {
::ffidl::typedef ::winapi::RECT long long long long
::ffidl::typedef ::winapi::POINT long long
::ffidl::typedef ::winapi::WINDOWPLACEMENT \
uint32 uint32 uint32 ::winapi::POINT ::winapi::POINT ::winapi::RECT
::ffidl::typedef ::winapi::WINDOWINFO \
uint32 ::winapi::RECT ::winapi::RECT uint32 uint32 uint32 uint32 \
uint32 uint16 uint16
# FindWindow in all its forms to support both empty and non-empty strings
api __FindWindow { pointer-utf8 pointer-utf8 } long FindWindow
api __FindWindowTitle { long pointer-utf8 } long FindWindow
api __FindWindowClass { pointer-utf8 long } long FindWindow
api __FindWindowNone { long long } long FindWindow
# FindWindowEx in all its forms to support both empty and non-empty strings
api __FindWindowEx { long long pointer-utf8 pointer-utf8 } long \
FindWindowEx
api __FindWindowExTitle { long long long pointer-utf8 } long FindWindowEx
api __FindWindowExClass { long long pointer-utf8 long } long FindWindowEx
api __FindWindowExNone { long long long long } long FindWindowEx
api GetDesktopWindow {} long
api GetWindow { long long } long
api __GetClassName {int pointer-var int} int
api __GetWindowText {int pointer-var int} int
api __GetWindowPlacement {int pointer-var} int
api __SetWindowPlacement {int pointer-var} int
api __SetWindowPos {int int int int int int uint32} int
api __ShowWindow {int int} int
api MoveWindow { int int int int int int } int
api __GetWindowInfo { int pointer-var } int
api BringWindowToTop { int } int
api GetTopWindow { int } int
api SwitchToThisWindow { int int } void
api __GetWindowRect { long pointer-var } int
api __GetClientRect { long pointer-var } int
api __GetSystemMetrics { int } int
api GetLastError {} int
# User Input
api SendInput { int pointer-var int } int
api mouse_event { int int int int long } void
api keybd_event { uint8 uint8 int long } void
return 1
}
# Now automatically initialises this module, once and only once
# through calling the __init procedure that was just declared above.
namespace eval ::winapi {
variable inited
if { ! [info exists inited] } {
set inited [::winapi::__init]
}
}
package provide winapi 0.1MJ -- In the ::winapi::api proc defined above, an A is appended to functions if the plain name cannot be found (GetWindowText is one example) This implies the ANSI version of the Win32 funcion is used so Unicode in for instance window captions will be returned as ? characters. If the A is replaced with W the Unicode will be correctly returned. Be aware that the buffers allocated for the return values have to be twice as large now than in the ANSI case.EF This page is devoted to an initial (and incomplete) attempt to provide a low-level layer to access and manipulate the Windows API. The library is built directly on top of Ffidl. It tries to provide wrappers around the various flags and constants that are used in Windows. So far, the library contains commands to fiddle with Windows and simulate input. Feel free to add anything to the code and/or modify it. The license is do whatever, don't blame me.APN Just so we don't duplicate work, please take a look at TWAPI which already provides both low level and high level access to over 350 Windows functions. One limitation however is that TWAPI is NT 4.0 and above only.EF winapi is Windows 95 compliant (so far) and above all, only requires Ffidl, while TWAPI is an extension that needs to be loaded. I really wish Ffidl or DLL [1] were part of the core. TWAPI also has a disturbing interface, in the manner that it is so different from the standard Windows API. The procedures declared by winapi tend to be very similar to the names and conventions that are introduced by the standard Windows API.APN EF, I hope you didn't take my note above as a criticism or a suggestion that winapi was not worth doing. Also, in addition to the much easier to use high level interface, TWAPI also provides direct win32 access so you can call twapi::GetWindowText directly just as you do in winapi. Do a twapi::list_raw_api to list the win32 functions supported. The higher level documented interface is only disturbing as you put it because it is vastly easier and more convenient to use than raw Win32 (IMHO of course). Just as Tcl is vastly easier and more convenient than C++ :-) Anyways, use of Ffidl v/s TWAPI is a common topic so I've started a page Comparing TWAPI and Ffidl on Windows summarizing my views.EF No, no, I did not take this as a criticism. I was just trying to point at the differences and your new page is probably going to help people. How can you pass flags and masks to the low level API of TWAPI? I tried to supply a "readable" version of these functions in winapi by translating flags and masks to readable strings or list of strings. See the __flag __flags __tflag and __tflags procedures below.EF 3/2/2006 Some new functions in the code below, no version boost though.EF An extended version is now part of my Google code project. You can check it out of SVN from [2]. You might also want to have a look at winop [3], another library available from the same site. winop will allow you to treat windows from external applications in a similar fashion than your own windows.
Getting started
Home • Recent changes • Help • Create new page • Search • Add comments
• Edit