« cmd.exeでUnicode | トップページ | バッチファイルで、dllのアイコンをインデックスで一覧表示する。 »

2009年1月13日 (火)

ホットキーが設定されてるショートカットを表示する。

ホットキーが有効なのは、デスクトップとスタートメニューにあるショートカットなので、そこを探します。

Hotkeys.vbs

Option Explicit
Dim fso
Dim wShell
Dim Shell

Set fso=CreateObject("Scripting.FileSystemObject")
Set wShell=CreateObject("WScript.Shell")
Set Shell=CreateObject("Shell.Application")

Files fso.GetFolder(wShell.SpecialFolders.Item("Desktop"))
Files fso.GetFolder(wShell.SpecialFolders.Item("AllUsersDesktop"))
SubFolders fso.GetFolder(wShell.SpecialFolders.Item("StartMenu"))
SubFolders fso.GetFolder(wShell.SpecialFolders.Item("AllUsersStartMenu"))

Sub Files(Folder)
Dim File
Dim Link
Dim FolderItem

For Each File In Folder.Files
  Select Case fso.GetExtensionName(File.Name)
  Case "lnk"
    Set Link=wShell.CreateShortcut(File.Path)
    If Link.HotKey<>"" Then WScript.Echo Join(Array(_
      "FullName" & vbTab & Link.FullName,_
      "TargetPath" & vbTab & Link.TargetPath,_
      "Arguments" & vbTab & Link.Arguments,_
      "WorkingDirectory" & vbTab & Link.WorkingDirectory,_
      "WindowStyle" & vbTab & Link.WindowStyle,_
      "Hotkey" & vbTab & Link.Hotkey,_
      "IconLocation" & vbTab & Link.IconLocation,_
      "Description" & vbTab & Link.Description),vbLf)
  Case "url"
    Set FolderItem=Shell.NameSpace(Folder.Path).Items().Item(File.Name)
    Set Link=FolderItem.GetLink
    WScript.Echo Join(Array(_
      "FullName" & vbTab & FolderItem.Path,_
      "Path" & vbTab & Link.Path,_
      "WorkingDirectory" & vbTab & Link.WorkingDirectory,_
      "ShowCommand" & vbTab & Link.ShowCommand,_
      "Hotkey" & vbTab & Link.Hotkey,_
      "IconLocation" & vbTab & GetIconLocation(FolderItem.Path),_
      "IconIndex" & vbTab & Link.GetIconLocation(""),_
      "Description" & vbTab & Link.Description),vbLf)
  End Select
Next
End Sub

Sub SubFolders(Folder)
Dim SubFolder
Files Folder
For Each SubFolder In Folder.SubFolders
  If SubFolder.Attributes And 2 = 0 Then Files SubFolder
Next
End Sub

Function GetIconLocation(Path)
Dim File
Dim Line
Set File=fso.OpenTextFile(Path)
Do While Not File.AtEndOfStream
  Line=Trim(File.ReadLine)
  If InStr(UCase(Line),"ICONFILE=") Then
    GetIconLocation=Trim(Mid(Line,10))
    Exit Function
  End If
Loop
End Function

« cmd.exeでUnicode | トップページ | バッチファイルで、dllのアイコンをインデックスで一覧表示する。 »