Программно создать ярлык?

[jetcom]

Каким образом это делается, если возможно в принципе?
Вот, собственно и все...

[tyomitch]

Код: Выделить всё

Private Declare Function fCreateShellLink Lib "VB5STKIT.DLL" (ByVal
lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath
As String, ByVal lpstrLinkArgs As String) As Long
Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    ' -> code by Raist Lin
    'Create a shell link on your desktop
    lngresult = fCreateShellLink("..\..\Desktop", "LINK", "C:\myfile.exe", "")
End Sub


Код: Выделить всё

'Source: MSDN column 'Ask Dr. GUI'
Private Declare Function fCreateShellLink Lib "vb6stkit.dll" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String, ByVal fPrivate As Long, ByVal sParent As String) As Long
Private Sub Form_Load()
    Dim strGroupName As String, strLinkName As String
    Dim strLinkPath As String, strLinkArguments As String
    Dim fPrivate As Boolean, sParent As String
    Dim fSuccess As Boolean
    strLinkName = "Shortcut to Calculator"
    strLinkPath = "c:\Windows\calc.exe"
    strLinkArguments = ""
    fPrivate = True                              ' Add shortcut to desktop.
    strGroupName = "..\..\Desktop"
    sParent = "$(Programs)"
    fSuccess = fCreateShellLink(strGroupName & vbNullChar, strLinkName, strLinkPath, strLinkArguments & vbNullChar, fPrivate, sParent)
    'the path should never be enclosed in double quotes
    If fSuccess Then
        MsgBox "Created desktop shortcut"
    Else
        MsgBox "Unable to create desktop shortcut"
    End If
    ' Add shortcut to Programs menu.
    strGroupName = "$(Programs)"
    sParent = "$(Programs)"
    fSuccess = fCreateShellLink(strGroupName & vbNullChar, strLinkName, strLinkPath, strLinkArguments & vbNullChar, fPrivate, sParent)
    'the path should never be enclosed in double quotes
    If fSuccess Then
        MsgBox "Created shortcut on Programs menu"
    Else
        MsgBox "Unable to create shortcut on Programs menu"
    End If
    ' Add shortcut to Startup folder of Programs menu.
    strGroupName = "Startup"
    sParent = "$(Programs)"
    fSuccess = fCreateShellLink(strGroupName & vbNullChar, strLinkName, strLinkPath, strLinkArguments & vbNullChar, fPrivate, sParent)
    'the path should never be enclosed in double quotes
    If fSuccess Then
        MsgBox "Created shortcut in Startup folder"
    Else
        MsgBox "Unable to create shortcut in Startup folder"
    End If
End Sub


[jetcom]

Спасибки, tyomitch!
Все просто...
А то я обыскался по критерию "shortcut" ни чего так и не нашел.
А "ОНО" вон как обзывается!

[cashman]

tyomitch, а у меня напротив какие-то глюки...
из первого кода придирается к "lngresult", вероятно ее нужно изначально как-то прописать?..
а во втором... создает только в "Пуск->Программы" (там появляется ярлык... а на Рабочем столе и в автозапуске НЕТ...

P.S У меня XP rus, возможно из-за этого путь найти не может (вместо Desktop - Рабочий стол), но изменение названия положительного результата не дало... В чем дело не знаешь?..

[hCORe]

Товарищи! Ну разве так можно?
Быстренько читаем статью и качаем пример к ней.

[tyomitch]

tyomitch, а у меня напротив какие-то глюки...
из первого кода придирается к "lngresult", вероятно ее нужно изначально как-то прописать?..

Да:

Код: Выделить всё

Dim lngresult As Long

а во втором... создает только в "Пуск->Программы" (там появляется ярлык... а на Рабочем столе и в автозапуске НЕТ...
В чем дело не знаешь?..

Не знаю, пример не мой...

[jetcom]

А у меня просит VB5STKIT.DLL...
И где ее брать?
Но я еще не читал вышеуказанную статью с примером, - иду читать!
Результат расскажу.

[tyomitch]

А у меня просит VB5STKIT.DLL...
И где ее брать?

[#HammeR#]

Код: Выделить всё

Dim ws As Object
Set ws=CreateObject("WScript.Shell")
Set ws=ws.CreateShortCut(ws.SpecialFolders("Desktop"))
ws.TargetPath=app.path & "\" & app.exename & ".exe"
ws.Save
Set ws=Nothing

И никаких всяких vb5stkit

[#HammeR#]

Ой! Я ошибся!
Вместо

Код: Выделить всё

SpecialFolders("desktop")

поставь

Код: Выделить всё

SpecialFolders("desktop") & ".lnk"

[Andrey Fedorov]

И никаких всяких vb5stkit

Поддерживаю. Самый простой способ.
Ибо Win95 мы уже все одно не поддерживаем

Ой! Я ошибся!

Вообще-то надо не только расширение, но и имя файла указывать.
Но это мелочи - желающий разберется, главное - принцип.

[kif]

для HammeR

Desktop - это объект или папка.

У меня не работает, может проблема в русской винде?

[Andrey Fedorov]

Desktop - это объект или папка

А нажать F1 и поискать по слову CreateShortcut?
Там ведь и пример есть - главное не лениться.
Спрашивать-то дольше выходит...

У меня не работает, может проблема в русской винде?

Нет. Не в русской. И не в винде.

[kif]

Keyword Not Found - это все что мне MSDN нашла

[Andrey Fedorov]

Keyword Not Found - это все что мне MSDN нашла

Значит что-то у тебя не установлено. Разберись, а то сам будешь мучиться и других зря дергать...

Вот кусок из рабочего кода:

Код: Выделить всё

Public Function CreateLnk(sLnkFile As String, sStartFile As String, g_sPrgFolder)
    Dim sExeFile As String
    Dim WshShell As Object, sDesktop As String, oShellLink As Object
   
    Set WshShell = CreateObject("WScript.Shell")
    sDesktop = WshShell.SpecialFolders("Desktop")

    sExeFile = g_sPrgFolder & sStartFile

    Set oShellLink = WshShell.CreateShortcut(sDesktop & "\" & sLnkFile)
    oShellLink.TargetPath = g_sSrvFolder & App.EXEName & ".exe"
    oShellLink.WindowStyle = 1
'    oShellLink.Hotkey = ""
    oShellLink.IconLocation = sExeFile & ", 0"
    oShellLink.Description = Left$(sLnkFile, Len(sLnkFile) - 4)
    oShellLink.WorkingDirectory = g_sSrvFolder
    oShellLink.Save
End Function

[kif]

Спасибо, еще один вопрос, кроме desktopа еще где-то можно создать (Startup, например)

[Andrey Fedorov]

Да где угодно

[Sirik]

У меня есть свой пример (вернее мной скаченный):

[#HammeR#]

Спасибо, что меня поправили. Я торопился!