Comment créer un raccourcis d'exe vers le bureau de windows en VB5

Signaler
Messages postés
32
Date d'inscription
samedi 31 août 2002
Statut
Membre
Dernière intervention
26 juin 2005
-
Messages postés
32
Date d'inscription
samedi 31 août 2002
Statut
Membre
Dernière intervention
26 juin 2005
-
Comment créer un raccourcis d'exe (exemple : C:\monprog\prog.exe) vers le bureau de windows en VB5?

Merci d'avance :)

2 réponses

Messages postés
194
Date d'inscription
dimanche 3 mars 2002
Statut
Membre
Dernière intervention
19 décembre 2005
3
Bonjour,

Ceci n'est pas de moi mais devrais repondre a ta question ...

_________________________________________
'************************************************************
'* NOM : vbRaccourci
'* DATE : 10/06/2002
'*
'* AUTEUR : Cyber@tom Association ( cyberatom@altern.org.com )
'*
'* CODE TROUVE SUR "Cyber@tom, programmation en VB"
'* http://www.cyberatom.com
'*
'* DESCRIPTION :
'* Cet exemple vous apprend comment créer un raccourci d'un
'* programme avec Visual Basic.
'************************************************************

Option Explicit

Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

'APIs pour la création de raccourcis

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
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

Function FileExists(Fichier As String) As Boolean
' Vérifie si un fichier existe ou non

If Dir(Fichier) <> "" Then FileExists = True

End Function

Function CHEMIN_RELATIF(Chemin1 As String, CheminRef As String) As String
'Renvoie l'adresse du dossier Chemin1 par rapport à CheminRef
'Exemple : Si Chemin1 "c:\program files" et CheminRef "c:\windows"
'alors CHEMIN_RELATIF = "..\program files"

Dim Morceau1() As String, Morceau2() As String
Dim TailleMorceau1 As Integer, TailleMorceau2 As Integer

Dim i As Integer, j As Integer
Dim Prov As String

ReDim Morceau1(1 To 1)
ReDim Morceau2(1 To 1)

' Marque chaque élément du chemin dans un tableau

For i = 1 To Len(Chemin1)
If Mid(Chemin1, i, 1) = "" Then
TailleMorceau1 = TailleMorceau1 + 1
ReDim Preserve Morceau1(1 To TailleMorceau1)
Morceau1(TailleMorceau1) = Prov
Prov = ""
Else
Prov = Prov & Mid(Chemin1, i, 1)
End If
Next i

'rajoute le dernier élément (non précédé d'un slash)

TailleMorceau1 = TailleMorceau1 + 1
ReDim Preserve Morceau1(1 To TailleMorceau1)
Morceau1(TailleMorceau1) = Prov

'* pour CheminRef
For i = 1 To Len(CheminRef)
If Mid(CheminRef, i, 1) = "" Then
TailleMorceau2 = TailleMorceau2 + 1
ReDim Preserve Morceau2(1 To TailleMorceau2)
Morceau2(TailleMorceau2) = Prov
Prov = ""
Else
Prov = Prov & Mid(CheminRef, i, 1)
End If
Next i

TailleMorceau2 = TailleMorceau2 + 1
ReDim Preserve Morceau2(1 To TailleMorceau2)
Morceau2(TailleMorceau2) = Prov

Prov = ""
For i = 1 To TailleMorceau2 - 1
Prov = Prov & ".."
Next i

For i = 2 To TailleMorceau1
Prov = Prov & Morceau1(i) & ""
Next i

CHEMIN_RELATIF = Left(Prov, Len(Prov) - 1) 'retire le "" final

End Function

Function GetSpecialFolder(CSIDL As Long) As String

'récupère un dossier spécial de Windows ( dossier système... )

'variables nécessaires
Dim r As Long
Dim sPath As String
Dim IDL As ITEMIDLIST
Const NOERROR = 0
Const MAX_LENGTH = 260

r = SHGetSpecialFolderLocation(Form1.hWnd, CSIDL, IDL)
If r = NOERROR Then
sPath = Space$(MAX_LENGTH)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
If r Then
GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) - 1) & ""
End If
End If

End Function

Private Sub Command1_Click()

If File1.ListIndex <> -1 Then

'Crée un raccourci vers le programme dans le dossier de démarrage

Dim NomFichier As String
Dim DossierProg As String
Dim DossierDemarrage As String
Dim DossierRelatif As String

'Nom du fichier
NomFichier = verif(Dir1.Path) & File1.filename

'Trouve le dossier Démarrer\Programmes
DossierProg = verif(GetSpecialFolder(2))

'Trouve l'adresse du dossier où le raccourci va être crée relativement à DossierProg
'(indispensable pour utiliser fCreateShellLink)

DossierRelatif = CHEMIN_RELATIF(CStr(Text1.Text), DossierProg)

' Crée le raccourci
Call fCreateShellLink(DossierRelatif, "Coucou", NomFichier, "")

End If

End Sub

Private Sub Dir1_Change()

' Changement de dossier
File1.Path = Dir1.Path
Text1.Text = File1.Path

End Sub

Private Sub Drive1_Change()

' Changement de lecteur
Dir1.Path = Drive1.Drive

End Sub

Private Function verif(Fichier)

' Verifie que le dossier est bien suivi d'un '\'

If Right(Fichier, 1) = "" Then
verif = Fichier
Else
verif = Fichier & ""
End If

End Function

Private Sub Form_Load()
Drive1.Drive = Left(verif(GetSpecialFolder(2)), 1) & ":"
Text1.Text = File1.Path
End Sub

__________________________________________

au plaisir ;-)

TFlorian
0
Messages postés
32
Date d'inscription
samedi 31 août 2002
Statut
Membre
Dernière intervention
26 juin 2005

Cool ca marche :D
Mais j'ai vu qe ca cree le racourcis dans le meme dossier que le prog, donc avec Filecopy on le deplace et puis le tour est jouer ;)

Merci beaucoup
0