Raccourcis sur le bureau

Il faut motifier le Setup1.Exe dont les sources sont dispo dans le prog
files.

Je te remercie. As-tu un exemple de code à me passer s'il te plait ?

"Emmanuel DURAND @wanadoo.fr>" a écrit :

Il faut motifier le Setup1.Exe dont les sources sont dispo dans le prog
files.

Dans le principe, c'est simple:

il faut insérer dans le source du Setup1.frm les lignes de code qui vont te
permettre de créer un fichier .lnk (le raccouirci) dans le répertoire
"documents and settingsnom utilisateurBureau" pour quelqu'un de précis ou
"documents and settingsall usersbureau" pour tout le monde.

Et dans la pratique comment on fait. Et qu'est ce que contient ce fichier
.lnk ?

C'est là que ça se complique ....

Heureusement pouir toi, j'ai eu à résoudre cette question il y a quelque
temps.

Mais si tu veux comprendre, va voir sur le site www.vbbyjc.com où tu
trouvera des infos, et notamment une bibliothèque de déclaration qui te
permettra de créer le fameux fichier .lnk

vois du coté de "type lib repository" ou bien clique directement sur le lien
ci dessous.
http://www.vbbyjc.com/typelibs/ivbshlink.tlb

cela te donneras une bibliothèque à enregistrer avec regsvr32. Cette
bibliothèque est NECESSAIRE.

Ensuite, comment faire pour le reste ?

Le plus simple est que je te copie colle le source d'un module que j'ai
utilisé dans un utilitaire d'automatisation que j'ai écris un jour.
Le module est plus bas, afin de ne pas couper mes explications.

Ce module contient 3 fonctions.
Une est très intéressante: createshortcut.

C'est elle qui créé un raccourci dans le chemin voulu, pointant sur le
programme voulu, avec les paramètres de lancement désirés.
Bref tout ce qui correspond à la commande "nouveau raccourci" de
l'environnement windows.

Enfin, pour l'ajouter là où il faut, il faut recupérer le chemin (paramètre
sCreateInPath de la fonction createshortcut), il faut récupérer le chemin du
bureau.

Pour cela une primitive super: GetSpecialFolder qui demande en paramètre un
entier indiquant quel type de répertoire on désire, et renvoie une chaine de
caratère contenant ce dernier

GetSpecialFolder(DocumentUserBureau) renverra le chemin menant au bureau de
l'utilisateur
GetSpecialFolder(AllUsersBureau) renverra le chemin menant au bureau de "All
Users"

Enfin au niveau de ton projet VB, rajoute la référence à IVBShlink.tlb
(projet/reference) qu'il te faudra ajouter à ton package.

Un conseil: fait un copier coller de ce qui suit dans un module

'*********** Debut du module ************
Option Explicit
'*********** getspecialfolder ********
Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias
"SHGetSpecialFolderPathA" (ByVal hwndOwner As Long, ByVal lpszPath As
String, ByVal nFolder As Long, ByVal fCreate As Long) As Long

