Nothing
###########################################################################/**
# @RdocDefault readWindowsShellLink
#
# @title "Reads a Microsoft Windows Shortcut (.lnk file)"
#
# @synopsis
#
# \description{
# @get "title".
# }
#
# \arguments{
# \item{con}{A @connection or a @character string (filename).}
# \item{clean}{If @TRUE, low-level file specific fields are dropped,
# e.g. offsets on file locations.}
# \item{verbose}{If @TRUE, extra information is written while reading.}
# \item{...}{Not used.}
# }
#
# \value{
# Returns a @list structure.
# }
#
# @examples "../incl/readWindowsShellLink.Rex"
#
# \details{
# This function is implemented based on the official file format
# specification [1].
# It is intended to replace @see "readWindowsShortcut", which was
# written based on reverse engineering (before [1] was made available).
# }
#
# @author
#
# \seealso{
# @see "readWindowsShortcut"
# \code{\link{filePath}}
# }
#
# \references{
# [1] [MS-SHLLINK]: Shell Link (.LNK) Binary File Format, Microsoft Inc.,
# September 25, 2009. \cr
# }
#
# @keyword file
# @keyword IO
# @keyword internal
#*/###########################################################################
setMethodS3("readWindowsShellLink", "default", function(con, clean=TRUE, verbose=FALSE, ...) {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Local functions
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
intToBits <- function(x, n=NULL, names=NULL, rev=TRUE, ...) {
# Argument 'x':
.stop_if_not(is.integer(x))
.stop_if_not(length(x) == 1L)
# Argument 'n':
if (!is.null(n)) {
.stop_if_not(n > 0L)
}
# Argument 'names':
if (!is.null(names)) {
.stop_if_not(is.character(names))
if (!is.null(n)) {
.stop_if_not(length(names) == n)
}
n <- length(names)
}
# Get binary represenation
x <- intToBin(x)
x <- unlist(strsplit(x, split=""), use.names=FALSE)
.stop_if_not(length(x) <= n)
x <- as.integer(x)
x <- as.logical(x)
x <- c(rep(FALSE, times=n-length(x)), x)
.stop_if_not(length(x) == n)
if (!is.null(names)) {
x <- rev(x)
names(x) <- names
x <- rev(x)
}
if (rev) {
x <- rev(x)
}
x
} # intToBits()
readBits <- function(con, n=32L, ...) {
.stop_if_not(n %% 8 == 0)
nbrOfBytes <- n %/% 8L
if (nbrOfBytes <= 2L) {
x <- readBin(con=con, what=integer(), size=nbrOfBytes, n=1L, signed=FALSE, endian="little")
} else {
x <- readBin(con=con, what=integer(), size=nbrOfBytes, n=1L, endian="little")
}
intToBits(x, n=n)
} # readBits()
# raw - An 1-byte unsigned integer
readRaw <- function(con, n=1) {
readBin(con=con, what=raw(), n=n)
}
# byte - An 1-byte unsigned integer
readByte <- function(con, n=1) {
readBin(con=con, what=integer(), size=1L, n=n,
signed=FALSE, endian="little")
}
# word - A 2-byte unsigned integer
readWord <- function(con, n=1) {
readBin(con=con, what=integer(), size=2L, 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=4L, 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=4L, n=2*n,
signed=TRUE, endian="little")
}
readString <- function(con, nchars=-1L, unicoded=FALSE) {
if (nchars == -1) {
bfr <- c()
while ((byte <- readByte(con)) != 0L) {
bfr <- c(bfr, byte)
}
} else {
if (unicoded)
nchars <- 2L*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()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# From [7]:
# The Shell Link Binary File Format consists of a sequence of structures
# that conform to the following ABNF rules [RFC5234]:
#
# SHELL_LINK = SHELL_LINK_HEADER [LINKTARGET_IDLIST] [LINKINFO]
# [STRING_DATA] *EXTRA_DATA
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# The ShellLinkHeader structure contains identification information,
# timestamps, and flags that specify the presence of optional structures,
# including LinkTargetIdList (section 2.2), LinkInfo (section 2.3),
# and StringData (section 2.4).
#
# [SHELL_LINK_HEADER] =
# HeaderSize (4 bytes):
# The size, in bytes, of this structure. MUST be 0x0000004C.
# LinkCLSID (16 bytes):
# A class identifier (CLSID). MUST be 00021401-0000-0000-C000-000000000046.
# LinkFlags (4 bytes):
# A LinkFlags structure (section 2.1.1) that specifies information about
# the shell link and the presence of optional portions of the structure.
# FileAttributes (4 bytes):
# A FileAttributesFlags structure (section 2.1.2) that specifies
# information about the link target.
# CreationTime (8 bytes):
# A FILETIME structure ([MS-DTYP] section 2.3.1) that specifies the
# creation time of the link target in UTC (Coordinated Universal Time).
# If the value is zero, there is no creation time set on the link target.
# AccessTime (8 bytes):
# A FILETIME structure ([MS-DTYP] section 2.3.1) that specifies the
# access time of the link target in UTC (Coordinated Universal Time).
# If the value is zero, there is no access time set on the link target.
# WriteTime (8 bytes):
# A FILETIME structure ([MS-DTYP] section 2.3.1) that specifies the
# write time of the link target in UTC (Coordinated Universal Time).
# If the value is zero, there is no write time set on the link target.
# FileSize (4 bytes):
# A 32-bit unsigned integer that specifies the size, in bytes,
# of the link target. If the link target file is larger than
# 0xFFFFFFFF, this value specifies the least significant 32 bits
# of the link target file size.
# IconIndex (4 bytes)
# A 32-bit signed integer that specifies the index of an icon
# within a given icon location.
# ShowCommand (4 bytes):
# A 32-bit unsigned integer that specifies the expected window state
# of an application launched by the link. This value SHOULD be one
# of the following.
# SW_SHOWNORMAL = 0x00000001
# The application is open and its window is open in a normal fashion.
# SW_SHOWMAXIMIZED = 0x00000003
# The application is open, and keyboard focus is given to the
# application, but its window is not shown.
# SW_SHOWMINNOACTIVE = 0x00000007
# The application is open, but its window is not shown. It is not
# given the keyboard focus.
# HotKey (2 bytes):
# A HotKeyFlags structure (section 2.1.3) that specifies the keystrokes
# used to launch the application referenced by the shortcut key. This
# value is assigned to the application after it is launched, so that
# pressing the key activates that application.
# Reserved1 (2 bytes): A value that MUST be zero.
# Reserved2 (4 bytes): A value that MUST be zero.
# Reserved3 (4 bytes): A value that MUST be zero.
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
parseLinkFlags <- function(flags, ...) {
keys <- character(length=27L)
keys[ 1] <- "HasLinkTargetIdList"
keys[ 2] <- "HasLinkInfo"
keys[ 3] <- "HasName"
keys[ 4] <- "HasRelativePath"
keys[ 5] <- "HasWorkingDir"
keys[ 6] <- "HasArguments"
keys[ 7] <- "HasIconLocation"
keys[ 8] <- "IsUnicode"
keys[ 9] <- "ForceNoLinkInfo"
keys[10] <- "HasExpString"
keys[11] <- "RunInSeparateProcess"
keys[12] <- "Unused1"
keys[13] <- "HasDarwinId"
keys[14] <- "RunAsUser"
keys[15] <- "HasExpIcon"
keys[16] <- "NoPidlAlias"
keys[17] <- "Unused2"
keys[18] <- "RunWithShimLayer"
keys[19] <- "ForceNoLinkTrack"
keys[20] <- "EnableTargetMetadata"
keys[21] <- "DisableLinkPathTracking"
keys[22] <- "DisableKnownFolderTracking"
keys[23] <- "DisableKnownFolderAlias"
keys[24] <- "AllowLinkToLink"
keys[25] <- "UnaliasOnSave"
keys[26] <- "PreferEnvironmentPath"
keys[27] <- "KeepLocalIdListForUNCTarget"
flags <- intToBits(flags, names=keys)
# Validation
.stop_if_not(flags["IsUnicode"])
flags
} # parseLinkFlags()
parseFileAttributes <- function(attrs, ...) {
keys <- character(length=15L)
keys[ 1] <- "readOnly"
keys[ 2] <- "hidden"
keys[ 3] <- "system"
keys[ 4] <- "reserved1"
keys[ 5] <- "directory"
keys[ 6] <- "archive"
keys[ 7] <- "reserved2"
keys[ 8] <- "normal"
keys[ 9] <- "temporary"
keys[10] <- "sparseFile"
keys[11] <- "reparsePoint"
keys[12] <- "compressed"
keys[13] <- "offline"
keys[14] <- "notContentIndexed"
keys[15] <- "encrypted"
attrs <- intToBits(attrs, names=keys)
# Validate
keys <- c("reserved1", "reserved2")
for (key in keys) {
if (attrs[key] != 0L) {
stop(sprintf("File format error: File header field 'fileAttributes' flag '%s' must be FALSE: %d", key, attrs[key]))
}
}
if (attrs["normal"] && sum(attrs) != 1L) {
stop(sprintf("File format error: File header field 'fileAttributes' flag 'normal' is set, but still detected %d other flags also being set.", sum(attrs)-1L))
}
attrs
} # parseFileAttributes()
parseShowCommand <- function(showCommand, ...) {
# Argument 'showCommand':
.stop_if_not(is.integer(showCommand))
.stop_if_not(length(showCommand) == 1L)
showCommand
} # parseShowCommand()
parseHotKey <- function(hotKey, ...) {
# Argument 'hotKey':
.stop_if_not(is.integer(hotKey))
.stop_if_not(length(hotKey) == 1L)
# Get binary represenation
lowByte <- hotKey %% 256L
highByte <- hotKey %/% 256L
if (highByte < 0L || highByte > 7L) {
stop(sprintf("File format error: File header field 'hotKey' has a 'highByte' out of range [0x00,0x07]: %d", highByte))
}
hotKey <- c(lowByte=lowByte, highByte=highByte)
hotKey
} # parseHotKey()
readShellLinkHeader <- function(con, ...) {
hdr <- list(
headerSize = readDWord(con), # 4 bytes
linkCLSID = readRaw(con, n=16), # 16 bytes
linkFlags = readDWord(con), # 4 bytes = 32 bits
fileAttributes = readDWord(con), # 4 bytes = 32 bits
creationTime = readQWord(con), # 8 bytes
accessTime = readQWord(con), # 8 bytes
writeTime = readQWord(con), # 8 bytes
fileSize = readDWord(con), # 4 bytes
iconIndex = readDWord(con), # 4 bytes
showCommand = readDWord(con), # 4 bytes
hotKey = readWord(con), # 2 bytes
reserved1 = readWord(con), # 2 bytes
reserved2 = readDWord(con), # 4 bytes
reserved3 = readDWord(con) # 4 bytes
); # =76 bytes total
# Validate
if (hdr$headerSize != 76L) {
stop("File format error: Shell link header size is not 76 bytes (0x0000004C): ", hdr$headerSize)
}
# Validate
knownCLSID <- as.raw(c(0x01, 0x14, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x46))
if (!all.equal(hdr$linkCLSID, knownCLSID)) {
knownCLSID <- paste(sprintf("%02x", as.integer(knownCLSID)), collapse=",")
linkCLSID <- paste(sprintf("%02x", as.integer(hdr$linkCLSID)), collapse=",")
stop("File format error: Shell link header has an unknown CLSID: ", knownCLSID, " != ", linkCLSID)
}
# Parse (and validate)
hdr$linkFlags <- parseLinkFlags(hdr$linkFlags)
# Parse (and validate)
hdr$fileAttributes <- parseFileAttributes(hdr$fileAttributes)
parseFileTime <- function(time, ...) {
offset <- as.POSIXlt("1601-01-01")
timeD <- as.double(time)
timeD <- c(1, 2^32)*timeD
timeD <- sum(timeD)
secs <- 1.0e-7*timeD
time <- offset + secs
time
} # parseFileTime()
hdr$creationTime <- parseFileTime(hdr$creationTime)
hdr$accessTime <- parseFileTime(hdr$accessTime)
hdr$writeTime <- parseFileTime(hdr$writeTime)
if (hdr$linkFlags["HasLinkInfo"]) {
attrs <- hdr$fileAttributes
# attrs <- names(attrs[attrs])
# if (length(attrs) > 0L) {
# stop("File format error: When shortcut is not pointing to a file or a directory no other file attributes should be set: ", paste(attrs, collapse=", "))
# }
}
# Validate
if (hdr$fileSize < 0L) {
stop("File format error: File length is negative: ", header$fileLength)
}
# Parse (and validate)
hdr$showCommand <- parseShowCommand(hdr$showCommand)
# Parse (and validate)
hdr$hotKey <- parseHotKey(hdr$hotKey)
# Validate
keys <- c("reserved1", "reserved2", "reserved3")
for (key in keys) {
if (hdr[[key]] != 0L) {
stop(sprintf("File format error: File header field '%s' must be 0: %d", key, hdr[[key]]))
}
}
if (clean) {
hdr$headerSize <- NULL
}
hdr
} # readShellLinkHeader()
readLinkTargetIdList <- function(con, ...) {
readIdList <- function(con, n) {
.stop_if_not(n >= 2L)
raw <- readRaw(con, n=n)
terminalId <- raw[(n-1L):n]
.stop_if_not(all(terminalId == 0L))
raw <- raw[1:(n-2L)]
# Parse 'itemIdList' into list of 'ItemId':s
itemIdList <- list()
idx <- 1L
while(length(raw) > 0L) {
.stop_if_not(length(raw) >= 2L)
itemIdSize <- readWord(raw)
raw <- raw[-(1:2)]
nbrOfBytesToRead <- itemIdSize - 2L
if (nbrOfBytesToRead > 0L) {
.stop_if_not(length(raw) >= nbrOfBytesToRead)
Data <- readRaw(raw, n=nbrOfBytesToRead)
itemIdList[[idx]] <- Data
raw <- raw[-(1:nbrOfBytesToRead)]
} else {
Data <- raw(length=0L)
}
itemIdList[[idx]] <- Data
idx <- idx + 1L
} # while()
# Sanity check
.stop_if_not(length(raw) == 0L)
## itemIdList <- lapply(itemIdList, FUN=rawToChar)
idList <- list(itemIdList=itemIdList, terminalId=terminalId)
if (clean) {
idList$terminalId <- NULL
}
idList
} # readIdList()
idListSize <- readWord(con)
idList <- readIdList(con, n=idListSize)
} # readLinkTargetIdList()
readLinkInfo <- function(con, ...) {
parseLinkInfoFlags <- function(flags, ...) {
keys <- character(length=2L)
keys[1] <- "VolumeIdAndLocalBasePath"
keys[2] <- "CommonNetworkRelativeLinkAndPathSuffix"
flags <- intToBits(flags, names=keys)
flags
} # parseLinkInfoFlags()
readVolumeId <- function(con, ...) {
id <- list(
volumeIdSize = readDWord(con), # 4 bytes
driveType = readDWord(con), # 4 bytes
driveSerialNumber = readDWord(con), # 4 bytes
volumeLabelOffset = readDWord(con) # 4 bytes
)
nbrOfBytesRead <- 4*4L
.stop_if_not(id$volumeIdSize > 0x00000010)
.stop_if_not(id$volumeLabelOffset >= 0L)
.stop_if_not(id$volumeLabelOffset < id$volumeIdSize)
.stop_if_not(id$driveType >= 0L)
.stop_if_not(id$driveType <= 6L)
if (id$volumeLabelOffset == 0x00000014) {
id$volumeLabelOffsetUnicode <- readDWord(con)
nbrOfBytesRead <- nbrOfBytesRead + 4L
offset <- id$volumeLabelOffsetUnicode
} else {
offset <- id$volumeLabelOffset
}
id$data <- readRaw(con, n=id$volumeIdSize-nbrOfBytesRead)
offset <- offset - nbrOfBytesRead
nbrOfBytesRead <- nbrOfBytesRead + length(id$data)
# Parse the volume label
data <- id$data
if (offset > 0L) {
data <- data[-c(1:offset)]
}
n <- which(data == as.raw(0x0))-1L
if (n < length(data)) {
data <- data[1:n]
}
id$volumeLabel <- rawToChar(data)
# Sanity check
.stop_if_not(nbrOfBytesRead == id$volumeIdSize)
id
} # readVolumeId()
info <- list(
size = readDWord(con), # 4 bytes
headerSize = readDWord(con), # 4 bytes
flags = readDWord(con), # 4 bytes = 32 bits
volumeIdOffset = readDWord(con), # 4 bytes
localBasePathOffset = readDWord(con), # 4 bytes
commonNetworkRelativeLinkOffset = readDWord(con), # 4 bytes
commonPathSuffixOffset = readDWord(con) # 4 bytes
)
nbrOfBytesRead <- 7*4L
.stop_if_not(info$size >= 0L)
.stop_if_not(info$headerSize >= 0L)
.stop_if_not(info$headerSize < info$size)
.stop_if_not(info$volumeIdOffset < info$size)
.stop_if_not(info$localBasePathOffset < info$size)
.stop_if_not(info$commonNetworkRelativeLinkOffset < info$size)
.stop_if_not(info$commonPathSuffixOffset < info$size)
info$flags <- parseLinkInfoFlags(info$flags)
# Validate
if (info$flags["VolumeIdAndLocalBasePath"]) {
} else {
# Sanity checks
.stop_if_not(info$volumeIdOffset == 0L)
.stop_if_not(info$localBasePathOffset == 0L)
if (info$headerSize >= 0x00000024) {
.stop_if_not(info$localBasePathOffsetUnicode == 0L)
}
}
# Validate
if (info$flags["CommonNetworkRelativeLinkAndPathSuffix"]) {
} else {
# Sanity checks
.stop_if_not(info$commonNetworkRelativeLinkOffset == 0L)
}
# LocalBasePathOffsetUnicode (optional)
if (info$headerSize >= 0x00000024) {
info$localBasePathOffsetUnicode <- readDWord(con)
nbrOfBytesRead <- nbrOfBytesRead + 4L
# Sanity check
if (info$flags["VolumeIdAndLocalBasePath"]) {
.stop_if_not(info$localBasePathOffsetUnicode >= 0L)
} else {
.stop_if_not(info$localBasePathOffsetUnicode == 0L)
}
}
.stop_if_not(nbrOfBytesRead <= info$size)
# CommonPathSuffixOffsetUnicode (optional)
if (info$headerSize >= 0x00000024) {
info$commonPathSuffixOffsetUnicode <- readDWord(con)
nbrOfBytesRead <- nbrOfBytesRead + 4L
# Sanity check
if (info$flags["VolumeIdAndLocalBasePath"]) {
.stop_if_not(info$commonPathSuffixOffsetUnicode >= 0L)
} else {
.stop_if_not(info$commonPathSuffixOffsetUnicode == 0L)
}
}
.stop_if_not(nbrOfBytesRead <= info$size)
# VolumeId (variable)
if (info$flags["VolumeIdAndLocalBasePath"]) {
offset <- info$volumeIdOffset - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
id <- readVolumeId(con)
nbrOfBytesRead <- nbrOfBytesRead + id$volumeIdSize
if (clean) {
id$volumeIdSize <- NULL
id$volumeLabelOffset <- NULL
}
info$volumeId <- id
}
.stop_if_not(nbrOfBytesRead <= info$size)
# LocalBasePath (variable)
if (info$flags["VolumeIdAndLocalBasePath"]) {
offset <- info$localBasePathOffset
.stop_if_not(offset >= 0L)
if (offset > 0L) {
offset <- offset - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
nextOffset <- info$commonNetworkRelativeLinkOffset
if (nextOffset == 0L || is.null(nextOffset)) {
nextOffset <- info$commonPathSuffixOffset
if (nextOffset == 0L || is.null(nextOffset)) {
stop("XXX")
}
}
n <- nextOffset - nbrOfBytesRead
localBasePath <- readRaw(con, n=n)
nbrOfBytesRead <- nbrOfBytesRead + n
info$localBasePath <- rawToChar(localBasePath)
}
}
.stop_if_not(nbrOfBytesRead <= info$size)
# CommonNetworkRelativeLink (variable)
if (info$flags["CommonNetworkRelativeLinkAndPathSuffix"]) {
readCommonNetworkRelativeLink <- function(con, ...) {
parseCommonNetworkRelativeLinkFlags <- function(x, ...) {
keys <- c("ValidDevice", "ValidNetType")
x <- intToBits(x, names=keys)
x
} # parseCommonNetworkRelativeLinkFlags()
link <- list(
size = readDWord(con), # 4 bytes
flags = readDWord(con), # 4 bytes
netNameOffset = readDWord(con), # 4 bytes
deviceNameOffset = readDWord(con), # 4 bytes
networkProviderType = readDWord(con) # 4 bytes
)
# Validate
.stop_if_not(link$size >= 0x00000014)
.stop_if_not(link$netNameOffset >= 0L)
.stop_if_not(link$deviceNameOffset >= 0L)
nbrOfBytesRead <- 5*4L
link$flags <- parseCommonNetworkRelativeLinkFlags(link$flags)
if (!link$flags["ValidDevice"]) {
.stop_if_not(link$deviceNameOffset == 0L)
}
if (!link$flags["ValidNetType"]) {
.stop_if_not(link$netProviderType == 0L)
}
if (link$netNameOffset > 0x00000014) {
link$netNameOffsetUnicode <- readDWord(con)
nbrOfBytesRead <- nbrOfBytesRead + 4L
.stop_if_not(link$netNameOffsetUnicode >= 0L)
link$deviceNameOffsetUnicode <- readDWord(con)
nbrOfBytesRead <- nbrOfBytesRead + 4L
.stop_if_not(link$deviceNameOffsetUnicode >= 0L)
}
# NetName (variable)
nextOffset <- link$deviceNameOffset
if (nextOffset == 0L) {
nextOffset <- link$netNameOffsetUnicode
if (is.null(nextOffset)) {
nextOffset <- link$deviceNameOffsetUnicode
if (is.null(nextOffset)) {
nextOffset <- link$size + 1L
}
}
}
.stop_if_not(!is.null(nextOffset))
offset <- link$netNameOffset - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
n <- nextOffset - nbrOfBytesRead - 1L
netName <- readRaw(con, n=n)
nbrOfBytesRead <- nbrOfBytesRead + n
link$netName <- rawToChar(netName)
# DeviceName (variable)
if (link$flags["ValidDevice"]) {
nextOffset <- link$netNameOffsetUnicode
if (is.null(nextOffset)) {
nextOffset <- link$deviceNameOffsetUnicode
if (is.null(nextOffset)) {
nextOffset <- link$size + 1L
}
}
.stop_if_not(!is.null(nextOffset))
offset <- link$deviceNameOffset - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
n <- nextOffset - nbrOfBytesRead - 1L
netName <- readRaw(con, n=n)
nbrOfBytesRead <- nbrOfBytesRead + n
link$deviceName <- rawToChar(netName)
}
# NetNameOffsetUnicode (variable)
if (!is.null(link$netNameOffsetUnicode)) {
nextOffset <- link$deviceNameOffsetUnicode
if (is.null(nextOffset)) {
nextOffset <- link$size + 1L
}
.stop_if_not(!is.null(nextOffset))
offset <- link$netNameOffsetUnicode - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
n <- nextOffset - nbrOfBytesRead - 1L
netName <- readRaw(con, n=n)
nbrOfBytesRead <- nbrOfBytesRead + n
link$netNameOffsetUnicode <- rawToChar(netName)
}
# DeviceNameOffsetUnicode (variable)
if (!is.null(link$deviceNameOffsetUnicode)) {
nextOffset <- link$size + 1L
.stop_if_not(!is.null(nextOffset))
offset <- link$deviceNameOffsetUnicode - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
n <- nextOffset - nbrOfBytesRead - 1L
value <- readRaw(con, n=n)
nbrOfBytesRead <- nbrOfBytesRead + n
link$deviceNameOffsetUnicode <- rawToChar(value)
}
link
} # readCommonNetworkRelativeLink()
offset <- info$commonNetworkRelativeLinkOffset - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
info$commonNetworkRelativeLink <- readCommonNetworkRelativeLink(con)
n <- info$commonNetworkRelativeLink$size
nbrOfBytesRead <- nbrOfBytesRead + n
if (clean) {
info$commonNetworkRelativeLink$flags <- NULL
info$commonNetworkRelativeLink$size <- NULL
info$commonNetworkRelativeLink$netNameOffset <- NULL
info$commonNetworkRelativeLink$deviceNameOffset <- NULL
}
}
.stop_if_not(nbrOfBytesRead <= info$size)
# CommonPathSuffix (variable)
offset <- info$commonPathSuffixOffset
if (!is.null(offset) && (offset < info$size)) {
offset <- offset - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
nextOffset <- info$localBasePathUnicode
if (is.null(nextOffset)) {
nextOffset <- info$commonPathSuffixUnicode
if (is.null(nextOffset)) {
nextOffset <- info$size + 1L
}
}
.stop_if_not(!is.null(nextOffset))
n <- nextOffset - nbrOfBytesRead - 1L
value <- readRaw(con, n=n)
nbrOfBytesRead <- nbrOfBytesRead + n
info$commonPathSuffix <- rawToChar(value)
}
.stop_if_not(nbrOfBytesRead <= info$size)
# LocalBasePathUnicode (variable)
offset <- info$localBasePathOffsetUnicode
if (!is.null(offset) && (offset < info$size)) {
offset <- offset - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
nextOffset <- info$commonPathSuffixUnicode
if (is.null(nextOffset)) {
nextOffset <- info$size + 1L
}
.stop_if_not(!is.null(nextOffset))
n <- nextOffset - nbrOfBytesRead - 1L
value <- readRaw(con, n=n)
nbrOfBytesRead <- nbrOfBytesRead + n
info$localBasePathUnicode <- rawToChar(value)
}
.stop_if_not(nbrOfBytesRead <= info$size)
# CommonPathSuffixUnicode (variable)
offset <- info$commonPathOffsetUnicode
if (!is.null(offset) && (offset < info$size)) {
offset <- offset - nbrOfBytesRead
.stop_if_not(offset >= 0L)
if (offset > 0L) {
readRaw(con, n=offset)
nbrOfBytesRead <- nbrOfBytesRead + offset
}
nextOffset <- info$size + 1L
n <- nextOffset - nbrOfBytesRead - 1L
value <- readRaw(con, n=n)
nbrOfBytesRead <- nbrOfBytesRead + n
info$commonPathSuffixUnicode <- rawToChar(value)
}
.stop_if_not(nbrOfBytesRead <= info$size)
.stop_if_not(nbrOfBytesRead == info$size)
if (clean) {
info$size <- NULL
info$flags <- NULL
info$headerSize <- NULL
info$volumeIdOffset <- NULL
info$localBasePathOffset <- NULL
info$commonNetworkRelativeLinkOffset <- NULL
info$commonPathSuffixOffset <- NULL
}
info
} # readLinkInfo()
readStringData <- function(con, ...) {
data <- list(
countCharacters = readWord(con) # 2 bytes
)
value <- readRaw(con, n=2*data$countCharacters)
value <- matrix(value, nrow=2L)
value <- value[1L,]
value <- rawToChar(value)
data$string <- value
.stop_if_not(nchar(data$string) == data$countCharacters)
if (clean) {
data <- data$string
}
data
} # readStringData()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# 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
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
lnk <- list()
lnk$header <- readShellLinkHeader(con)
if (verbose) {
message("File header read:")
message(paste(capture.output(lnk$header), collapse="\n"))
}
if (lnk$header$linkFlags["HasLinkTargetIdList"]) {
lnk$idList <- readLinkTargetIdList(con)
}
if (lnk$header$linkFlags["HasLinkInfo"]) {
lnk$linkInfo <- readLinkInfo(con)
}
keys <- c("HasName", "HasRelativePath", "HasWorkingDir", "HasArguments", "HasIconLocation")
if (any(lnk$header$linkFlags[keys])) {
lnk$stringData <- list()
stringData <- list()
if (lnk$header$linkFlags["HasName"]) {
stringData$name <- readStringData(con)
}
if (lnk$header$linkFlags["HasRelativePath"]) {
stringData$relativePath <- readStringData(con)
}
if (lnk$header$linkFlags["HasWorkingDir"]) {
stringData$workingDir <- readStringData(con)
}
if (lnk$header$linkFlags["HasArguments"]) {
stringData$commandLineArguments <- readStringData(con)
}
if (lnk$header$linkFlags["HasIconLocation"]) {
stringData$iconLocation <- readStringData(con)
}
lnk$stringData <- stringData
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# For convenience
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
key <- "relativePath"
if (is.element(key, names(lnk$stringData))) {
value <- lnk$stringData[[key]]
if (!clean) {
value <- value$data
}
lnk$relativePathname <- value
}
key <- "localBasePath"
if (is.element(key, names(lnk$linkInfo))) {
path <- lnk$linkInfo[[key]]
lnk$pathname <- file.path(path, lnk$linkInfo$commonPathSuffix, fsep="")
}
key <- "commonNetworkRelativeLink"
if (is.element(key, names(lnk$linkInfo))) {
path <- lnk$linkInfo[[key]]$netName
lnk$networkPathname <- file.path(path, lnk$linkInfo$commonPathSuffix, fsep="\\")
}
lnk
}) # readWindowsShellLink()
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.