Can Tcl manage Windows "shell links"? Certainly; there are at least seven ways: * [Matt Newman]'s tlink32 [http://www.sensus.org/tcl/index.htm] * by way of [DDE], as [David Gravereaux] exemplifies: dde execute progman progman "" "\[CreateGroup(Bogus)\]" dde execute progman progman "" \ "\[AddItem(notepad.exe,BogusPadLink)\]" dde execute progman progman "" "\[ShowGroup(Bogus,0)\]" dde execute progman progman "" "\[ShowGroup(Bogus,1)\]" dde execute progman progman "" "\[DeleteItem(BogusPadLink)\]" dde execute progman progman "" "\[DeleteGroup(Bogus)\]" * [Steve Cassidy] wraps this DDE approach in a progman.tcl [http://www.shlrc.mq.edu.au/~steve/tcl/progman.tcl] package designed "package to allow creation of program groups and shortcuts in the start menu on Windows 9x/NT" * [Bill Schongar]'s WISE hack [http://groups.google.com/groups?q=schongar+shell32.lib+group%3Acomp.lang.tcl*&num=25&hl=en&safe=off&rnum=2&ic=1&selm=37418479%40News.Destek.net] * [freeWrap] includes "shell link" functionality comparable to tlink32's. * NT-TCL [http://zazu.maxwell.syr.edu/nt-tcl/] includes a shortcut.dll that although ancient works with recent version of Tcl thanks to the stubs interface. Can't seem to find the source though. * Use Tcom (see below) * [[...]] A ZIP file containing a PDF with detailed information on the link file format [http://www.the7soft.com/file-formats/file-formats-Windows/shortcut.zip] Anybody knows of an extension that lets you create unicode-aware shell links ? For example, for chinese version of windows (none of the above seems to work for me) ---- [RS] tried reading such links, or "shortcuts", in a simpler, and pure-Tcl way. If you look at .lnk files in hexdump, you notice that they contain the string of what they link to, among other things. So I tried just to split on NUL bytes and see whether a snippet is a valid absolute path: proc readlnk {lnk} { set res "" set fp [open $lnk] foreach snip [split [read $fp] \x00] { if {[regexp {[A-Z]:\\} $snip] && [file exists $snip]} { lappend res $snip } } close $fp join $res } This is highly experimental, but it worked on the few examples I tried - please correct me if you know better! Simple links to directories and files work. Links that contain an executable invocation with arguments and icon, are a funny mix of ASCII and Unicode, so splitting on 0 is not a good idea there, and the above code does not work. See also [Symbolic links in Windows/CE] ---- [NJG] package require tcom set sh [::tcom::ref createobject "WScript.Shell"] set lnk [$sh CreateShortcut {D:\WORK\Acrobat.lnk}] $lnk TargetPath {"D:\Program Files\Adobe\Acrobat 4.0\Acrobat\Acrobat.exe"} $lnk WorkingDirectory {D:\WORK} $lnk Arguments Tutorial.pdf $lnk Save ---- [BEO] Using Tcom these procedures can create, modify, and get the contents of MS Shortcut files. package require tcom # # Create a new MS Windows shortcut file. # # Requires MS Windows 2000 or later (shell v5.00+) # # Args: file = Name of shortcut file to create. # other args are: # Arguments "args.." = any cmd lines options # Description "text" = Description of Shortcut # Hotkey "sequence" = Hot key sequence. Must start with CTRL+ALT. Ex. CTRL+ALT+SHIFT+X # IconLocation "filename,number" = Path to icon file and icon # # TargetPath filename = Destination of the shortcut # WindowStyle style = number (1=normal, 3=maximized, 7=minimized) # WorkingDirectory dirname = pathname of working directory # Returns: Boolean result # # Example: create_shortcut wish.lnk Description "Tcl/Tk" WindowStyle 1 \ # TargetPath {C:\Program Files\TCL\bin\wish.exe} # proc create_shortcut {file args} { if {![string match ".lnk" [string tolower [file extension $file]]]} { append file ".lnk" } if {[string match "windows" $::tcl_platform(platform)]} { # Make sure filenames are in nativename format. array set opts $args foreach item [list IconLocation Path WorkingDirectory] { if {[info exists opts($item)]} { set opts($item) [file nativename $opts($item)] } } set oShell [tcom::ref createobject "WScript.Shell"] set oShellLink [$oShell CreateShortcut [file nativename $file]] foreach {opt val} [array get opts] { if {[catch {$oShellLink $opt $val} result]} { return -code error "Invalid shortcut option $opt or value $value: $result" } } $oShellLink Save return 1 } return 0 } # # Modify a MS Windows shortcut file. # # Requires MS Windows 2000 or later (shell v5.00+) # # Args: file = Shortcut filename. # other args are: # Arguments = any cmd lines options # Description = Description of Shortcut # Hotkey = Hot key sequence. Must start with CTRL+ALT. Ex. CTRL+ALT+SHIFT+X # IconLocation = "pathname","icon #" # Path = destination of the shortcut # WindowStyle = number (1=normal, 3=maximized, 7=minimized) # WorkingDirectory = pathname of working directory # Returns: Boolean result # # See: http://www.microsoft.com/technet/scriptcenter/resources/qanda/feb05/hey0209.mspx # http://www.microsoft.com/technet/scriptcenter/guide/sas_wsh_aytf.mspx # http://www.microsoft.com/technet/scriptcenter/resources/qanda/aug05/hey0812.mspx # proc modify_shortcut {file args} { set dir [file nativename [file dirname $file]] set tail [file nativename [file tail $file]] if {![string match ".lnk" [string tolower [file extension $file]]]} { return -code error "$file is not a valid shortcut name" } if {[string match "windows" $::tcl_platform(platform)]} { # Make sure filenames are in nativename format. array set opts $args foreach item [list IconLocation Path WorkingDirectory] { if {[info exists opts($item)]} { set opts($item) [file nativename $opts($item)] } } # Get Shortcut file as an object set oShell [tcom::ref createobject "Shell.Application"] set oFolder [$oShell NameSpace $dir] set oFolderItem [$oFolder ParseName $tail] # If its a shortcut, do modify if {[$oFolderItem IsLink]} { set oShellLink [$oFolderItem GetLink] foreach {opt val} [array get opts] { if {[catch {$oShellLink $opt $val} result]} { return -code error "Invalid shortcut option $opt or value $value: $rsult" } } $oShellLink Save } return 1 } return 0 } # # Get linked to file for MS Windows shortcut or file link. # # Requires MS Windows 2000 or later (shell v5.00+) # # Args: file = Shortcut filename. # Returns: filename shortcut links to. # proc get_shortcut_filename {file} { set dir [file nativename [file dirname $file]] set tail [file nativename [file tail $file]] if {![string match ".lnk" [string tolower [file extension $file]]]} { return -code error "$file is not a valid shortcut name" } if {[string match "windows" $::tcl_platform(platform)]} { # Get Shortcut file as an object set oShell [tcom::ref createobject "Shell.Application"] set oFolder [$oShell NameSpace $dir] set oFolderItem [$oFolder ParseName $tail] # If its a shortcut, do modify if {[$oFolderItem IsLink]} { set oShellLink [$oFolderItem GetLink] return [$oShellLink Path] } else { if {![catch {file readlink $file} new]} { set new } else { set file } } } else { if {![catch {file readlink $file} new]} { set new } else { set file } } } # # Get properties of a MS Windows shortcut file. # # Requires MS Windows 2000 or later (shell v5.00+) # # Args: file = Shortcut filename. # Returns: list of option and value pairs. # # Return Example: Path {C:\Program Files\TCL\bin\test.file} Hotkey 0 # Description {Shortcut to test.file} WorkingDirectory {} # Arguments {} ShowCommand 1 Target ::tcom::handle0x00C2D938 # proc get_shortcut {file} { set dir [file nativename [file dirname $file]] set tail [file nativename [file tail $file]] if {![string match ".lnk" [string tolower [file extension $file]]]} { return -code error "$file is not a valid shortcut name" } if {[string match "windows" $::tcl_platform(platform)]} { # Get Shortcut file as an object set oShell [tcom::ref createobject "Shell.Application"] set oFolder [$oShell NameSpace $dir] set oFolderItem [$oFolder ParseName $tail] # If its a shortcut, get linked to file if {[$oFolderItem IsLink]} { set oShellLink [$oFolderItem GetLink] set if [tcom::info interface $oShellLink] set list [list] foreach entry [$if properties] { foreach {ptr io type name} $entry break if {[catch {lappend list $name [$oShellLink $name]}]} { lappend list $name {} } } set list } } } ---- [AF] - here is a code snippet i wrote to parse .lnk files. i lost interest when i found out how complex the format was and that i would never be able to write them. array set sizeof [list a 1 A 1 b 1 B 1 h 1 H 1 c 1 s 2 S 2 i 4 I 4 w 8 W 8] proc getdword {fh} { binary scan [read $fh 4] i tmp return $tmp } proc getword {fh} { binary scan [read $fh 2] s tmp return $tmp } proc struct {name defs} { global struct_sizes struct_defs set offset 0 set tmp {} foreach {type n} $defs { set type [string trim $type] set n [string trim $n] if {[string match string* $type]} { set len [lindex [split $type {[]}] 1] set type string } else { if {![info exists struct_sizes($type)]} { error "unknown type" } set len $struct_sizes($type) } lappend tmp [list $n $offset $type $len] incr offset $len } set struct_defs($name) [linsert $tmp 0 $offset] } proc _islnk {fh} { fconfigure $fh -encoding binary -translation binary -eofchar {} if {[getdword $fh] != "76"} { close $fh; return -code error "not a lnk file" } binary scan [read $fh 16] h32 tmp if {$tmp != "10412000000000000c00000000000064"} { close $fh; return -code error "unrecognized GUID" } return $fh } proc readlnk {lnk} { array set array {} set fh [_islnk [open $lnk r]] set array(flags) [getdword $fh] set attributes [read $fh 4] struct $fh * array(created) w array(modified) w array(acessed) w array(size) i array(icon) i array(showwnd) i array(hotkey) i res1 i res2 i if {$array(flags) & 1 > 0} { set len [getword $fh] set w1 [walkStart $fh s *] while {![walkDone $w1]} { puts [walkNext $w1] } walkEnd $w1 } set offset [tell $fh] set structlen [getdword $fh] if {$array(flags) & 2 > 0 && $structlen > 0} { struct $fh * nextstruct i flflags i lvt i lvbp i nvt i path i set nextstruct [expr {[tell $fh] + $structlen - $nextstruct}] if {($flflags & 1) > 0} { seek $fh [expr {$offset + $lvt}] start struct $fh [expr {[getdword $fh] - 4}] type i serial i noff i name a* seek $fh [expr {$offset + $lvbp}] start set base [read $fh [expr {$offset + $structlen - [tell $fh]}]] } if {($flflags & 2) > 0} { seek $fh [expr {$offset + $nvt}] start struct $fh [expr {[getdword $fh] - 4}] a i b i c i d i base a* } seek $fh [expr {$offset + $path}] start set path [read $fh [expr {$nextstruct - [tell $fh]}]] seek $fh $nextstruct start } set array(base) [string trimright $base \x00] set array(final) [string trimright $path \x00] set f 4 foreach name "comment relativepath workingdir commandline icon" { if {($array(flags) & $f) > 0} { set len [getword $fh] set array($name) [read $fh [expr {$len * 2}]] } set f [expr {$f * 2}] } return [array get array] } array set blah [readlnk $argv] parray blah if {$blah(final) == ""} { puts "--> $blah(base)" } else { puts "--> $blah(base)\\$blah(final)" } ---- Another simple way, if you have [Cygwin] ([RS]): exec ln -s /path/to/this/file that ---- [LV] What does it take to create Start menu entries from a Tcl script? What about putting a specific icon on the Windows desktop that will then launch a specific program? [MG] Nov 21 2005 - On Win XP, you can get all the info you need from the $env var: set base $env(USERPROFILE) ;# this user only set base $env(ALLUSERSPROFILE) ;# for all users # Create a folder in Start->Programs to put your shortcuts/files in.. set start_menu [file mkdir [file join $base "Start Menu" "Programs" "MyApp"]] # Get the path of the Desktop to put your files in/on... set desktop [file join $base Desktop] ---- Related information appears in "[Windows specific Tcl commands]". [Microsoft Windows and Tcl] - [Arts and crafts of Tcl-Tk programming] - [Windows shortcut]