Public Enum TypeRepertoire
UserBureau = 0 'SYSDRV:Documents And
SettingsuserBureau
UserMenuPrograms = 2 'SYSDRV:Documents And
SettingsuserMenu DémarrerProgrammes
UserDocuments = 5 'SYSDRV:Documents And
SettingsuserMes documents
UserFavoris = 6 'SYSDRV:Documents And
SettingsuserFavoris
UserMenuProgramsDemarrer = 7 'SYSDRV:Documents And
SettingsuserMenu DémarrerProgrammesDémarrage
UserRecent = 8 'SYSDRV:Documents And
SettingsuserRecent
UserSendTo = 9 'SYSDRV:Documents And
SettingsuserSendTo
UserMenu = 11 'SYSDRV:Documents And
SettingsuserMenu Démarrer
UserDocumentsMusique = 13 'SYSDRV:Documents And
SettingsuserMes documentsMa musique
DocumentUserBureau = 16 'SYSDRV:Documents And
SettingsuserBureau
UserVoisinageReseau = 19 'SYSDRV:Documents And
SettingsuserVoisinage réseau
WindowsFonts = 20 'WINDIRFonts
UserModeles = 21 'SYSDRV:Documents And
SettingsuserModèles
AllUsersMenu = 22 'SYSDRV:Documents And SettingsAll
UsersMenu Démarrer
AllUsersMenuPrograms = 23 'SYSDRV:Documents And SettingsAll
UsersMenu DémarrerProgrammes
AllUsersMenuProgramsDemarrer = 24 'SYSDRV:Documents And SettingsAll
UsersMenu DémarrerProgrammesDémarrage
AllUsersBureau = 25 'SYSDRV:Documents And SettingsAll
UsersBureau
UserApplicationData = 26 'SYSDRV:Documents And
SettingsuserApplication Data
UserVoisinageImpression = 27 'SYSDRV:Documents And
SettingsuserVoisinage d'impression
UserLocalSettingApplicationData = 28 'SYSDRV:Documents And
SettingsuserLocal SettingsApplication Data
AllUsersFavoris = 31 'SYSDRV:Documents And SettingsAll
UsersFavoris
UserLocalSettingmpInrnet = 32 'SYSDRV:Documents And
SettingsuserLocal SettingsTemporary Internet Files
UserCookies = 33 'SYSDRV:Documents And
SettingsuserCookies
UserLocalSettingHistorique = 34 'SYSDRV:Documents And
SettingsuserLocal SettingsHistorique
AllUsersApplicationData = 35 'SYSDRV:Documents And SettingsAll
UsersApplication Data
windows = 36 'WINDIR
windowssystem32 = 37 'WINDIRSystem32
ProgramFiles = 38 'SYSDRV:Program Files
UserDocumentsImages = 39 'SYSDRV:Documents And
SettingsuserMes documentsMes images
User = 40 'SYSDRV:Documents And Settingsuser
System32 = 41 'WINDIRSystem32
ProgramFilesCommuns = 43 'SYSDRV:Program FilesFichiers
communs
AllUsersModeles = 45 'SYSDRV:Documents And SettingsAll
UsersModèles
AllUsersDocuments = 46 'SYSDRV:Documents And SettingsAll
UsersDocuments
AllUsersMenuProgramsOutilsAdministration = 47 'SYSDRV:Documents And
SettingsAll UsersMenu DémarrerProgrammesOutils d'administration
AllUsersDocumentsMusique = 53 'SYSDRV:Documents And SettingsAll
UsersDocumentsMa musique
AllUsersDocumentsImages = 54 'SYSDRV:Documents And SettingsAll
UsersDocumentsMes images
WindowsResources = 56 'WINDIRresources
End Enum

Public Function GetSpecialFolder(NumDossier As TypeRepertoire)
Dim buff As String

buff = Space(260)
SHGetSpecialFolderPath 0, buff, NumDossier, 0
GetSpecialFolder = Left(buff, InStr(1, buff, Chr(0)) - 1)
End Function
'***************** Fin Get special folder *************



'*********** Debut manipulation des raccourcis*******

'*********************************************
'Ce module est basé sur le code de JC Alsup (www.vbbyjc.com)
'(la fonction CreateShortCut)
Private Const CLSCTX_INPROC_SERVER = 1& 'CoCreateInstance
'context flag
Private Const S_OK = 0& 'COM - success
Private Const S_FALSE = 1& 'COM - failure
Private Const cNULL = 0& 'C-style NULL
Private Const STGM_DIRECT = &H0 'Storage flags
Private Const SLR_UPDATE = &H4 'IShellLink resolve
'flags

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal ByteLen As Long)
Private Declare Function CoCreateInstance Lib "ole32.dll" _
(refCLSID As Any, pkUnkOuter As Long, ByVal _
dwClsContext As Long, _
refIID As Any, _
ppv As Long) As Long
Private Declare Function CoInitialize Lib "ole32.dll" _
(pvReserved As Long) As Long
Private Declare Sub CoUninitialize Lib "ole32.dll" ()
Private Declare Function SHGetMalloc Lib "shell32.dll" _
(ppMalloc As Long) As Long
Private Declare Function SHGetDesktopFolder _
Lib "shell32.dll" (ppshf As Long) As Long
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As
Any, ByVal numBytes As Long)

