Iska
17-09-2013, 01:24
Lucretius, ясно.
В таком случае, будет гораздо лучше, если в качестве имени ярлыка будет выступать не имя исполняемого файла, а имя из свойств исполняемого файла (если оно есть; жаль, что Вы не называете продукт), например, не «NOTEPAD.EXE.lnk», а «Блокнот.lnk».
Пробуйте:
Option Explicit
Dim strGoalTargetPath
Dim objShell
Dim objFolder
Dim objFSO
Dim objFile
Dim objWshShell
Dim objWshShortcut
Dim objFolderItem
Dim strShortcutFilePath
Dim strShortcutFileName
If WScript.Arguments.Count = 1 Then
strGoalTargetPath = WScript.Arguments.Item(0)
Set objShell = WScript.CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("shell:Desktop")
If Not objFolder Is Nothing Then
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
For Each objFile In WScript.CreateObject("Scripting.FileSystemObject").GetFolder(objFolder.self.Path).Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "lnk" Then
strShortcutFilePath = objFile.Path
Set objWshShortcut = objWshShell.CreateShortcut(strShortcutFilePath)
If LCase(objWshShortcut.TargetPath) = LCase(strGoalTargetPath) Then
objFile.Copy objFSO.GetParentFolderName(WScript.ScriptFullName) & "\", True
objFile.Delete True
Set objFolder = objShell.NameSpace(objFSO.GetParentFolderName(strGoalTargetPath))
If Not objFolder Is Nothing Then
Set objFolderItem = objFolder.ParseName(objFSO.GetFileName(strGoalTargetPath))
If Not objFolderItem Is Nothing Then
strShortcutFileName = Trim(CStr(objFolder.GetDetailsOf(objFolderItem, 36)))
If Len(strShortcutFileName) > 0 Then
strShortcutFilePath = objFSO.BuildPath(objFSO.GetParentFolderName(strShortcutFilePath), strShortcutFileName & ".lnk")
End If
End If
End If
Set objWshShortcut = objWshShell.CreateShortcut(strShortcutFilePath)
With objWshShortcut
.TargetPath = strGoalTargetPath
.WorkingDirectory = objFSO.GetParentFolderName(strGoalTargetPath)
.Description = strShortcutFileName
.Save
End With
End If
End If
Next
Set objWshShell = Nothing
Set objFSO = Nothing
Else
WScript.Echo "Can't determine user desktop folder"
WScript.Quit 2
End If
Set objFolder = Nothing
Set objShell = Nothing
Else
WScript.Echo "Usage: " & WScript.ScriptName & " <Path to shortcut target>"
WScript.Quit 1
End If
WScript.Quit 0
Обращаю Ваше внимание, что «36» в:
strShortcutFileName = Trim(CStr(objFolder.GetDetailsOf(objFolderItem, 36)))
специфично исключительно для Windows 5.1/5.2. Если рассчитано на иные ОС — см. в: GetExtFileProperties() - Get Extended File Properties / Attributes of Files - KiXtart.org - official site (http://www.kixtart.org/forums/ubbthreads.php?ubb=showflat&Number=160880&page=1). Если рассчитано на множественные ОС — добавляйте проверку версии ОС и выбор соответствующего ей значения.
В таком случае, будет гораздо лучше, если в качестве имени ярлыка будет выступать не имя исполняемого файла, а имя из свойств исполняемого файла (если оно есть; жаль, что Вы не называете продукт), например, не «NOTEPAD.EXE.lnk», а «Блокнот.lnk».
Пробуйте:
Option Explicit
Dim strGoalTargetPath
Dim objShell
Dim objFolder
Dim objFSO
Dim objFile
Dim objWshShell
Dim objWshShortcut
Dim objFolderItem
Dim strShortcutFilePath
Dim strShortcutFileName
If WScript.Arguments.Count = 1 Then
strGoalTargetPath = WScript.Arguments.Item(0)
Set objShell = WScript.CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("shell:Desktop")
If Not objFolder Is Nothing Then
Set objWshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
For Each objFile In WScript.CreateObject("Scripting.FileSystemObject").GetFolder(objFolder.self.Path).Files
If LCase(objFSO.GetExtensionName(objFile.Name)) = "lnk" Then
strShortcutFilePath = objFile.Path
Set objWshShortcut = objWshShell.CreateShortcut(strShortcutFilePath)
If LCase(objWshShortcut.TargetPath) = LCase(strGoalTargetPath) Then
objFile.Copy objFSO.GetParentFolderName(WScript.ScriptFullName) & "\", True
objFile.Delete True
Set objFolder = objShell.NameSpace(objFSO.GetParentFolderName(strGoalTargetPath))
If Not objFolder Is Nothing Then
Set objFolderItem = objFolder.ParseName(objFSO.GetFileName(strGoalTargetPath))
If Not objFolderItem Is Nothing Then
strShortcutFileName = Trim(CStr(objFolder.GetDetailsOf(objFolderItem, 36)))
If Len(strShortcutFileName) > 0 Then
strShortcutFilePath = objFSO.BuildPath(objFSO.GetParentFolderName(strShortcutFilePath), strShortcutFileName & ".lnk")
End If
End If
End If
Set objWshShortcut = objWshShell.CreateShortcut(strShortcutFilePath)
With objWshShortcut
.TargetPath = strGoalTargetPath
.WorkingDirectory = objFSO.GetParentFolderName(strGoalTargetPath)
.Description = strShortcutFileName
.Save
End With
End If
End If
Next
Set objWshShell = Nothing
Set objFSO = Nothing
Else
WScript.Echo "Can't determine user desktop folder"
WScript.Quit 2
End If
Set objFolder = Nothing
Set objShell = Nothing
Else
WScript.Echo "Usage: " & WScript.ScriptName & " <Path to shortcut target>"
WScript.Quit 1
End If
WScript.Quit 0
Обращаю Ваше внимание, что «36» в:
strShortcutFileName = Trim(CStr(objFolder.GetDetailsOf(objFolderItem, 36)))
специфично исключительно для Windows 5.1/5.2. Если рассчитано на иные ОС — см. в: GetExtFileProperties() - Get Extended File Properties / Attributes of Files - KiXtart.org - official site (http://www.kixtart.org/forums/ubbthreads.php?ubb=showflat&Number=160880&page=1). Если рассчитано на множественные ОС — добавляйте проверку версии ОС и выбор соответствующего ей значения.