Using MSAgent to Scan the Start Menu 选择自 wm_ni 的 Blog

Using MSAgent to Scan the Start Menu 选择自 wm_ni 的 BlogNotethiscodewillignoreduplicateshortcuts.ForexampleIhave4or5shortcutsinmyStartMenuthatarenamed”Readme.txt.”Onlythefirstinstanceofthesewillgetaddedtothecommandsallot

大家好,又见面了,我是你们的朋友全栈君。

Note this code will ignore duplicate shortcuts. For example I have 4 or 5 shortcuts in my Start Menu that are named “Readme.txt.” Only the first instance of these will get added to the commands all others will produce an error and will be ignored.

Add the following objects to your project:

Object Type   Object Name
New Module      Doesn’t matter
New Form       frmMain
Function        SubMain() – The project will need to start up here.
Microsoft Agent Control  Agent

 

Add the following to a new code module:
Option Explicit

Public Declare Function ShellExecute Lib “shell32.dll” _
               Alias “ShellExecuteA” _
               (ByVal hwnd As Long, _
               ByVal lpOperation As String, _
               ByVal lpFile As String, _
               ByVal lpParameters As String, _
               ByVal lpDirectory As String, _
               ByVal nShowCmd As Long) As Long

Public a As IAgentCtlCharacter
Public Request As Object
Public fso As New FileSystemObject

Public Type ShortCut
    Name As String * 80
    Path As String * 150
End Type

Public ShortCuts() As ShortCut

Sub Main()
    Load frmMain
    Dim fldr As Scripting.Folder
    Dim wfldr As Scripting.Folder
    ReDim ShortCuts(0)
   
    ‘*************************************************
    ‘Use default Character by not including the path
    ‘*************************************************
    frmMain.Agent.Characters.Load “Agent”
    Set a = frmMain.Agent.Characters(“Agent”)
       
    ‘*************************************************
    ‘Find out the path of the windows directory
    ‘*************************************************
    Set wfldr = fso.GetSpecialFolder(WindowsFolder)
   
    ‘*************************************************
    ‘Get Start Menu Shortcuts
    ‘*************************************************
    Set fldr = fso.GetFolder(wfldr.Path & “/Start Menu”)
    Call AddFolderCommands(fldr, “*.lnk”)
   
    ‘*************************************************
    ‘Get Desktop Shortcuts
    ‘*************************************************
    Set fldr = fso.GetFolder(wfldr.Path & “/Start Menu”)
    Call AddFolderCommands(fldr, “*.lnk”)
   
    ‘*************************************************
    ‘Get Favorites Shortcuts
    ‘*************************************************
    Set fldr = fso.GetFolder(wfldr.Path & “/Start Menu”)
    Call AddFolderCommands(fldr, “*.url”)
   
    a.Show
End Sub

Public Sub AddFolderCommands(rfldr As Scripting.Folder, _
                             lsFileMask As String)
    Dim f As Scripting.File
    Dim lsName As String
    Dim x As Long
    Dim fldr As Scripting.Folder
   
    If fso.FolderExists(rfldr.Path) Then
   
        ‘*************************************************
        ‘Check each file to see if it fits the mask
        ‘*************************************************
        For Each f In rfldr.Files
            If f.Name Like lsFileMask Then
                x = InStrRev(f.Name, “.”, , vbTextCompare)
                If x <> 0 Then
                    lsName = Trim$(Left$(f.Name, x – 1))
                Else
                    lsName = Trim$(f.Name)
                End If
               
                Call AddCommand(lsName, Trim$(f.Path))
            End If
        Next
       
        ‘*************************************************
        ‘Do this for each sub folder as well
        ‘*************************************************
        For Each fldr In rfldr.SubFolders
            Call AddFolderCommands(fldr, lsFileMask)
        Next
    End If
End Sub

Public Sub AddCommand(lsName As String, lsPath As String)
    On Error GoTo EndCmd
   
    ‘*************************************************
    ‘If there is duplicate items ignore all but the
    ‘first instance.
    ‘*************************************************
    a.Commands.Add lsName, lsName, lsName, True, True
   
    ReDim Preserve ShortCuts(UBound(ShortCuts) + 1)
   
    ShortCuts(UBound(ShortCuts)).Name = lsName
    ShortCuts(UBound(ShortCuts)).Path = lsPath
EndCmd:

End Sub

 

版权声明:本文内容由互联网用户自发贡献,该文观点仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 举报,一经查实,本站将立刻删除。

发布者:全栈程序员-用户IM,转载请注明出处:https://javaforall.cn/151648.html原文链接:https://javaforall.cn

【正版授权,激活自己账号】: Jetbrains全家桶Ide使用,1年售后保障,每天仅需1毛

【官方授权 正版激活】: 官方授权 正版激活 支持Jetbrains家族下所有IDE 使用个人JB账号...

(0)


相关推荐

发表回复

您的电子邮箱地址不会被公开。

关注全栈程序员社区公众号