Newsgroup: it.comp.lang.visual-basic
Titolo: CreateShellLink IShellLinkA

codice per creare gli shortcut
(serve la ShellLnk.tlb)
ciao, Francesco.
'******************************************************
Option Explicit
Dim strExePath As String
Dim strLinkFullName As String
Dim strExeFullName As String
Dim strLinkName As String
Private Enum SHOWCMDFLAGS
    SHOWNORMAL = 5
    SHOWMAXIMIZE = 3
    SHOWMINIMIZE = 7
End Enum
'---------------------------------------------------------------------------
------------
' Procedure : CreateShellLink
' DateTime  : 13/02/2002 22.03
' Author    : Microsoft
' Purpose   : funzione scopiazzata dal progetto shelllnk.vpb reperito nel cd
di vb5
'---------------------------------------------------------------------------
------------
'
Private Function CreateShellLink(LnkFile As String, ExeFile As String,
WorkDir As String, _
                                ExeArgs As String, IconFile As String,
IconIdx As Long, _
                                ShowCmd As SHOWCMDFLAGS) As Long
    Dim rc As Long
    Dim pidl As Long                                    ' Item id list
    Dim dwReserved As Long                              ' Reserved flag
    Dim cShellLink As ShellLinkA                        ' An explorer
IShellLinkA(Win 95/Win NT) instance
    Dim cPersistFile As IPersistFile                    ' An explorer
IPersistFile instance
    If ((LnkFile = "") Or (ExeFile = "")) Then Exit Function    ' Validate
min. input requirements.
    On Error GoTo ErrHandler
    Set cShellLink = New ShellLinkA                     ' Create new
IShellLink interface
    Set cPersistFile = cShellLink                       ' Implement
cShellLink's IPersistFile interface
    With cShellLink
        .SetPath ExeFile                                ' set command line
exe name & path to new ShortCut.
        If (WorkDir <> "") Then .SetWorkingDirectory WorkDir ' Set working
directory in shortcut
        If (ExeArgs <> "") Then .SetArguments ExeArgs   ' Add arguments to
command line
        If (IconFile <> "") Then .SetIconLocation IconFile, IconIdx ' Set
shortcut icon location & index
        .SetDescription "MyProject" & vbNullChar
        .SetIconLocation IconFile, IconIdx
        .SetShowCmd ShowCmd                             ' Set shortcut's
startup mode (min,max,normal)
    End With
    cShellLink.Resolve 0, SLR_UPDATE
    cPersistFile.Save StrConv(LnkFile, vbUnicode), 0    ' Unicode conversion
hack... This must be done!
    CreateShellLink = True                              ' Return Success
ErrHandler:
    Set cPersistFile = Nothing                          ' Destroy Object
    Set cShellLink = Nothing                            ' Destroy Object
End Function
Private Sub Form_Load()
End Sub
Sub main()
    Dim iResponse As Boolean
    On Error GoTo errhndl
    strLinkName = "MyProject"
    strLinkFullName = "MyProject.lnk"
    strExePath = App.Path
    strExeFullName = App.Path & "\" & App.EXEName & ".exe"
    'in fase di debug la funzione crea il link se e solo se
    'nell'app.path e presente l'eseguibile del progetto stesso
    iResponse = CreateShellLink(strLinkFullName, strExeFullName, strExePath,
"", strExeFullName, 0, SHOWNORMAL)
    If Not iResponse Then
        Err.Raise 99999, "CreateShellLink", Err.Description & vbCrLf & "Link
non creato"
    Else
        'il link viene creato nell'app.path
        Call MsgBox("Link creato con successo", vbInformation)
    End If
    On Error GoTo 0
    Exit Sub
errhndl:
    Call MsgBox(Err.Number & vbCrLf & Err.Description, vbCritical,
Err.Source)
End Sub

 End Sub
Questa non serve a nulla!!!!!