Nothing
R/readWindowsShortcut.R
In R.utils: Various Programming Utilities
###########################################################################/**
# @RdocDefault readWindowsShortcut
#
# @title "Reads a Microsoft Windows Shortcut (.lnk file)"
#
# @synopsis
#
# \description{
# @get "title".
# }
#
# \arguments{
# \item{con}{A @connection or a @character string (filename).}
# \item{verbose}{If @TRUE, extra information is written while reading.}
# \item{...}{Not used.}
# }
#
# \value{
# Returns a @list structure.
# }
#
# @examples "../incl/readWindowsShortcut.Rex"
#
# \details{
# The MIME type for a Windows Shortcut file is
# \code{application/x-ms-shortcut}.
# }
#
# @author
#
# \seealso{
# @see "createWindowsShortcut" and
# \code{\link{filePath}()}
# }
#
# \references{
# [1] Wotsit's Format, \url{http://www.wotsit.org/}, 2005.\cr
# [2] Hager J, \emph{The Windows Shortcut File Format}
# (as reverse-engineered by), version 1.0.\cr
# [3] Microsoft Developer Network, \emph{IShellLink Interface}, 2018.
# \url{https://learn.microsoft.com/en-us/windows/win32/api/shobjidl_core/nn-shobjidl_core-ishelllinka} \cr
# [4] Andrews D, \emph{Parsing Windows Shortcuts (lnk) files in java},
# comp.lang.java.help, Aug 1999.
# \url{https://groups.google.com/d/topic/comp.lang.java.help/ouFHsH1UgKI} \cr
# [5] Multiple authors, \emph{Windows shell links} (in Tcl), Tcler's Wiki,
# April 2008. \url{https://wiki.tcl-lang.org/1844} \cr
# [6] Daniel S. Bensen, \emph{Shortcut File Format (.lnk)}, Stdlib.com,
# April 24, 2009. \cr
# \url{https://web.archive.org/web/20110817051855/http://www.stdlib.com/art6-Shortcut-File-Format-lnk.html} (was http://www.stdlib.com/art6-Shortcut-File-Format-lnk.html)\cr
# [7] [MS-SHLLINK]: Shell Link (.LNK) Binary File Format, Microsoft Inc.,
# September 25, 2009. \cr
# }
#
# @keyword file
# @keyword IO
#*/###########################################################################
# MORE REFERENCES:
# An Unofficial Guide to the URL File Format, \url{http://www.cyanwerks.com/file-format-url.html} (contains info about Hotkeys)
# xxmklink - create a shortcut, http://www.xxcopy.com/xxcopy38.htm
# FILExt, \url{https://filext.com/file-extension/LNK}, 2005.
setMethodS3("readWindowsShortcut", "default", function(con, verbose=FALSE, ...) {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Local functions
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# dword - An 4-byte unsigned integer
readByte <- function(con, n=1) {
readBin(con=con, what=integer(), size=1, n=n,
signed=FALSE, endian="little")
}
# word - A 2-byte unsigned integer
readWord <- function(con, n=1) {
readBin(con=con, what=integer(), size=2, n=n,
signed=FALSE, endian="little")
}
# qword - A 4-byte unsigned integer (actually as signed integer)
readDWord <- function(con, n=1) {
readBin(con=con, what=integer(), size=4, n=n,
signed=TRUE, endian="little")
}
# qword - An 8-byte unsigned integer (actually as signed integer)
readQWord <- function(con, n=1) {
readBin(con=con, what=integer(), size=8, n=n,
signed=TRUE, endian="little")
}
readString <- function(con, nchars=-1, unicoded=FALSE) {
if (nchars == -1) {
bfr <- c()
while ((byte <- readByte(con)) != 0) {
bfr <- c(bfr, byte)
}
} else {
if (unicoded)
nchars <- 2*nchars
bfr <- readByte(con, n=nchars)
}
# Since R does not support Unicoded strings, we (incorrectly) assume
# (=hope) that it is only the unicode characters 0:255 that are used.
if (unicoded)
bfr <- bfr[bfr != 0]
paste(intToChar(bfr), collapse="")
} # readString()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'con':
if (is.character(con)) {
con <- file(con, open="")
}
if (inherits(con, "connection")) {
if (!isOpen(con)) {
open(con, open="rb")
on.exit({
if (inherits(con, "connection") && isOpen(con))
close(con)
})
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# File header
# Shell item ID list
# Item 1
# Item 2
# etc..
# File locator info
# Local path
# Network path
# Description string
# Relative path string
# Working directory string
# Command line string
# Icon filename string
# Extra stuff
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# File header
#
# Offset Size/Type Contents
# -------------------------
# 0h 1 dword Always 0000004Ch 'L'
# 4h 16 bytes GUID of shortcut files
# 14h 1 dword Flags
# 18h 1 dword File attributes
# 1Ch 1 qword Time 1
# 24h 1 qword Time 2
# 2Ch 1 qword Time 3
# 34h 1 dword File length
# 38h 1 dword Icon number
# 3Ch 1 dword ShowWnd value
# 40h 1 dword Hot key
# 44h 2 dwords Unknown, always zero
#
# The first 4 bytes of the file form a long integer that is always set
# to 4Ch this it the ASCII value for the uppercase letter L. This is used
# to identify a valid shell link file.
#
# Identifying Characters (in hex):
# [ magic ] [ GUID ]
# 4C 00 00 00 01 14 02 00 00 00 00 00 C0 00 00 00 00 00 00 46
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
header <- list(
magic = readDWord(con),
guid = readByte(con, n=16),
flags = readDWord(con),
fileAttributes = readDWord(con),
creationTime = readQWord(con),
modificationTime = readQWord(con),
lastAccessTime = readQWord(con),
fileLength = readDWord(con),
iconNumber = readDWord(con),
showWndValue = readDWord(con),
hotKey = readDWord(con),
unknown = readDWord(con, n=2)
)
if (verbose) {
message("File header read:")
message(paste(capture.output(header), collapse="\n"))
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Assert and parse header
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (header$magic != 76) {
stop("File format error: Magic dword in header is not 0000004C (76): ", header$magic)
}
knownGuid <- c(1,20,2,0,0,0,0,0,192,0,0,0,0,0,0,70)
if (!all.equal(header$guid, knownGuid)) {
stop("File format error: Unknown GUID: ", paste(header$guid, collapse=","))
}
flags <- intToBin(header$flags)
flags <- rev(strsplit(flags, split="")[[1]])
flags <- as.integer(flags)
flags <- as.logical(flags)
knownFlagNames <- c("hasShellItemIdList", "pointsToFileOrDirectory", "hasDescription", "hasRelativePath", "hasWorkingDirectory", "hasCommandLineArguments", "hasCustomIcon", "unicodedStrings")
if (length(flags) <= length(knownFlagNames)) {
flags <- c(flags, rep(FALSE, length.out=length(knownFlagNames)-length(flags)))
names(flags) <- knownFlagNames
} else {
extraFlags <- sprintf("unknown%d", 1:(length(flags)-length(knownFlagNames)))
names(flags) <- c(knownFlagNames, extraFlags)
if (!is.element(length(extraFlags), c(0,2))) {
warning("Detected a possibly unsupported file format: There are unknown 'flags' in the Windows Shortcut link file: ", paste(paste(names(flags), flags, sep="="), collapse=", "))
}
}
header$flags <- flags
if (header$flags["pointsToFileOrDirectory"]) {
fileAttributes <- intToBin(header$fileAttributes)
fileAttributes <- rev(strsplit(fileAttributes, split="")[[1]])
fileAttributes <- as.logical(as.integer(fileAttributes))
if (length(fileAttributes) > 13)
stop("File format error: Too many bits in flags in header: ", length(fileAttributes))
fileAttributes <- c(fileAttributes, rep(FALSE, length.out=13-length(fileAttributes)))
names(fileAttributes) <- c("isReadOnly", "isHidden", "isSystemFile", "isVolumeLabel", "isDirectory", "isModifiedSinceLastBackup", "isEncrypted", "isNormal", "isTemporary", "isSparseFile", "hasReparsePointData", "isCompressed", "isOffline")
header$fileAttributes <- fileAttributes
} else {
# "If the target is not a file (see flags bit 1), then this is set
# to zero."
if (!all(header$fileAttributes == 0)) {
stop("File format error: When shortcut is not pointing to a file or a directory all file attributes should be zero.")
}
header$fileAttributes <- NA
}
if (header$fileLength < 0) {
stop("File format error: File length is negative: ", header$fileLength)
}
if (header$flags["hasCustomIcon"]) {
} else {
if (header$iconNumber != 0)
stop("File format error: Expected zero icon number: ", header$iconNumber)
}
swNames <- c("SW_HIDE", "SW_NORMAL", "SW_SHOWMINIMIZED", "SW_SHOWMAXIMIZED", "SW_SHOWNOACTIVATE", "SW_SHOW", "SW_MINIMIZE", "SW_SHOWMINNOACTIVE", "SW_SHOWNA", "SW_RESTORE", "SW_SHOWDEFAULT")
if (header$showWndValue %in% 0:10) {
names(header$showWndValue) <- swNames[header$showWndValue+1]
} else {
stop("File format error: showWndValue in header is out of range [0:10]: ", header$showWndValue)
}
if (!all(header$unknown == 0)) {
stop("File format error: Last 2 dwords in header are not zero: ", header$unknown, sep="")
}
lnk <- list(header=header)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The Shell Item Id List
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (header$flags["hasShellItemIdList"]) {
bytesToRead <- readWord(con)
if (verbose) {
message("bytesToRead=", bytesToRead)
}
dummy <- readByte(con, n=bytesToRead)
bytesToRead <- 0
while(bytesToRead > 0) {
itemLength <- readWord(con)
if (verbose) {
message("itemLength=", itemLength)
}
bytesToRead <- bytesToRead-2
item <- readByte(con, n=itemLength-2)
print(paste(intToChar(item), collapse=""))
str(item)
bytesToRead <- bytesToRead-itemLength
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# File Location Info
#
# Offset Size Contents
# 0h 1 dword This is the total length of this structure and all
# following data
# 4h 1 dword This is a pointer to first offset after this
# structure. 1Ch
# 8h 1 dword Flags
# Ch 1 dword Offset of local volume info
# 10h 1 dword Offset of base pathname on local system
# 14h 1 dword Offset of network volume info
# 18h 1 dword Offset of remaining pathname
#
# Notes: The first length value includes all the assorted pathnames and
# other data structures. All offsets are relative to the start of this
# structure.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (header$flags["pointsToFileOrDirectory"]) {
fileLocationInfo <- list(
length = readDWord(con),
firstOffset = readDWord(con),
flags = readDWord(con),
offsetLocalVolumeInfo = readDWord(con),
offsetBasePathname = readDWord(con),
offsetNetworkVolumeInfo = readDWord(con),
offsetRemainingPathname = readDWord(con),
.offset = 7*4 # Current read position
)
# Set current offset
if (fileLocationInfo$flags %in% 0:3) {
} else {
stop("File format error: Unknown volume flag: ", fileLocationInfo$flags)
}
flags <- intToBin(fileLocationInfo$flags)
flags <- rev(strsplit(flags, split="")[[1]])
flags <- as.logical(as.integer(flags))
flags <- c(flags, rep(FALSE, length.out=2-length(flags)))
names(flags) <- c("availableOnLocalVolume", "availableOnNetworkShare")
fileLocationInfo$flags <- flags
if (fileLocationInfo$flags["availableOnLocalVolume"] != TRUE) {
"Random garbage when bit 0 is clear in volume flags" [1]
# fileLocationInfo$offsetLocalVolumeInfo <- NA
# fileLocationInfo$offsetBasePathname <- NA
}
if (fileLocationInfo$flags["availableOnNetworkShare"] != TRUE) {
"Random garbage when bit 1 is clear in volume flags" [1]
# fileLocationInfo$offsetNetworkVolumeInfo <- NA
}
if (fileLocationInfo$firstOffset != fileLocationInfo$.offset) {
warning("File format warning: First offset in File Location Info is not 0x1C (28): ", fileLocationInfo$firstOffset)
# Skip to first offset
skip <- fileLocationInfo$firstOffset-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
}
if (verbose) {
message("File location info:")
message(paste(capture.output(fileLocationInfo), collapse="\n"))
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The local volume table
#
# Offset Size Contents
# 0h 1 dword Length of this structure.
# 4h 1 dword Type of volume
# 8h 1 dword Volume serial number
# Ch 1 dword Offset of the volume name (Always 10h)
# 10h ASCIZ Volume label
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (fileLocationInfo$flags["availableOnLocalVolume"]) {
if (verbose) {
message("availableOnLocalVolume...")
}
# Skip to local volume table
skip <- fileLocationInfo$offsetLocalVolumeInfo-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
table <- list(
length = readDWord(con),
typeOfVolume = readDWord(con),
volumeSerialNumber = readDWord(con),
offsetName = readDWord(con),
volumeLabel = "", # To be read
.offset = 4*4
)
if (table$typeOfVolume %in% 0:6) {
names(table$typeOfVolume) <- c("Unknown", "No root directory", "Removable", "Fixed", "Remote", "CD-ROM", "Ram drive")[table$typeOfVolume+1]
} else {
stop("File format error: Unknown type of volume: ", table$typeOfVolume)
}
if (table$offsetName != table$.offset) {
warning("File format warning: Offset to volume name in Local Volume Table is not 0x10 (16): ", table$offsetName)
# Skip to volume label
skip <- table$offsetName-table$.offset
readBin(con, what=integer(), size=1, n=skip)
table$.offset <- table$.offset + skip
}
table$volumeLabel <- readString(con)
table$.offset <- table$.offset + nchar(table$volumeLabel, type="chars") + 1
if (table$.offset != table$length) {
stop("File format error: Length of structure did not match the number of bytes read.")
}
# Update the offset for file location info
fileLocationInfo$.offset <- fileLocationInfo$.offset + table$.offset
# Remove obsolete information
table$length <- NULL
table$offsetName <- NULL
table$.offset <- NULL
fileLocationInfo$localVolumeTable <- table
if (verbose) {
message("File location info / Local Volume Table:")
message(paste(capture.output(fileLocationInfo$localVolumeTable), collapse="\n"))
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The base pathname on local system
#
# "To find the filename of the file on the local volume, combine the
# base path string and the final path string." [1]
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Skip to base pathname
skip <- fileLocationInfo$offsetBasePathname-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
fileLocationInfo$basePathname <- readString(con)
fileLocationInfo$.offset <- fileLocationInfo$.offset +
nchar(fileLocationInfo$basePathname, type="chars") + 1
if (verbose) {
message("basePathname='", fileLocationInfo$basePathname, "'")
message("availableOnLocalVolume...done")
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The network volume table
#
# Offset Size Contents
# 0h 1 dword Length of this structure
# 4h 1 dword Unknown, always 2h?
# 8h 1 dword Offset of network share name (Always 14h)
# Ch 1 dword Unknown, always zero?
# 10h 1 dword Unknown, always 20000h?
# 14h ASCIZ Network share name
#
# Note 1: The above unknown values are the same for a printer or file
# share.
# Note 2: The above values are for Microsoft Networks, I don't have a
# NetWare server to test.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (fileLocationInfo$flags["availableOnNetworkShare"]) {
if (verbose) {
message("availableOnNetworkShare...")
}
# Skip to local volume table
skip <- fileLocationInfo$offsetNetworkVolumeInfo-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
table <- list(
length = readDWord(con),
unknown1 = readDWord(con),
offsetName = readDWord(con),
unknown2 = readDWord(con),
unknown3 = readDWord(con),
networkShareName = "", # To be read
.offset = 5*4
)
if (table$offsetName != table$.offset) {
warning("File format warning: Offset to network share name in Network Volume Table is not 0x14 (20): ", table$offsetName)
# Skip to volume label
readBin(con, what=integer(), size=1, n=table$offsetName-table$.offset)
}
table$networkShareName <- readString(con)
table$.offset <- table$.offset + nchar(table$networkShareName, type="chars") + 1
if (verbose) {
message("File location info / Network Volume Table:")
message(paste(capture.output(table), collapse="\n"))
}
# if (table$.offset != table$length) {
if (table$.offset != table$unknown2) {
warning("File format warning: Length of table structure did not match the number of bytes read: ", table$.offset, " != ", table$unknown2)
}
# Update the offset for file location info
fileLocationInfo$.offset <- fileLocationInfo$.offset + table$.offset
# Remove obsolete information
table$length <- NULL
table$offsetName <- NULL
table$unknown1 <- table$unknown2 <- table$unknown3 <- NULL
table$.offset <- NULL
fileLocationInfo$networkVolumeTable <- table
if (verbose) {
message("File location info / Network Volume Table:")
message(paste(capture.output(fileLocationInfo$networkVolumeTable), collapse="\n"))
message("availableOnNetworkShare...done")
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The remaining pathname on network system
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Skip to remaining pathname
skip <- fileLocationInfo$offsetRemainingPathname-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
fileLocationInfo$remainingPathname <- readString(con)
fileLocationInfo$.offset <- fileLocationInfo$.offset +
nchar(fileLocationInfo$remainingPathname, type="chars") + 1
if (fileLocationInfo$length != fileLocationInfo$.offset) {
stop("File format error: Expected to read ", fileLocationInfo$length, " bytes in File Location Info structure, but read ", fileLocationInfo$.offset)
}
# Remove obsolete information
fileLocationInfo$length <- NULL
fileLocationInfo$firstOffset <- NULL
fileLocationInfo$offsetBasePathname <- NULL
fileLocationInfo$offsetLocalVolumeInfo <- NULL
fileLocationInfo$offsetNetworkVolumeInfo <- NULL
fileLocationInfo$offsetRemainingPathname <- NULL
fileLocationInfo$.offset <- NULL
lnk$fileLocationInfo <- fileLocationInfo
} else {
lnk$fileLocationInfo <- NA
} # if (header$flags["pointsToFileOrDirectory"])
unicoded <- header$flags["unicodedStrings"]
if (header$flags["hasDescription"]) {
nchars <- readWord(con)
lnk$description <- readString(con, nchars=nchars, unicoded=unicoded)
}
if (header$flags["hasRelativePath"]) {
nchars <- readWord(con)
lnk$relativePath <- readString(con, nchars=nchars, unicoded=unicoded)
}
if (header$flags["hasWorkingDirectory"]) {
nchars <- readWord(con)
lnk$workingDirectory <- readString(con, nchars=nchars, unicoded=unicoded)
}
if (header$flags["hasCommandLineArguments"]) {
nchars <- readWord(con)
lnk$commandLineArguments <- readString(con, nchars=nchars, unicoded=unicoded)
}
if (header$flags["hasCustomIcon"]) {
nbytes <- readWord(con)
lnk$iconFilename <- readString(con, nchars=nchars, unicoded=unicoded)
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# For convenience
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
value <- lnk$relativePath
if (!is.null(value)) {
lnk$relativePathname <- value
}
if (header$flags["pointsToFileOrDirectory"]) {
if (lnk$fileLocationInfo$flags["availableOnLocalVolume"]) {
lnk$pathname <- paste(lnk$fileLocationInfo$basePathname,
lnk$fileLocationInfo$remainingPathname, sep="")
}
if (lnk$fileLocationInfo$flags["availableOnNetworkShare"]) {
lnk$networkPathname <-
paste(lnk$fileLocationInfo$networkVolumeTable$networkShareName,
"\\", lnk$fileLocationInfo$remainingPathname, sep="")
}
} # if (header$flags["pointsToFileOrDirectory"])
lnk
}) # readWindowsShortcut()
Try the R.utils package in your browser
Any scripts or data that you put into this service are public.
R.utils documentation built on Nov. 18, 2023, 1:09 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
###########################################################################/**
# @RdocDefault readWindowsShortcut
#
# @title "Reads a Microsoft Windows Shortcut (.lnk file)"
#
# @synopsis
#
# \description{
# @get "title".
# }
#
# \arguments{
# \item{con}{A @connection or a @character string (filename).}
# \item{verbose}{If @TRUE, extra information is written while reading.}
# \item{...}{Not used.}
# }
#
# \value{
# Returns a @list structure.
# }
#
# @examples "../incl/readWindowsShortcut.Rex"
#
# \details{
# The MIME type for a Windows Shortcut file is
# \code{application/x-ms-shortcut}.
# }
#
# @author
#
# \seealso{
# @see "createWindowsShortcut" and
# \code{\link{filePath}()}
# }
#
# \references{
# [1] Wotsit's Format, \url{http://www.wotsit.org/}, 2005.\cr
# [2] Hager J, \emph{The Windows Shortcut File Format}
# (as reverse-engineered by), version 1.0.\cr
# [3] Microsoft Developer Network, \emph{IShellLink Interface}, 2018.
# \url{https://learn.microsoft.com/en-us/windows/win32/api/shobjidl_core/nn-shobjidl_core-ishelllinka} \cr
# [4] Andrews D, \emph{Parsing Windows Shortcuts (lnk) files in java},
# comp.lang.java.help, Aug 1999.
# \url{https://groups.google.com/d/topic/comp.lang.java.help/ouFHsH1UgKI} \cr
# [5] Multiple authors, \emph{Windows shell links} (in Tcl), Tcler's Wiki,
# April 2008. \url{https://wiki.tcl-lang.org/1844} \cr
# [6] Daniel S. Bensen, \emph{Shortcut File Format (.lnk)}, Stdlib.com,
# April 24, 2009. \cr
# \url{https://web.archive.org/web/20110817051855/http://www.stdlib.com/art6-Shortcut-File-Format-lnk.html} (was http://www.stdlib.com/art6-Shortcut-File-Format-lnk.html)\cr
# [7] [MS-SHLLINK]: Shell Link (.LNK) Binary File Format, Microsoft Inc.,
# September 25, 2009. \cr
# }
#
# @keyword file
# @keyword IO
#*/###########################################################################
# MORE REFERENCES:
# An Unofficial Guide to the URL File Format, \url{http://www.cyanwerks.com/file-format-url.html} (contains info about Hotkeys)
# xxmklink - create a shortcut, http://www.xxcopy.com/xxcopy38.htm
# FILExt, \url{https://filext.com/file-extension/LNK}, 2005.
setMethodS3("readWindowsShortcut", "default", function(con, verbose=FALSE, ...) {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Local functions
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# dword - An 4-byte unsigned integer
readByte <- function(con, n=1) {
readBin(con=con, what=integer(), size=1, n=n,
signed=FALSE, endian="little")
}
# word - A 2-byte unsigned integer
readWord <- function(con, n=1) {
readBin(con=con, what=integer(), size=2, n=n,
signed=FALSE, endian="little")
}
# qword - A 4-byte unsigned integer (actually as signed integer)
readDWord <- function(con, n=1) {
readBin(con=con, what=integer(), size=4, n=n,
signed=TRUE, endian="little")
}
# qword - An 8-byte unsigned integer (actually as signed integer)
readQWord <- function(con, n=1) {
readBin(con=con, what=integer(), size=8, n=n,
signed=TRUE, endian="little")
}
readString <- function(con, nchars=-1, unicoded=FALSE) {
if (nchars == -1) {
bfr <- c()
while ((byte <- readByte(con)) != 0) {
bfr <- c(bfr, byte)
}
} else {
if (unicoded)
nchars <- 2*nchars
bfr <- readByte(con, n=nchars)
}
# Since R does not support Unicoded strings, we (incorrectly) assume
# (=hope) that it is only the unicode characters 0:255 that are used.
if (unicoded)
bfr <- bfr[bfr != 0]
paste(intToChar(bfr), collapse="")
} # readString()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Validate arguments
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Argument 'con':
if (is.character(con)) {
con <- file(con, open="")
}
if (inherits(con, "connection")) {
if (!isOpen(con)) {
open(con, open="rb")
on.exit({
if (inherits(con, "connection") && isOpen(con))
close(con)
})
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# File header
# Shell item ID list
# Item 1
# Item 2
# etc..
# File locator info
# Local path
# Network path
# Description string
# Relative path string
# Working directory string
# Command line string
# Icon filename string
# Extra stuff
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# File header
#
# Offset Size/Type Contents
# -------------------------
# 0h 1 dword Always 0000004Ch 'L'
# 4h 16 bytes GUID of shortcut files
# 14h 1 dword Flags
# 18h 1 dword File attributes
# 1Ch 1 qword Time 1
# 24h 1 qword Time 2
# 2Ch 1 qword Time 3
# 34h 1 dword File length
# 38h 1 dword Icon number
# 3Ch 1 dword ShowWnd value
# 40h 1 dword Hot key
# 44h 2 dwords Unknown, always zero
#
# The first 4 bytes of the file form a long integer that is always set
# to 4Ch this it the ASCII value for the uppercase letter L. This is used
# to identify a valid shell link file.
#
# Identifying Characters (in hex):
# [ magic ] [ GUID ]
# 4C 00 00 00 01 14 02 00 00 00 00 00 C0 00 00 00 00 00 00 46
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
header <- list(
magic = readDWord(con),
guid = readByte(con, n=16),
flags = readDWord(con),
fileAttributes = readDWord(con),
creationTime = readQWord(con),
modificationTime = readQWord(con),
lastAccessTime = readQWord(con),
fileLength = readDWord(con),
iconNumber = readDWord(con),
showWndValue = readDWord(con),
hotKey = readDWord(con),
unknown = readDWord(con, n=2)
)
if (verbose) {
message("File header read:")
message(paste(capture.output(header), collapse="\n"))
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Assert and parse header
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (header$magic != 76) {
stop("File format error: Magic dword in header is not 0000004C (76): ", header$magic)
}
knownGuid <- c(1,20,2,0,0,0,0,0,192,0,0,0,0,0,0,70)
if (!all.equal(header$guid, knownGuid)) {
stop("File format error: Unknown GUID: ", paste(header$guid, collapse=","))
}
flags <- intToBin(header$flags)
flags <- rev(strsplit(flags, split="")[[1]])
flags <- as.integer(flags)
flags <- as.logical(flags)
knownFlagNames <- c("hasShellItemIdList", "pointsToFileOrDirectory", "hasDescription", "hasRelativePath", "hasWorkingDirectory", "hasCommandLineArguments", "hasCustomIcon", "unicodedStrings")
if (length(flags) <= length(knownFlagNames)) {
flags <- c(flags, rep(FALSE, length.out=length(knownFlagNames)-length(flags)))
names(flags) <- knownFlagNames
} else {
extraFlags <- sprintf("unknown%d", 1:(length(flags)-length(knownFlagNames)))
names(flags) <- c(knownFlagNames, extraFlags)
if (!is.element(length(extraFlags), c(0,2))) {
warning("Detected a possibly unsupported file format: There are unknown 'flags' in the Windows Shortcut link file: ", paste(paste(names(flags), flags, sep="="), collapse=", "))
}
}
header$flags <- flags
if (header$flags["pointsToFileOrDirectory"]) {
fileAttributes <- intToBin(header$fileAttributes)
fileAttributes <- rev(strsplit(fileAttributes, split="")[[1]])
fileAttributes <- as.logical(as.integer(fileAttributes))
if (length(fileAttributes) > 13)
stop("File format error: Too many bits in flags in header: ", length(fileAttributes))
fileAttributes <- c(fileAttributes, rep(FALSE, length.out=13-length(fileAttributes)))
names(fileAttributes) <- c("isReadOnly", "isHidden", "isSystemFile", "isVolumeLabel", "isDirectory", "isModifiedSinceLastBackup", "isEncrypted", "isNormal", "isTemporary", "isSparseFile", "hasReparsePointData", "isCompressed", "isOffline")
header$fileAttributes <- fileAttributes
} else {
# "If the target is not a file (see flags bit 1), then this is set
# to zero."
if (!all(header$fileAttributes == 0)) {
stop("File format error: When shortcut is not pointing to a file or a directory all file attributes should be zero.")
}
header$fileAttributes <- NA
}
if (header$fileLength < 0) {
stop("File format error: File length is negative: ", header$fileLength)
}
if (header$flags["hasCustomIcon"]) {
} else {
if (header$iconNumber != 0)
stop("File format error: Expected zero icon number: ", header$iconNumber)
}
swNames <- c("SW_HIDE", "SW_NORMAL", "SW_SHOWMINIMIZED", "SW_SHOWMAXIMIZED", "SW_SHOWNOACTIVATE", "SW_SHOW", "SW_MINIMIZE", "SW_SHOWMINNOACTIVE", "SW_SHOWNA", "SW_RESTORE", "SW_SHOWDEFAULT")
if (header$showWndValue %in% 0:10) {
names(header$showWndValue) <- swNames[header$showWndValue+1]
} else {
stop("File format error: showWndValue in header is out of range [0:10]: ", header$showWndValue)
}
if (!all(header$unknown == 0)) {
stop("File format error: Last 2 dwords in header are not zero: ", header$unknown, sep="")
}
lnk <- list(header=header)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The Shell Item Id List
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (header$flags["hasShellItemIdList"]) {
bytesToRead <- readWord(con)
if (verbose) {
message("bytesToRead=", bytesToRead)
}
dummy <- readByte(con, n=bytesToRead)
bytesToRead <- 0
while(bytesToRead > 0) {
itemLength <- readWord(con)
if (verbose) {
message("itemLength=", itemLength)
}
bytesToRead <- bytesToRead-2
item <- readByte(con, n=itemLength-2)
print(paste(intToChar(item), collapse=""))
str(item)
bytesToRead <- bytesToRead-itemLength
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# File Location Info
#
# Offset Size Contents
# 0h 1 dword This is the total length of this structure and all
# following data
# 4h 1 dword This is a pointer to first offset after this
# structure. 1Ch
# 8h 1 dword Flags
# Ch 1 dword Offset of local volume info
# 10h 1 dword Offset of base pathname on local system
# 14h 1 dword Offset of network volume info
# 18h 1 dword Offset of remaining pathname
#
# Notes: The first length value includes all the assorted pathnames and
# other data structures. All offsets are relative to the start of this
# structure.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (header$flags["pointsToFileOrDirectory"]) {
fileLocationInfo <- list(
length = readDWord(con),
firstOffset = readDWord(con),
flags = readDWord(con),
offsetLocalVolumeInfo = readDWord(con),
offsetBasePathname = readDWord(con),
offsetNetworkVolumeInfo = readDWord(con),
offsetRemainingPathname = readDWord(con),
.offset = 7*4 # Current read position
)
# Set current offset
if (fileLocationInfo$flags %in% 0:3) {
} else {
stop("File format error: Unknown volume flag: ", fileLocationInfo$flags)
}
flags <- intToBin(fileLocationInfo$flags)
flags <- rev(strsplit(flags, split="")[[1]])
flags <- as.logical(as.integer(flags))
flags <- c(flags, rep(FALSE, length.out=2-length(flags)))
names(flags) <- c("availableOnLocalVolume", "availableOnNetworkShare")
fileLocationInfo$flags <- flags
if (fileLocationInfo$flags["availableOnLocalVolume"] != TRUE) {
"Random garbage when bit 0 is clear in volume flags" [1]
# fileLocationInfo$offsetLocalVolumeInfo <- NA
# fileLocationInfo$offsetBasePathname <- NA
}
if (fileLocationInfo$flags["availableOnNetworkShare"] != TRUE) {
"Random garbage when bit 1 is clear in volume flags" [1]
# fileLocationInfo$offsetNetworkVolumeInfo <- NA
}
if (fileLocationInfo$firstOffset != fileLocationInfo$.offset) {
warning("File format warning: First offset in File Location Info is not 0x1C (28): ", fileLocationInfo$firstOffset)
# Skip to first offset
skip <- fileLocationInfo$firstOffset-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
}
if (verbose) {
message("File location info:")
message(paste(capture.output(fileLocationInfo), collapse="\n"))
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The local volume table
#
# Offset Size Contents
# 0h 1 dword Length of this structure.
# 4h 1 dword Type of volume
# 8h 1 dword Volume serial number
# Ch 1 dword Offset of the volume name (Always 10h)
# 10h ASCIZ Volume label
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (fileLocationInfo$flags["availableOnLocalVolume"]) {
if (verbose) {
message("availableOnLocalVolume...")
}
# Skip to local volume table
skip <- fileLocationInfo$offsetLocalVolumeInfo-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
table <- list(
length = readDWord(con),
typeOfVolume = readDWord(con),
volumeSerialNumber = readDWord(con),
offsetName = readDWord(con),
volumeLabel = "", # To be read
.offset = 4*4
)
if (table$typeOfVolume %in% 0:6) {
names(table$typeOfVolume) <- c("Unknown", "No root directory", "Removable", "Fixed", "Remote", "CD-ROM", "Ram drive")[table$typeOfVolume+1]
} else {
stop("File format error: Unknown type of volume: ", table$typeOfVolume)
}
if (table$offsetName != table$.offset) {
warning("File format warning: Offset to volume name in Local Volume Table is not 0x10 (16): ", table$offsetName)
# Skip to volume label
skip <- table$offsetName-table$.offset
readBin(con, what=integer(), size=1, n=skip)
table$.offset <- table$.offset + skip
}
table$volumeLabel <- readString(con)
table$.offset <- table$.offset + nchar(table$volumeLabel, type="chars") + 1
if (table$.offset != table$length) {
stop("File format error: Length of structure did not match the number of bytes read.")
}
# Update the offset for file location info
fileLocationInfo$.offset <- fileLocationInfo$.offset + table$.offset
# Remove obsolete information
table$length <- NULL
table$offsetName <- NULL
table$.offset <- NULL
fileLocationInfo$localVolumeTable <- table
if (verbose) {
message("File location info / Local Volume Table:")
message(paste(capture.output(fileLocationInfo$localVolumeTable), collapse="\n"))
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The base pathname on local system
#
# "To find the filename of the file on the local volume, combine the
# base path string and the final path string." [1]
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Skip to base pathname
skip <- fileLocationInfo$offsetBasePathname-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
fileLocationInfo$basePathname <- readString(con)
fileLocationInfo$.offset <- fileLocationInfo$.offset +
nchar(fileLocationInfo$basePathname, type="chars") + 1
if (verbose) {
message("basePathname='", fileLocationInfo$basePathname, "'")
message("availableOnLocalVolume...done")
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The network volume table
#
# Offset Size Contents
# 0h 1 dword Length of this structure
# 4h 1 dword Unknown, always 2h?
# 8h 1 dword Offset of network share name (Always 14h)
# Ch 1 dword Unknown, always zero?
# 10h 1 dword Unknown, always 20000h?
# 14h ASCIZ Network share name
#
# Note 1: The above unknown values are the same for a printer or file
# share.
# Note 2: The above values are for Microsoft Networks, I don't have a
# NetWare server to test.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if (fileLocationInfo$flags["availableOnNetworkShare"]) {
if (verbose) {
message("availableOnNetworkShare...")
}
# Skip to local volume table
skip <- fileLocationInfo$offsetNetworkVolumeInfo-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
table <- list(
length = readDWord(con),
unknown1 = readDWord(con),
offsetName = readDWord(con),
unknown2 = readDWord(con),
unknown3 = readDWord(con),
networkShareName = "", # To be read
.offset = 5*4
)
if (table$offsetName != table$.offset) {
warning("File format warning: Offset to network share name in Network Volume Table is not 0x14 (20): ", table$offsetName)
# Skip to volume label
readBin(con, what=integer(), size=1, n=table$offsetName-table$.offset)
}
table$networkShareName <- readString(con)
table$.offset <- table$.offset + nchar(table$networkShareName, type="chars") + 1
if (verbose) {
message("File location info / Network Volume Table:")
message(paste(capture.output(table), collapse="\n"))
}
# if (table$.offset != table$length) {
if (table$.offset != table$unknown2) {
warning("File format warning: Length of table structure did not match the number of bytes read: ", table$.offset, " != ", table$unknown2)
}
# Update the offset for file location info
fileLocationInfo$.offset <- fileLocationInfo$.offset + table$.offset
# Remove obsolete information
table$length <- NULL
table$offsetName <- NULL
table$unknown1 <- table$unknown2 <- table$unknown3 <- NULL
table$.offset <- NULL
fileLocationInfo$networkVolumeTable <- table
if (verbose) {
message("File location info / Network Volume Table:")
message(paste(capture.output(fileLocationInfo$networkVolumeTable), collapse="\n"))
message("availableOnNetworkShare...done")
}
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The remaining pathname on network system
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Skip to remaining pathname
skip <- fileLocationInfo$offsetRemainingPathname-fileLocationInfo$.offset
readBin(con, what=integer(), size=1, n=skip)
fileLocationInfo$.offset <- fileLocationInfo$.offset + skip
fileLocationInfo$remainingPathname <- readString(con)
fileLocationInfo$.offset <- fileLocationInfo$.offset +
nchar(fileLocationInfo$remainingPathname, type="chars") + 1
if (fileLocationInfo$length != fileLocationInfo$.offset) {
stop("File format error: Expected to read ", fileLocationInfo$length, " bytes in File Location Info structure, but read ", fileLocationInfo$.offset)
}
# Remove obsolete information
fileLocationInfo$length <- NULL
fileLocationInfo$firstOffset <- NULL
fileLocationInfo$offsetBasePathname <- NULL
fileLocationInfo$offsetLocalVolumeInfo <- NULL
fileLocationInfo$offsetNetworkVolumeInfo <- NULL
fileLocationInfo$offsetRemainingPathname <- NULL
fileLocationInfo$.offset <- NULL
lnk$fileLocationInfo <- fileLocationInfo
} else {
lnk$fileLocationInfo <- NA
} # if (header$flags["pointsToFileOrDirectory"])
unicoded <- header$flags["unicodedStrings"]
if (header$flags["hasDescription"]) {
nchars <- readWord(con)
lnk$description <- readString(con, nchars=nchars, unicoded=unicoded)
}
if (header$flags["hasRelativePath"]) {
nchars <- readWord(con)
lnk$relativePath <- readString(con, nchars=nchars, unicoded=unicoded)
}
if (header$flags["hasWorkingDirectory"]) {
nchars <- readWord(con)
lnk$workingDirectory <- readString(con, nchars=nchars, unicoded=unicoded)
}
if (header$flags["hasCommandLineArguments"]) {
nchars <- readWord(con)
lnk$commandLineArguments <- readString(con, nchars=nchars, unicoded=unicoded)
}
if (header$flags["hasCustomIcon"]) {
nbytes <- readWord(con)
lnk$iconFilename <- readString(con, nchars=nchars, unicoded=unicoded)
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# For convenience
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
value <- lnk$relativePath
if (!is.null(value)) {
lnk$relativePathname <- value
}
if (header$flags["pointsToFileOrDirectory"]) {
if (lnk$fileLocationInfo$flags["availableOnLocalVolume"]) {
lnk$pathname <- paste(lnk$fileLocationInfo$basePathname,
lnk$fileLocationInfo$remainingPathname, sep="")
}
if (lnk$fileLocationInfo$flags["availableOnNetworkShare"]) {
lnk$networkPathname <-
paste(lnk$fileLocationInfo$networkVolumeTable$networkShareName,
"\\", lnk$fileLocationInfo$remainingPathname, sep="")
}
} # if (header$flags["pointsToFileOrDirectory"])
lnk
}) # readWindowsShortcut()
Try the R.utils package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.