30 Декабрь 2008

Пример создания ярлыков

Разное |  Таги: ,

Пример создания ярлыков.

'Код создаёт ярлыки для программы калькулятор
'Пути указаны для Windows 2k/XP

Enum ShortCutDest
DeskTop
Programs
StartMenu
StartUp
End Enum

Public Function CreateLink(dest As ShortCutDest, ByVal sName As String, ByVal sPath As String, Optional HotKey As String = "", Optional sIcon As String = "", Optional sWorkingDirectory As String = "", Optional sSubFolder As String = "", Optional WinStyle As Integer = vbNormalFocus)
Dim WshShell As Object
Dim oShellLink As Object
Dim sLinkPath As String
Set WshShell = CreateObject("WScript.Shell")
Select Case dest
Case DeskTop
sLinkPath = WshShell.SpecialFolders("Desktop")
Case StartMenu
sLinkPath = WshShell.SpecialFolders("StartMenu")
Case StartUp
sLinkPath = WshShell.SpecialFolders("StartUp")
Case Programs
sLinkPath = WshShell.SpecialFolders("Programs")
End Select
On Error Resume Next
If sSubFolder <> "" Then
sLinkPath = sLinkPath & "\" & sSubFolder
If Dir(sLinkPath) = "" Then MkDir sLinkPath
End If
On Error GoTo 0
Set oShellLink = WshShell.CreateShortCut(sLinkPath & "\" & sName & ".lnk")
oShellLink.WindowStyle = WinStyle
oShellLink.HotKey = sHotKey
oShellLink.TargetPath = sPath
oShellLink.IconLocation = sIcon
oShellLink.Description = sName
oShellLink.WorkingDirectory = sWorkingDirectory
oShellLink.Save
Set oShellLink = Nothing
Set WshShell = Nothing
End Function

Private Sub Command1_Click()
CreateLink DeskTop, "Calculator", "c:\windows\system32\calc.exe", "CTRL+SHIFT+C", "calc.exe,0", "c:\windows\system32"
CreateLink StartMenu, "Calculator", "c:\windows\system32\calc.exe", "CTRL+SHIFT+C", "calc.exe,0", "c:\windows\system32"
'Автозагрузка
'CreateLink StartUp, "Calculator", "c:\windows\system32\calc.exe", "CTRL+SHIFT+C", "calc.exe,0", "c:\windows\system32"
CreateLink Programs, "Calculator", "c:\windows\system32\calc.exe", "CTRL+SHIFT+C", "calc.exe,0", "c:\windows\system32", "WinCalc"
CreateLink Programs, "Calculator Help", "c:\windows\help\calc.chm", "", "winhlp32.exe,0", "c:\windows\help", "WinCalc"
End Sub


Оставить комментарий

Я не робот.


PokerStars