Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - Общий форум

Страница: 1 |

 

  Вопрос: Как создать Ярлык? Добавлено: 18.08.04 21:25  

Автор вопроса:  wishco
Как создать Ярлык?
И кто подскажет как его поместить
в Пуск\Автозагрузка\
Для вех пользователей под Xp.?

Ответить

  Ответы Всего ответов: 4  

Номер ответа: 1
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #1 Добавлено: 18.08.04 22:17
Как создать ярлык см. Поиск по форуму, я задавал этот вопрос и получил достойный ответ. Там же можно создать ярлык в Автозагрузке. Выношу код:

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
    ;Desktop
    Programs
    StartMenu
    StartUp
    Favorites
    Recent
    SendTo
    Other
' *** Для 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 kPath 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, _
             Optional ByVal sDesc As String = "", _
             Optional ByVal xPath As String = "";)
    On Error Resume Next
    
    ;Dim sPath As String
    ;Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell";)

    With WshShell ' Выбор каталога, поскольку sPath - был переда ByVal,
        Select Case inDest ' можем его со спокойной душой менять
            Case Is = Desktop: sPath = .SpecialFolders(";Desktop";)
            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";)
            Case Is = Other: sPath = xPath
        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 = kPath
        .IconLocation = sIcon
        .Description = sDesc
        .WorkingDirectory = sWorkingDirectory
        .Save
    End With
1
    Set WshShell = Nothing
End Sub

Private Sub MkDirEx(sPath As String) 'Создание каталога любой степени вложенности
    ;Dim 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

Где :
kPath - путь к проге,
xPath - путь к ярлычку (если в InDest указано Other)

Ответить

Номер ответа: 2
Автор ответа:
 sne



Разработчик Offline Client

ICQ: 233286456 

Вопросов: 34
Ответов: 5445
  Web-сайт: hw.t-k.ru
 Профиль | | #2 		Добавлено: 19.08.04 00:12
Kodo, а код-то мой ;))) и комментарии мои %))

То: Администрация, может стоит включить этот вопрос в ЧАВо ???
Очень уж он часто звучит...

Ответить

Номер ответа: 3
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #3 Добавлено: 19.08.04 00:26
Ну извини ;) Я то откуда помню чей я код себе скопировал? ;)

Ответить

Номер ответа: 4
Автор ответа:
 Kodo



Разработчик Offline Client

ICQ: 293048085 

Вопросов: 37
Ответов: 457
  Профиль | | #4 Добавлено: 19.08.04 00:29
И! Код с моими доработками! Именно я ввел xPath и пофиксил глюк с kPath (sPath в твоем коде) - в твоем коде он не играл НИКАКОЙ роли!

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам