| Вопрос: ЯрлычОк | Добавлено: 24.07.04 18:36 |
Автор вопроса:  Kodo | ICQ: 293048085 |
| Как создать ярлык для проги на Рабочем Столе? |
| Ответы | Всего ответов: 4 |
|
Номер ответа: 1 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | | #1 | Добавлено: 24.07.04 18:58 |
|
Этот вопрос неоднократно задавался на форуме, и самым простым ответом был следующий код:
Option Explicit Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As Long) As Long Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long Public Enum ShortcutPath  esktop
Programs StartMenu StartUp Favorites Recent SendTo ' *** Для Windows 2000/XP *** NT_AllUsersDesktop NT_AllUsersStartMenu NT_AllUsersPrograms NT_AllUsersStartup End Enum Public Sub CreateLink(ByVal inDest As ShortcutPath, _ ByVal sName As String, _ ByVal sPath As String, _ Optional ByVal HotKey As String = vbNullString, _ Optional ByVal sIcon As String = vbNullString, _ Optional ByVal sWorkingDirectory As String = vbNullString, _ Optional ByVal sSubFolder As String = vbNullString, _ Optional ByVal WinStyle As VBA.VbAppWinStyle = vbNormalFocus) On Error Resume Next im WshShell As Object
Set WshShell = CreateObject("WScript.Shell" 
With WshShell ' Выбор каталога, поскольку sPath - был переда ByVal, Select Case inDest ' можем его со спокойной душой менять Case Is = Desktop: sPath = .SpecialFolders(" esktop"
Case Is = StartMenu: sPath = .SpecialFolders("StartMenu"
Case Is = StartUp: sPath = .SpecialFolders("StartUp"
Case Is = Programs: sPath = .SpecialFolders("Programs"
Case Is = Favorites: sPath = .SpecialFolders("Favorites Windows"
Case Is = Recent: sPath = .SpecialFolders("Recent Windows"
Case Is = SendTo: sPath = .SpecialFolders("SendTo Windows"
Case Is = NT_AllUsersDesktop: sPath = .SpecialFolders("AllUsersDesktop"
Case Is = NT_AllUsersStartMenu: sPath = .SpecialFolders("AllUsersStartMenu"
Case Is = NT_AllUsersPrograms: sPath = .SpecialFolders("AllUsersPrograms"
Case Is = NT_AllUsersStartup: sPath = .SpecialFolders("AllUsersStartup"
End Select End With ' Проверка правильности имен и каталогов... If Not Right(sPath, &H1) = "\" Then sPath = sPath & "\" If Len(sSubFolder) Then If Not Right(sSubFolder, &H1) = "\" Then sSubFolder = sSubFolder & "\" If Not Right(sName, &H4) = ".lnk" Then sName = sName & ".lnk" sPath = sPath & sSubFolder ' Ставим путь, и проверяем существует-ли он... If PathFileExists(sPath) = &H0 Then Call MkDirEx(sPath) Set WshShell = WshShell.CreateShortCut(sPath & "\" & sName) ' Ух... какой я экономный 
With WshShell ' Зачем еще один объект создавать ??? .WindowStyle = WinStyle .HotKey = HotKey .TargetPath = sPath .IconLocation = sIcon .Description = sName .WorkingDirectory = sWorkingDirectory .Save End With Set WshShell = Nothing End Sub Private Sub MkDirEx(sPath As String) 'Создание каталога любой степени вложенности im ci As Long, sArray() As String, sBuffer As String
If Len(sPath) = &H0 Then Exit Sub sArray = Split(sPath, "\"
For ci = 0 To UBound(sArray) - 1 sBuffer = sBuffer & sArray(ci) & "\" If PathFileExists(sBuffer) = &H0 Then Call CreateDirectory(sBuffer, ByVal &H0) Next End Sub |
||
|
Номер ответа: 2 Автор ответа: Kodo Разработчик Offline Client ICQ: 293048085 Вопросов: 37 Ответов: 457 |
Профиль | | #2 | Добавлено: 24.07.04 20:33 |
|
Ну спасибо! Правда если код немного урезать будет строчек 10
|
||
|
Номер ответа: 3 Автор ответа: sneРазработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | | #3 | Добавлено: 24.07.04 20:47 |
|
Дык это на будующее, дабы вопросов не возникало лишние знания лишними бываюд редко
|
||
|
Номер ответа: 4 Автор ответа: KodoРазработчик Offline Client ICQ: 293048085 Вопросов: 37 Ответов: 457 |
Профиль | | #4 | Добавлено: 24.07.04 20:49 |
|
ПРОТЕСТУЮ !!!
В коде грубейшая ошибка ! В том виде в каком он есть, параметр sPath НИ НА ЧТО НЕ ВЛИЯЕТ! Он тут же заменяется .SpecialFolders("xxx" . И что же? Создается ярлык сам на себя Кому ж он такой нужен-то? :/ И Description почему-то ставится на sName ... Короче код недоработанный круто (правда исправляется все за 15 сек., но все же ...).
И все равно спасибо ! |
||
Страница: 1 |