'commande d'affichage
Public Enum SW
SW_NORMAL = &H1 'normal
SW_MINIMIZED = &H2 'réduite
SW_MAXIMIZED = &H3 'agrandie
End Enum

'raccourci clavier
Public Enum HOTKEYF
HOTKEYF_SHIFT = &H1
HOTKEYF_CONTROL = &H2
HOTKEYF_ALT = &H4
HOTKEYF_EXT = &H8
End Enum

'propriétés d'un raccourci
Public Type ShellLink
sTargetFile As String 'cible
sWorkingDir As String 'dossier démarrage
sDecription As String 'description
sIconPath As String 'chemin du fichier sui contient l'icone affichée
iIconIndex As Long 'index de l'icone dans ce fichier
iHotKey As Byte 'touche de raccourci clavier
iHotKeyModifier As HOTKEYF 'touche de raccourci clavier Ctrl Shift Alt
iShowCommand As SW 'commande d'affichage
sArguments As String ' argument de la ligne de commande
End Type

'****************************************************************
' ByVal sShortcutTitle As String : titre du raccourci
' ByVal sTargetFile As String : fichier cible existant
' ByVal sCreateInPath As String : dossier dans lequel le fichier .lnk
sera créé
' Optional ByVal sWorkingDir As String : dossier dans lequel la cible est
executée
' Optional ByVal sIconPath As String : chemin du fichier contenant
l'icone du raccourci
' Optional ByVal iIconIndex As Long : index de l'icone à afficher
' Optional ByVal iHotKey As Byte : Touche de raccourci (code Ascii)
' Optional ByVal iHotKeyModifier As HOTKEYF : touches de raccourci
complementaires
' Optional ByVal iShowCommand As SW = SW_NORMAL : affichage de la cible
' Optional ByVal sArguments As String = "" : argument de la ligne de
commande de l'executable cible
'****************************************************************

Public Function CreateShortcut( _
ByVal sShortcutTitle As String, _
ByVal sTargetFile As String, _
ByVal sCreateInPath As String, _
Optional ByVal sWorkingDir As String, _
Optional ByVal sIconPath As String, _
Optional ByVal iIconIndex As Long, _
Optional ByVal iHotKey As Byte, _
Optional ByVal iHotKeyModifier As HOTKEYF, _
Optional ByVal iShowCommand As SW = SW_NORMAL, _
Optional ByVal sArguments As String = "", _
Optional ByVal sDescription As String = "" _
) As Long

'Cette fonction retourne 0& si succés,sinon elle retourne
'un code d'erreur API

'On définit les GUID dont on a
besoins ----------------------------------------
Dim IID_IShellLink As IVBShellLink.GUID
Dim IID_IPersistFile As IVBShellLink.GUID
Dim CLSID_ShellLink As IVBShellLink.GUID

'CLSID_ShellLink = "{00021401-0000-0000-C000-000000000046}"
'IID_IShellLink = "{000214EE-0000-0000-C000-000000000046}"
'IID_IPersistFile = "{0000010B-0000-0000-C000-000000000046}"

'On complete les champs du GUID
CLSID_ShellLink.Data1 = &H21401
CLSID_ShellLink.Data4(0) = &HC0
CLSID_ShellLink.Data4(7) = &H46

'On complete les champs du GUID
IID_IShellLink.Data1 = &H214EE
IID_IShellLink.Data4(0) = &HC0
IID_IShellLink.Data4(7) = &H46

'On complete les champs du GUID
IID_IPersistFile.Data1 = &H10B
IID_IPersistFile.Data4(0) = &HC0
IID_IPersistFile.Data4(7) = &H46

'----------------------------------------------------------------------
Dim r As Long 'valeur retournée
Dim sSHFile As String
Dim rCOM As Long 'valeur retournée par CoInitialize

'on verifie que sCreateInPath se termine par un ""
If Right$(sCreateInPath, 1) <> "" Then
sCreateInPath = sCreateInPath & ""
End If

sSHFile = sCreateInPath & sShortcutTitle & ".lnk"

