puts stderr "fcat WARNING: apparent option $opt found after file argument(s) (expected them before filenames). Passing to fileutil::cat anyway - but for at least some versions, these options may be ignored. commandline 'fcat $args'"
}
set opt_noredirect [dict exists $received -noredirect]
if {$opt_noredirect} {
set opts [dict remove $opts -noredirect]
}
if {$::tcl_platform(platform) ne "windows"} {
return [fileutil::cat {*}$args]
}
set finalpaths [list]
set is_windows [string match *windows* $::tcl_platform(platform)]
foreach p $paths {
if {$has_winpath && [punk::winpath::illegalname_test $p]} {
if {$is_windows && $has_winpath && [punk::winpath::illegalname_test $p]} {
puts stderr "fcat WARNING: apparent option $opt found after file argument(s) (expected them before filenames). Passing to fileutil::cat anyway - but for at least some versions, these options may be ignored. commandline 'fcat $args'"
}
set opt_noredirect [dict exists $received -noredirect]
if {$opt_noredirect} {
set opts [dict remove $opts -noredirect]
}
if {$::tcl_platform(platform) ne "windows"} {
return [fileutil::cat {*}$args]
}
set finalpaths [list]
set is_windows [string match *windows* $::tcl_platform(platform)]
foreach p $paths {
if {$has_winpath && [punk::winpath::illegalname_test $p]} {
if {$is_windows && $has_winpath && [punk::winpath::illegalname_test $p]} {
#This is based on COM textual representation of GUIDS
#Apparently a CLSID is a GUID that identifies a COM object
set clsid ""
set s1 [tcl::string::range $16bytes 0 3]
set declist [scan [string reverse $s1] %c%c%c%c]
set fmt "%02X%02X%02X%02X"
append clsid [format $fmt {*}$declist]
append clsid -
set s2 [tcl::string::range $16bytes 4 5]
set declist [scan [string reverse $s2] %c%c]
set fmt "%02X%02X"
append clsid [format $fmt {*}$declist]
append clsid -
set s3 [tcl::string::range $16bytes 6 7]
set declist [scan [string reverse $s3] %c%c]
append clsid [format $fmt {*}$declist]
append clsid -
#now treat bytes individually - so no endianness conversion
set declist [scan [tcl::string::range $16bytes 8 9] %c%c]
append clsid [format $fmt {*}$declist]
append clsid -
set scan [string repeat %c 6]
set fmt [string repeat %02X 6]
set declist [scan [tcl::string::range $16bytes 10 15] $scan]
append clsid [format $fmt {*}$declist]
return $clsid
}
#offset hex:0x14 dec:20 4 bytes
#Link flags (LinkFlags) - bit field specifying information about the shell link and the presence of optional portions of the structure.
#HasLinkTargetIDList bit 0 (0x00000001) - if set, a LinkTargetIDList structure is present immediately following the header
#HasLinkInfo bit 1 (0x00000002) - if set, a LinkInfo structure is present immediately following the header (or the LinkTargetIDList if that is present)
#HasName bit 2 (0x00000004) - if set, a null-terminated string containing the name of the link is present immediately following the header (or the LinkTargetIDList and LinkInfo if they are present)
#HasRelativePath bit 3 (0x00000008) - if set, a null-terminated string containing the relative path of the link target is present immediately following the header (or the LinkTargetIDList, LinkInfo and Name if they are present)
#HasWorkingDir bit 4 (0x00000010) - if set, a null-terminated string containing the working directory of the link target is present immediately following the header (or the LinkTargetIDList, LinkInfo, Name and Relative Path if they are present)
#HasArguments bit 5 (0x00000020) - if set, a null-terminated string containing the command line arguments for the link target is present immediately following the header (or the LinkTargetIDList, LinkInfo, Name, Relative Path and Working Dir if they are present)
#HasIconLocation bit 6 (0x00000040) - if set, a null-terminated string containing the location of the icon for the link is present immediately following the header (or the LinkTargetIDList, LinkInfo, Name, Relative Path, Working Dir and Arguments if they are present)
#IsUnicode bit 7 (0x00000080) - if set, the strings in the link are stored in Unicode (UTF-16LE) format; if not set, the strings are stored in ANSI format (usually the system's default code page)
#ForceNoLinkInfo bit 8 (0x00000100) - if set, the LinkInfo structure is not stored in the file even if the HasLinkInfo bit is set; this can be used to force the link to be resolved using only the information in the header and the optional strings, without using the LinkInfo structure
#HasExpString bit 9 (0x00000200) - if set, a null-terminated string containing an "environment variable" style string is present immediately following the header (or the LinkTargetIDList, LinkInfo, Name, Relative Path, Working Dir, Arguments and Icon Location if they are present); this string can contain environment variable references (e.g. %USERPROFILE%) that can be expanded to obtain the actual path of the link target
#RunInSeparateProcess bit 10 (0x00000400) - if set, the link target should be run in a separate process; if not set, the link target may be run in the same process as the caller
#Unused1 bit 11 (0x00000800) - reserved for future use; should be set to 0
#HasDarwinID bit 12 (0x00001000) - if set, a null-terminated string containing a "Darwin ID" is present immediately following the header (or the LinkTargetIDList, LinkInfo, Name, Relative Path, Working Dir, Arguments, Icon Location and ExpString if they are present); this string can be used to identify the link target in a way that is independent of the file system (e.g. for links to Control Panel items or special folders)
#RunAsUser bit 13 (0x00002000) - if set, the link target should be run with the permissions of the user specified in the HasDarwinID string; if not set, the link target should be run with the permissions of the caller
#HasExpIcon bit 14 (0x00004000) - if set, a null-terminated string containing an "environment variable" style string for the icon location is present immediately following the header (or the LinkTargetIDList, LinkInfo, Name, Relative Path, Working Dir, Arguments, Icon Location, ExpString and DarwinID if they are present); this string can contain environment variable references that can be expanded to obtain the actual path of the icon for the link
#NoPidlAlias bit 15 (0x00008000) - if set, the link target should not be resolved using the PIDL alias mechanism; this can be used to prevent the link from being resolved to a different target if the original target is moved or renamed
#Unused2 bit 16 (0x00010000) - reserved for future use; should be set to 0
#RunWithShimLayer bit 17 (0x00020000) - if set, the link target should be run with the application compatibility shim layer; if not set, the link target should be run without the shim layer
#ForceNoLinkTrack bit 18 (0x00040000) - if set, the link target should not be tracked by the shell's link tracking mechanism; this can be used to prevent the link from being automatically updated if the target is moved or renamed
#EnableTargetMetadata bit 19 (0x00080000) - if set, the link target should have metadata enabled; this can be used to allow the link to store additional information about the target (e.g. for links to files, the link can store the file's attributes, creation time, access time and modification time)
#DisableLinkPathTracking bit 20 (0x00100000) - if set, the link target should not be tracked by the shell's link path tracking mechanism; this can be used to prevent the link from being automatically updated if the target is moved or renamed based on its path
#DisableKnownFolderTracking bit 21 (0x00200000) - if set, the link target should not be tracked by the shell's known folder tracking mechanism; this can be used to prevent the link from being automatically updated if the target is moved or renamed based on its known folder ID
#DisableKnownFolderAlias bit 22 (0x00400000) - if set, the link target should not be aliased to a known folder; this can be used to prevent the link from being resolved to a different target if the original target is moved or renamed based on its known folder ID
#AllowLinkToLink bit 23 (0x00800000) - if set, the link target can be another link; if not set, the link target should not be another link (i.e. it should be a file or directory); this can be used to prevent the link from being resolved to a different target if the original target is moved or renamed based on the fact that it is a link
#UnaliasOnSave bit 24 (0x01000000) - if set, the link should be unaliased when it is saved; this can be used to prevent the link from being resolved to a different target if the original target is moved or renamed based on the fact that it is a link
#PreferEnvironmentPath bit 25 (0x02000000) - if set, the link should prefer to resolve the target using environment variable references; this can be used to allow the link to be resolved correctly even if the target is moved or renamed, as long as the environment variable references still point to the correct location
#KeepLocalIDListForUNCTarget bit 26 (0x04000000) - if set, the link should keep the local ID list for UNC targets; this can be used to allow the link to be resolved correctly even if the target is moved or renamed, as long as the local ID list still points to the correct location
# - the presence of these flags indicates the presence of optional structures in the .lnk file and also provides information about how to interpret the data in the file
proc Header_Get_LinkFlags {contents} {
set 4bytes [string range $contents 20 23]
set r [binary scan $4bytes i val] ;# i for little endian 32-bit signed int
return $val
}
#offset hex:0x18 dec:24 4 bytes
#File attributes (FileAttributes) - bit field specifying the file attributes of the link target (if the EnableTargetMetadata flag is set in the LinkFlags field); this field is a bitwise combination of the following values:
proc Header_Get_FileAttributes {contents} {
if {![Header_Has_LinkFlag $contents "EnableTargetMetadata"]} {
return {}
}
set 4bytes [string range $contents 24 27]
set r [binary scan $4bytes i val] ;# i for little endian 32-bit signed int
set attrlist {}
if {$val & 0x00000001} {lappend attrlist "READONLY"}
if {$val & 0x00000002} {lappend attrlist "HIDDEN"}
if {$val & 0x00000004} {lappend attrlist "SYSTEM"}
if {$val & 0x00000010} {lappend attrlist "DIRECTORY"}
if {$val & 0x00000020} {lappend attrlist "ARCHIVE"}
if {$val & 0x00000040} {lappend attrlist "DEVICE"}
if {$val & 0x00000080} {lappend attrlist "NORMAL"}
if {$val & 0x00000100} {lappend attrlist "TEMPORARY"}
if {$val & 0x00000200} {lappend attrlist "SPARSE_FILE"}
if {$val & 0x00000400} {lappend attrlist "REPARSE_POINT"}
if {$val & 0x00000800} {lappend attrlist "COMPRESSED"}
if {$val & 0x00001000} {lappend attrlist "OFFLINE"}
if {$val & 0x00002000} {lappend attrlist "NOT_CONTENT_INDEXED"}
if {$val & 0x00004000} {lappend attrlist "ENCRYPTED"}
return $attrlist
}
proc Header_Get_FileAttributes_Raw {contents} {
if {![Header_Has_LinkFlag $contents "EnableTargetMetadata"]} {
return 0
}
set 4bytes [string range $contents 24 27]
set r [binary scan $4bytes i val] ;# i for little endian 32-bit signed int
return $val
}
#offset hex:0x1C dec:28 8 bytes
#creation date and time (CreationTime) (FILETIME structure - 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601 (UTC))
proc Header_Get_CreationTime {contents} {
set 8bytes [string range $contents 28 35]
set r [binary scan $8bytes w val] ;# w for little endian 64-bit signed int
#convert FILETIME to human readable format - this is a bit complex because FILETIME is in 100-nanosecond intervals since January 1, 1601 (UTC)
#we can convert it to seconds and then to a human readable format
set seconds [expr {$val / 10000000.0}]
set epoch_seconds [expr {round($seconds) - 11644473600}] ;# number of seconds between January 1, 1601 and January 1, 1970
set human_time [clock format $epoch_seconds -format "%Y-%m-%d %H:%M:%S" -gmt true]
return $human_time
}
proc Header_Get_CreationTime_Raw {contents} {
set 8bytes [string range $contents 28 35]
set r [binary scan $8bytes w val] ;# w for little endian 64-bit signed int
return $val
}
#offset 36 8 bytes
#last access date and time
#last access date and time (AccessTime) (FILETIME structure - 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601 (UTC))
proc Header_Get_AccessTime {contents} {
set 8bytes [string range $contents 36 43]
set r [binary scan $8bytes w val] ;# w for little endian 64-bit signed int
#convert FILETIME to human readable format - this is a bit complex because FILETIME is in 100-nanosecond intervals since January 1, 1601 (UTC)
#we can convert it to seconds and then to a human readable format
set seconds [expr {$val / 10000000.0}]
set epoch_seconds [expr {round($seconds) - 11644473600}] ;# number of seconds between January 1, 1601 and January 1, 1970
set human_time [clock format $epoch_seconds -format "%Y-%m-%d %H:%M:%S" -gmt true]
return $human_time
}
proc Header_Get_AccessTime_Raw {contents} {
set 8bytes [string range $contents 36 43]
set r [binary scan $8bytes w val] ;# w for little endian 64-bit signed int
return $val
}
#offset 44 8 bytes
#last modification date and time
#offset hex:0x2C dec:44 8 bytes
#last modification date and time (WriteTime) (FILETIME structure - 64-bit value representing the number of 100-nanosecond intervals since January 1, 1601 (UTC))
proc Header_Get_WriteTime {contents} {
set 8bytes [string range $contents 44 51]
set r [binary scan $8bytes w val] ;# w for little endian 64-bit signed int
#convert FILETIME to human readable format - this is a bit complex because FILETIME is in 100-nanosecond intervals since January 1, 1601 (UTC)
#we can convert it to seconds and then to a human readable format
set seconds [expr {$val / 10000000.0}]
set epoch_seconds [expr {round($seconds) - 11644473600}] ;# number of seconds between January 1, 1601 and January 1, 1970
set human_time [clock format $epoch_seconds -format "%Y-%m-%d %H:%M:%S" -gmt true]
return $human_time
}
proc Header_Get_WriteTime_Raw {contents} {
set 8bytes [string range $contents 44 51]
set r [binary scan $8bytes w val] ;# w for little endian 64-bit signed int
return $val
}
#offset 52 4 bytes - unsigned int
#file size in bytes (of target)
proc Get_FileSize {contents} {
#offset hex:0x34 dec:52 Bytes:4 - unsigned int
#file size in bytes (of target - low 32 bits if >4GB)
#Should move to home position and reset ansi SGR when no save data available
#puts stderr "overtype::renderspace cursor_restore without save data available"
}
#If we were inserting prior to hitting the cursor_restore - there could be overflow_right data - generally the overtype functions aren't for inserting - but ansi can enable it
puts stderr "fcat WARNING: apparent option $opt found after file argument(s) (expected them before filenames). Passing to fileutil::cat anyway - but for at least some versions, these options may be ignored. commandline 'fcat $args'"
}
set opt_noredirect [dict exists $received -noredirect]
if {$opt_noredirect} {
set opts [dict remove $opts -noredirect]
}
if {$::tcl_platform(platform) ne "windows"} {
return [fileutil::cat {*}$args]
}
set finalpaths [list]
set is_windows [string match *windows* $::tcl_platform(platform)]
foreach p $paths {
if {$has_winpath && [punk::winpath::illegalname_test $p]} {
if {$is_windows && $has_winpath && [punk::winpath::illegalname_test $p]} {
#Should move to home position and reset ansi SGR when no save data available
#puts stderr "overtype::renderspace cursor_restore without save data available"
}
#If we were inserting prior to hitting the cursor_restore - there could be overflow_right data - generally the overtype functions aren't for inserting - but ansi can enable it
puts stderr "fcat WARNING: apparent option $opt found after file argument(s) (expected them before filenames). Passing to fileutil::cat anyway - but for at least some versions, these options may be ignored. commandline 'fcat $args'"
}
set opt_noredirect [dict exists $received -noredirect]
if {$opt_noredirect} {
set opts [dict remove $opts -noredirect]
}
if {$::tcl_platform(platform) ne "windows"} {
return [fileutil::cat {*}$args]
}
set finalpaths [list]
set is_windows [string match *windows* $::tcl_platform(platform)]
foreach p $paths {
if {$has_winpath && [punk::winpath::illegalname_test $p]} {
if {$is_windows && $has_winpath && [punk::winpath::illegalname_test $p]} {
