Total Commander

Код: Выделить всё

'============================================================================
' Через контекстное меню для ярлыка копируется в буфер кнопка TC,
'   аналогичная ярлыку.
' В системе должен быть установлен TCScript.Helper.
'
' Параметры скрипта - имя файла ярлыка
'
' Автор  - Batya
'============================================================================
Option Explicit
Dim FSO, WSH, TCS, Mess, LinkFile, Clipboard, LNK
Set FSO  = CreateObject("Scripting.FileSystemObject")
Set WSH  = CreateObject("WScript.Shell")
Set TCS  = CreateObject("TCScript.Helper")

'Задаем массив сообщений
MessDefine
'Проверяем параметры
CheckParams

Set LNK = WSH.CreateShortcut(LinkFile)

Clipboard = "TOTALCMD#BAR#DATA"       & vbNewLine &_
            LNK.TargetPath            & vbNewLine &_
            LNK.Arguments             & vbNewLine
If Left(LNK.IconLocation, 1) = "," Then Clipboard = Clipboard & LNK.TargetPath
Clipboard = Clipboard                             &_
            LNK.IconLocation          & vbNewLine &_ 
            FSO.GetBaseName(LinkFile) & vbNewLine &_
            LNK.WorkingDirectory      & vbNewLine
Select Case LNK.WindowStyle
  Case 3    Clipboard = Clipboard & -1
  Case 7    Clipboard = Clipboard & 1
  Case Else Clipboard = Clipboard & ""
End Select
Clipboard = Clipboard & vbNewLine & "-1"

TCS.SetTextToClip(Clipboard)

'Выход
Quit

'===== Процедуры и функции ====================================================
'Проверка входных параметров
Sub CheckParams
  With WScript
    If .Arguments.Count = 0 Then
      MsgBox Mess(1), vbCritical + vbOKOnly, Mess(0)
      Quit
    End If
    LinkFile = .Arguments(0)
  End With
  If Not FSO.FileExists(LinkFile) Then
    MsgBox Mess(2), vbCritical + vbOKOnly, Mess(0)
    Quit
  End If
End Sub

'Описание сообщений
Sub MessDefine
  Set Mess = CreateObject("Scripting.Dictionary")
  With Mess
    .Add 0,  "Копирование кнопки TC"
    .Add 1,  "Не указано имя файла ярлыка!"
    .Add 2,  "Указанный ярлык не существует!"
  End With
End Sub

'Выход
Sub Quit
  Set Mess = Nothing
  Set TCS  = Nothing
  Set WSH  = Nothing
  Set FSO  = Nothing
  WScript.Quit
End Sub