'on verifie que sCreateInPath ne se termine pas par un ""
If Len(sWorkingDir) > 0 Then
If Right$(sWorkingDir, 1) = "" Then
sWorkingDir = Left$(sWorkingDir, Len(sWorkingDir) - 1)
End If
End If

'----------------------------------------------------------------------
'On initialise COM (Ce n'est problablement pas nécessaire mais c'est une
bonne
'pratique néanmoins.

r = CoInitialize(ByVal cNULL)
If (r = S_OK) Or (r = S_FALSE) Then
rCOM = r

'On obtient le handle du Shell's memory allocator
Dim ppvMalloc As Long

r = SHGetMalloc(ppvMalloc)
If r = S_OK Then
Dim oMalloc As IVBShellLink.IMalloc
CopyMemory oMalloc, ppvMalloc, 4&

'On obtient le dossier du bureau.
Dim ppvDesktop As Long

r = SHGetDesktopFolder(ppvDesktop)
If r = S_OK Then
Dim oDesktop As IVBShellLink.IShellFolder
CopyMemory oDesktop, ppvDesktop, 4&

'On essaie d'obtenir le pidl de notre fichier cible.
Dim pidl As Long
Dim nEaten As Long

r = oDesktop.ParseDisplayName(cNULL, cNULL, _
StrConv(sTargetFile, vbUnicode), _
nEaten, pidl, cNULL)

If r = S_OK Then

'----------------------------------------------------------------------
'On crée un objet ShellLink (CoClass) et on demande son
interface IShellLink

Dim ppvShellLink As Long 'Pointeur vers l'interface
IShellLink pour le
'ShellLink coclass que nous
allons créer.
r = CoCreateInstance( _
CLSID_ShellLink, ByVal cNULL, CLSCTX_INPROC_SERVER,
_
IID_IShellLink, ppvShellLink)

If r = S_OK Then
'Succés - On crée un objet VB pour l'utiliser
Dim oShellLink As IVBShellLink.IShellLink
CopyMemory oShellLink, ppvShellLink, 4&

'On définit la cible du raccourci
r = oShellLink.SetIDList(pidl)

If r = S_OK Then
'On remplie les differents propriétés du
raccourci.

'------------------------------------------------------------
'On définit nom/description du raccourci
r = oShellLink.SetDescription(sDescription)

If r = S_OK Then
If Len(sWorkingDir) > 0 Then
'On définit le répertoire de travail
r = oShellLink.SetWorkingDirectory( _
sWorkingDir)
End If

If Len(sArguments) > 0 Then
'On définit le ou les argument(s) de la
ligne de commande
r = oShellLink.SetArguments( _
sArguments)
End If

If r = S_OK Then
If Len(sIconPath) > 0 Then
'On définit le chemin de l'icone
(autre que celle du fichier cible)
r = oShellLink.SetIconLocation( _
sIconPath, iIconIndex)
End If
End If

If r = S_OK Then
If iHotKey Then
'On définie la touche de raccourci
et les touches de raccourci de contrôle
Dim wHotkey As Integer
Dim yMod As Byte

yMod = CByte(iHotKeyModifier)
'On mets les infos du raccourci
clavier dans un integer
CopyMemory wHotkey, iHotKey, 1&
CopyMemory ByVal VarPtr(wHotkey) +
1&, yMod, 1&

r = oShellLink.SetHotkey(wHotkey)
End If
End If

If r = S_OK Then
If iShowCommand Then
'On définit la commande d'affichage
r oShellLink.SetShowCmd(CLng(iShowCommand))
End If
End If
End If

If r = S_OK Then
'On résout le chemein de la cible pour être
sur que tout est OK
r = oShellLink.Resolve(0&, SLR_UPDATE)
End If
End If

'----------------------------------------------------------------
If r = S_OK Then
'Nous avons défini les propriété du raccourci,
maintenant nous devons
'l'enregistrer. Nous aurons besoin d'un pointeur
vers
'une interface IPersistFile de ShellLink pour
enregistrer

Dim ppvIPersistFile As Long

r = oShellLink.QueryInterface(IID_IPersistFile,
ppvIPersistFile)

