Comment créer un raccourcis d'exe vers le bureau de windows en VB5
cs_Turakam
Messages postés
32
Date d'inscription
samedi 31 août 2002
Statut
Membre
Dernière intervention
26 juin 2005
-
31 août 2002 à 20:23
cs_Turakam Messages postés 32 Date d'inscription samedi 31 août 2002 Statut Membre Dernière intervention 26 juin 2005 - 3 sept. 2002 à 12:37
cs_Turakam Messages postés 32 Date d'inscription samedi 31 août 2002 Statut Membre Dernière intervention 26 juin 2005 - 3 sept. 2002 à 12:37
A voir également:
- Comment créer un raccourcis d'exe vers le bureau de windows en VB5
- Comment créer un mot caché - Forum C# / .NET
- Comment créer un mot mélé - Forum Java
- Créer un bulletin scolaire en ligne - Forum PHP
- Winhlp32.exe windows 7 ✓ - Forum Delphi / Pascal
- Créer un emploi du temps en ligne - Forum Java
2 réponses
TFlorian
Messages postés
194
Date d'inscription
dimanche 3 mars 2002
Statut
Membre
Dernière intervention
19 décembre 2005
3
2 sept. 2002 à 23:45
2 sept. 2002 à 23:45
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
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
cs_Turakam
Messages postés
32
Date d'inscription
samedi 31 août 2002
Statut
Membre
Dernière intervention
26 juin 2005
3 sept. 2002 à 12:37
3 sept. 2002 à 12:37
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
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