Newsgroup: it.comp.lang.visual-basic
Titolo: Creare un collegamento

Ciao a tutti.
Come posso creare un collegamento ad un file?
Grazie


click col destro
"crea collegamento"...    ;-PPP
http://groups.google.com/groups?hl=en&lr=&ie=ISO-8859-1&safe=off&q=creare+collegamento&btnG=Google+Search&meta=group%3Dit.comp.lang.visual-basic
ciao
ugo


http://groups.google.com/groups?hl=en&lr=&ie=ISO-8859-1&safe=off&q=creare+co
llegamento&btnG=Google+Search&meta=group%3Dit.comp.lang.visual-basic
Grazie mille.

Ho scritto il codce che segue per creare link o per eliminarli, ma
funzionano solo se ometto l'argomendo che indica dove si trova il link, e se
ne specifico un'altro, non viene creato nulla. Dove sbaglio?
Grazie
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 Declare Function fRemoveShellLink Lib "vb6stkit.dll" _
    (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String) As Long
 Const gsSTARTMENUKEY As String = "$(Start Menu)"
 Const gsPROGMENUKEY As String = "$(Programs)"
Function CreaLink(LinkName As String, _
    ProgramPath As String, _
    Optional DestPath As String = "..\..\Desktop") _
    As Long
CreaLink = fCreateShellLink(DestPath & _
    vbNullChar, LinkName, _
    ProgramPath, "" & vbNullChar, _
    True, gsPROGMENUKEY)
End Function
Function EliminaLink(LinkName As String, _
    Optional LinkPath As String = "..\..\Desktop") _
    As Long
EliminaLink = fRemoveShellLink(LinkPath, _
    LinkName)
End Function

 ne specifico un'altro, non viene creato nulla. Dove sbaglio?
la  fCreateShellLink prende come path di origine quello del menu avvio, che
su win95/98 č (normalmente) sulla %windir%\menu avvio mentre sotto nt č
(normalmente) sulla %windir%\profiles\%username%\menu avvio e sotto 2000/xp
č sotto la %userprofile%\menu avvio... ergo...:
1) usi un'altra soluzione tipo (copy/paste da un post di sabba):
Allora per fare questo devi aggiungere come riferimento il Window Scripting
Host e usare questo codice:
Public Sub CreateShortcut(ByVal sName As String, ByVal sPath As String,
Optional ByVal sArg As String = "", Optional ByVal sDesc As String = "",
Optional ByVal sDir As String = "")
Dim sDesk               As String
Dim oShell             As New IWshShell_Class
Dim oShortcut       As IWshShortcut_Class
sDesk = oShell.SpecialFolders.Item("Desktop")
Set oShortcut = oShell.CreateShortcut(sDesk & "\" & sName & ".lnk")
oShortcut.TargetPath = sPath
oShortcut.Description = sDesc
oShortcut.Arguments = sArg
oShortcut.WorkingDirectory = sDir
oShortcut.Save
End Sub
2) parti dalla suddetta locazione e risali alla root (devi fare un po' piů
di lavoro di api)... usando la getspecialfolder per definire dove si trovano
le suddette con queste chiamate api:
Global Const CSIDL_DESKTOP = &H0
Global Const CSIDL_PROGRAMS = &H2
Global Const CSIDL_CONTROLS = &H3
Global Const CSIDL_PRINTERS = &H4
Global Const CSIDL_PERSONAL = &H5
Global Const CSIDL_FAVORITES = &H6
Global Const CSIDL_STARTUP = &H7
Global Const CSIDL_RECENT = &H8
Global Const CSIDL_SENDTO = &H9
Global Const CSIDL_BITBUCKET = &HA
Global Const CSIDL_STARTMENU = &HB
Global Const CSIDL_DESKTOPDIRECTORY = &H10
Global Const CSIDL_DRIVES = &H11
Global Const CSIDL_NETWORK = &H12
Global Const CSIDL_NETHOOD = &H13
Global Const CSIDL_FONTS = &H14
Global Const CSIDL_TEMPLATES = &H15
Global Const MAX_PATH = 260
Type SHITEMID
    cb As Long
    abID As Byte
End Type
Type ITEMIDLIST
    mkid As SHITEMID
End Type
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal
hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Function GetSpecialfolder(CSIDL As Long) As String
    Dim r As Long
    Dim IDL As ITEMIDLIST
    Dim NOERROR As Integer
    Dim path As String
    'Get the special folder
    r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
    If r = NOERROR Then
        'Create a buffer
        path = Space$(512)
        'Get the path from the IDList
        r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal path)
        'Remove the unnecessary chr$(0)'s
        GetSpecialfolder = Left$(path, InStr(path, Chr$(0)) - 1)
        Exit Function
    End If
    GetSpecialfolder = ""
End Function
quindi, ad esempio, se vuoi scrivere un collegamento nella "c:\appoggio"
devi:
1- leggere dove si trova la cartella del menu avvio
2) rettificare il tuo nome cartella in base alla posizione relativa dei due
con una funzione tipo la seguente:
Function RelativePath(ByVal sOriginalPath As String) As String
    Dim sStartMenu As String
    Dim nSMBackSlashes As Long, nn As Long
    sStartMenu = GetSpecialfolder(CSIDL_STARTMENU)
    nSMBackSlashes = UBound(Split(sStartMenu, "\"))
    RelativePath = Mid(sOriginalPath, InStr(sOriginalPath, "\") + 1)
    For nn = 0 To nSMBackSlashes
        RelativePath = "..\" & RelativePath
    Next nn
End Function
e chiamare la fCreateShellLink con questo nuovo path:
CreaLink "pippo", "c:\pippo.exe", relativepath ("c:\appoggio")
...se poi devi anche cambiare drive... ne parliamo un'altra volta...  ;-)
ciao
ugo

Grazie