If r = S_OK Then
'On l'a obtenu
Dim oPersistFile As
IVBShellLink.IPersistFile
CopyMemory oPersistFile, ppvIPersistFile, 4&

r = oPersistFile.Save( _
StrConv(sSHFile, vbUnicode), _
cNULL)

'On nettoie et libère le pointeur vers
IPersistFile.
oPersistFile.Release
CopyMemory oPersistFile, 0&, 4&
End If
End If

'On nettoie et libère le pointeur vers IShellLink.
oShellLink.Release
CopyMemory oShellLink, 0&, 4&
End If

'On libère le pidl
oMalloc.Free pidl 'ByVal pidl
End If

'On nettoie et libère le pointeur vers Desktop Folder.
oDesktop.Release
CopyMemory oDesktop, 0&, 4&
End If

'On nettoie et libère le pointeur vers IMalloc.
oMalloc.Release
CopyMemory oMalloc, 0&, 4&
End If

If (rCOM = S_OK) Or (rCOM = S_FALSE) Then
CoUninitialize
End If
End If

CreateShortcut = r 'Retourne S_OK ou code d'erreur
End Function

'**************************************************
' ByVal sFileName As String : chemin et nom du fichier .lnk
'**************************************************
Public Function GetShortcut(ByVal sFileName As String) As ShellLink

'Cette fonction retourne les propriétés d'un raccourci dans une
structure ShellLink

'On définit les GUID dont on a
besoins ----------------------------------------
Dim IID_IShellLink As IVBShellLink.GUID
Dim IID_IPersistFile As IVBShellLink.GUID
Dim CLSID_ShellLink As IVBShellLink.GUID

'CLSID_ShellLink = "{00021401-0000-0000-C000-000000000046}"
'IID_IShellLink = "{000214EE-0000-0000-C000-000000000046}"
'IID_IPersistFile = "{0000010B-0000-0000-C000-000000000046}"

'On complete les champs du GUID
CLSID_ShellLink.Data1 = &H21401
CLSID_ShellLink.Data4(0) = &HC0
CLSID_ShellLink.Data4(7) = &H46

'On complete les champs du GUID
IID_IShellLink.Data1 = &H214EE
IID_IShellLink.Data4(0) = &HC0
IID_IShellLink.Data4(7) = &H46

'On complete les champs du GUID
IID_IPersistFile.Data1 = &H10B
IID_IPersistFile.Data4(0) = &HC0
IID_IPersistFile.Data4(7) = &H46

'----------------------------------------------------------------------
Dim r As Long 'valeur retournée
Dim sSHFile As String
Dim rCOM As Long 'valeur retournée par CoInitialize

'----------------------------------------------------------------------
'On initialise COM (Ce n'est problablement pas nécessaire mais c'est une
bonne
'pratique néanmoins.

r = CoInitialize(ByVal cNULL)
If (r = S_OK) Or (r = S_FALSE) Then
rCOM = r

'----------------------------------------------------------------------
'On crée un objet ShellLink (CoClass) et on demande son
interface IShellLink

Dim ppvShellLink As Long 'Pointeur vers l'interface
IShellLink pour le
'ShellLink coclass que nous
allons créer.
r = CoCreateInstance( _
CLSID_ShellLink, ByVal cNULL, CLSCTX_INPROC_SERVER,
_
IID_IShellLink, ppvShellLink)

If r = S_OK Then
'Succés - On crée un objet VB pour l'utiliser
Dim oShellLink As IVBShellLink.IShellLink
CopyMemory oShellLink, ppvShellLink, 4&

If r = S_OK Then
'Nous avons un objet IShellLink. Nous allons
maintenant ouvrir le fichier .lnk
'Pour cela, nous avons besoin d'un pointeur vers
une interface IPersistFile de ShellLink

Dim ppvIPersistFile As Long

r = oShellLink.QueryInterface( _
IID_IPersistFile, ppvIPersistFile)

If r = S_OK Then
'Nous l'avons, on crée un objet VB
IPersistFile
Dim oPersistFile As
IVBShellLink.IPersistFile
CopyMemory oPersistFile, ppvIPersistFile, 4&

'On ouvre le raccourci
r = oPersistFile.Load( _
StrConv(sFileName, vbUnicode), _
cNULL)
If r = S_OK Then
'Ouverture réussie
'On lit les differentes propriétés du
raccourci
GetShortcut.sArguments = Space$(255)
oShellLink.GetArguments
GetShortcut.sArguments, 255
GetShortcut.sArguments Left$(GetShortcut.sArguments, InStr(GetShortcut.sArguments, vbNullChar) - 1)

GetShortcut.sDecription = Space$(255)
oShellLink.GetDescription
GetShortcut.sDecription, 255
GetShortcut.sDecription Left$(GetShortcut.sDecription, InStr(GetShortcut.sDecription, vbNullChar) -
1)

Dim HotKey As Integer
oShellLink.GetHotkey HotKey
GetShortcut.iHotKey = HotKey Mod 256 ' CInt(HotKey And CLng(&HFF))
GetShortcut.iHotKeyModifier HOTKEYF_ALT / 256

GetShortcut.sIconPath = Space$(255)
oShellLink.GetIconLocation
GetShortcut.sIconPath, 255, GetShortcut.iIconIndex
GetShortcut.sIconPath Left$(GetShortcut.sIconPath, InStr(GetShortcut.sIconPath, vbNullChar) - 1)

GetShortcut.sTargetFile = Space$(255)
oShellLink.GetPath
GetShortcut.sTargetFile, 255&, ByVal 0&, ByVal 0&
GetShortcut.sTargetFile Left$(GetShortcut.sTargetFile, InStr(GetShortcut.sTargetFile, vbNullChar) -
1)

GetShortcut.sWorkingDir = Space$(255)
oShellLink.GetWorkingDirectory
GetShortcut.sWorkingDir, 255
GetShortcut.sWorkingDir Left$(GetShortcut.sWorkingDir, InStr(GetShortcut.sWorkingDir, vbNullChar) -
1)

oShellLink.GetShowCmd
GetShortcut.iShowCommand
End If
End If
End If

'On nettoie et on libère le pointeur vers
IShellLink.
oShellLink.Release
CopyMemory oShellLink, 0&, 4&
End If
'On nettoie et on libère le pointeur vers IPersistFile.
oPersistFile.Release
CopyMemory oPersistFile, 0&, 4&


If (rCOM = S_OK) Or (rCOM = S_FALSE) Then
CoUninitialize
End If
End If
End Function

'****************************************************************
' ByVal sShortcutTitle As String : titre du raccourci
' ByVal sCreateInPath As String : dossier dans lequel le fichier .lnk
sera créé
' Shortcut As ShellLink : structure contenant les propriétés d'un
raccourci à modifier
'****************************************************************

Public Function ModifyShortcut( _
ByVal sShortcutTitle As String, _
ByVal sCreateInPath As String, _
ShortCut As ShellLink _
) As Long
ModifyShortcut = CreateShortcut(sShortcutTitle, ShortCut.sTargetFile,
sCreateInPath, _
ShortCut.sWorkingDir, ShortCut.sIconPath, ShortCut.iIconIndex,
ShortCut.iHotKey, _
ShortCut.iHotKeyModifier, ShortCut.iShowCommand, ShortCut.sArguments,
ShortCut.sDecription)
End Function
'********************* Fin

Dernière précision:

Quand tu as créé le raccourcis sur le bureau de l'utilisateur avec
CreateShortcut, tu peux le recopier dans n'importe quel répertoire spécial
que tu récupère avec GetSpecialFolder et le copiant comme n'importe quel
fichier (utilise de préférence FileSystemObjet.CopyFile ce sera plus facile)

Bon courage


"Philippe" <Philippe@discussions.microsoft.com> a écrit dans le message de
news: 839D30D5-C5DF-42F8-B676-A733CB7ECA02@microsoft.com...

Je te remercie. As-tu un exemple de code à me passer s'il te plait ?

"Emmanuel DURAND @wanadoo.fr>" a écrit :

> Il faut motifier le Setup1.Exe dont les sources sont dispo dans le prog
> files.
>
>
>