CommonDialog
ghans
Messages postés
12
Date d'inscription
mardi 16 juillet 2002
Statut
Membre
Dernière intervention
14 juin 2005
-
16 juil. 2002 à 09:24
PatDeLaYaute Messages postés 133 Date d'inscription dimanche 28 avril 2002 Statut Membre Dernière intervention 15 janvier 2009 - 16 juil. 2002 à 10:14
PatDeLaYaute Messages postés 133 Date d'inscription dimanche 28 avril 2002 Statut Membre Dernière intervention 15 janvier 2009 - 16 juil. 2002 à 10:14
1 réponse
PatDeLaYaute
Messages postés
133
Date d'inscription
dimanche 28 avril 2002
Statut
Membre
Dernière intervention
15 janvier 2009
3
16 juil. 2002 à 10:14
16 juil. 2002 à 10:14
salut, voici le code pour récupérer plusieurs chemin d'accès aux dossiers système. Copie tout ca dans un fichier texte et renomme le en Form1.frm
VERSION 4.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 5400
ClientLeft = 3765
ClientTop = 3195
ClientWidth = 5070
Height = 5805
Left = 3705
LinkTopic = "Form1"
ScaleHeight = 5400
ScaleWidth = 5070
Top = 2850
Width = 5190
Begin VB.Frame Frame1
Caption = "Dossier à retrouver :"
Height = 4335
Left = 240
TabIndex = 1
Top = 120
Width = 4575
Begin VB.OptionButton Option1
Caption = "Favoris"
Height = 255
Index = 4
Left = 240
TabIndex = 21
Top = 1440
Width = 2415
End
Begin VB.OptionButton Option1
Caption = "Bureau"
Height = 255
Index = 1
Left = 240
TabIndex = 20
Top = 360
Width = 2175
End
Begin VB.OptionButton Option1
Caption = "Windows"
Height = 255
Index = 19
Left = 2760
TabIndex = 2
Top = 3480
Width = 1335
End
Begin VB.OptionButton Option1
Caption = "Cache Internet"
Height = 255
Index = 16
Left = 2760
TabIndex = 19
Top = 2280
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "PrintHood"
Height = 255
Index = 15
Left = 2760
TabIndex = 18
Top = 1920
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Historique"
Height = 255
Index = 18
Left = 2760
TabIndex = 17
Top = 3000
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Cookies"
Height = 255
Index = 17
Left = 2760
TabIndex = 16
Top = 2640
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Application Data"
Height = 255
Index = 14
Left = 2760
TabIndex = 15
Top = 1560
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "All users\Bureau"
Height = 255
Index = 13
Left = 2760
TabIndex = 14
Top = 1200
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "ShellNew"
Height = 255
Index = 12
Left = 2760
TabIndex = 13
Top = 840
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Démarrer\Programmes\Démarrer"
Height = 375
Index = 5
Left = 240
TabIndex = 12
Top = 1800
Width = 2415
End
Begin VB.OptionButton Option1
Caption = "MesDocuments"
Height = 255
Index = 3
Left = 240
TabIndex = 11
Top = 1080
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Fonts"
Height = 255
Index = 11
Left = 2760
TabIndex = 10
Top = 480
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Voisinnage Réseau"
Height = 255
Index = 10
Left = 240
TabIndex = 9
Top = 3600
Width = 2175
End
Begin VB.OptionButton Option1
Caption = "Bureau"
Height = 255
Index = 9
Left = 240
TabIndex = 8
Top = 3240
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Menu Démarrer"
Height = 255
Index = 8
Left = 240
TabIndex = 7
Top = 2880
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "SendTo"
Height = 255
Index = 7
Left = 240
TabIndex = 6
Top = 2520
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Recents"
Height = 255
Index = 6
Left = 240
TabIndex = 5
Top = 2160
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Démarrer\Programmes"
Height = 255
Index = 2
Left = 240
TabIndex = 4
Top = 720
Width = 2175
End
Begin VB.OptionButton Option1
Caption = "Windows\System"
Height = 255
Index = 20
Left = 2760
TabIndex = 3
Top = 3840
Width = 1575
End
End
Begin VB.CommandButton Command1
Caption = "Command1"
Default = -1 'True
Height = 495
Left = 1920
TabIndex = 0
Top = 4680
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
'Constantes et APIs nécessaires
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
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
'Pour les répertoires Windows et System :
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Function DossierSpecial(ByVal CSIDL As Long) As String
'récupère un dossier spécial style c:\windows, c:\windows\recent...
'variables nécessaires
Dim r As Long
Dim sPath As String
Dim IDL As ITEMIDLIST
Const NOERROR = 0
Const MAX_LENGTH = 260
'cherche le dossier spécial
r = SHGetSpecialFolderLocation(Form1.hWnd, CSIDL, IDL)
If r = NOERROR Then
'Recherche le dossier spécial à partir
'du "Type" IDL
sPath = Space$(MAX_LENGTH)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
If r Then
DossierSpecial = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If
End If
End Function
Private Sub Command1_Click()
Dim i As Integer
Dim IndexCliqué As Integer
Dim NumRep As Integer
'Pour les dossiers Windows et System
Dim str As String * 128
Dim TailleChemin As Integer
'Trouve l'index du bouton radio sélectionné
For i = 1 To 20 If Option1(i).Value True Then IndexCliqué i
Next i
If IndexCliqué <= 18 Then 'La méthode est différente pour les dossiers Windows et System que pour les autres
Select Case IndexCliqué
Case 1: NumRep = 0
Case 2: NumRep = 2
Case 3: NumRep = 5
Case 4: NumRep = 6
Case 5: NumRep = 7
Case 6: NumRep = 8
Case 7: NumRep = 9
Case 8: NumRep = 11
Case 9: NumRep = 16
Case 10: NumRep = 19
Case 11: NumRep = 20
Case 12: NumRep = 21
Case 13: NumRep = 25
Case 14: NumRep = 26
Case 15: NumRep = 27
Case 16: NumRep = 32
Case 17: NumRep = 33
Case 18: NumRep = 34
End Select
MsgBox DossierSpecial(NumRep) 'affiche le dossier voulu
Else 'Pour Windows et System
If IndexCliqué = 19 Then 'Si Windows
TailleChemin = GetWindowsDirectory(str, 128)
MsgBox Left(str, TailleChemin)
ElseIf IndexCliqué = 20 Then 'Si System
TailleChemin = GetSystemDirectory(str, 128)
MsgBox Left(str, TailleChemin)
End If
End If
End Sub
Private Sub Form_Load()
'************************************************************
'* NOM : Dossiers Spéciaux
'* DATE : 14/11/1998
'*
'* AUTEUR : Antoine de Montgolfier ( Antoine@vbasic.org )
'*
'* CODE TROUVE SUR "Le petit monde de Visual Basic"
'* http://www.vbasic.org
'*
'* DESCRIPTION :
'* Permet de retrouver le chemin des répertoires spéciaux
'* de Windows, comme le dossier contenant les Favoris,
'* celui du Menu Démarrer, et bien d'autres encore...
'* Ce code permet également de trouver le chemin des dossier
'* Windows et Windows\System.
'*
'************************************************************
End Sub
Et copie ca dans un autre fichier texte et renomme le en Projet1.vbp
Form=Form1.frm
ProjWinSize=82,830,194,128
ProjWinShow=2
HelpFile=""
Name="Projet1"
HelpContextID="0"
StartMode=0
VersionCompatible32="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="escom"
@+
VERSION 4.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 5400
ClientLeft = 3765
ClientTop = 3195
ClientWidth = 5070
Height = 5805
Left = 3705
LinkTopic = "Form1"
ScaleHeight = 5400
ScaleWidth = 5070
Top = 2850
Width = 5190
Begin VB.Frame Frame1
Caption = "Dossier à retrouver :"
Height = 4335
Left = 240
TabIndex = 1
Top = 120
Width = 4575
Begin VB.OptionButton Option1
Caption = "Favoris"
Height = 255
Index = 4
Left = 240
TabIndex = 21
Top = 1440
Width = 2415
End
Begin VB.OptionButton Option1
Caption = "Bureau"
Height = 255
Index = 1
Left = 240
TabIndex = 20
Top = 360
Width = 2175
End
Begin VB.OptionButton Option1
Caption = "Windows"
Height = 255
Index = 19
Left = 2760
TabIndex = 2
Top = 3480
Width = 1335
End
Begin VB.OptionButton Option1
Caption = "Cache Internet"
Height = 255
Index = 16
Left = 2760
TabIndex = 19
Top = 2280
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "PrintHood"
Height = 255
Index = 15
Left = 2760
TabIndex = 18
Top = 1920
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Historique"
Height = 255
Index = 18
Left = 2760
TabIndex = 17
Top = 3000
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Cookies"
Height = 255
Index = 17
Left = 2760
TabIndex = 16
Top = 2640
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Application Data"
Height = 255
Index = 14
Left = 2760
TabIndex = 15
Top = 1560
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "All users\Bureau"
Height = 255
Index = 13
Left = 2760
TabIndex = 14
Top = 1200
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "ShellNew"
Height = 255
Index = 12
Left = 2760
TabIndex = 13
Top = 840
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Démarrer\Programmes\Démarrer"
Height = 375
Index = 5
Left = 240
TabIndex = 12
Top = 1800
Width = 2415
End
Begin VB.OptionButton Option1
Caption = "MesDocuments"
Height = 255
Index = 3
Left = 240
TabIndex = 11
Top = 1080
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Fonts"
Height = 255
Index = 11
Left = 2760
TabIndex = 10
Top = 480
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Voisinnage Réseau"
Height = 255
Index = 10
Left = 240
TabIndex = 9
Top = 3600
Width = 2175
End
Begin VB.OptionButton Option1
Caption = "Bureau"
Height = 255
Index = 9
Left = 240
TabIndex = 8
Top = 3240
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Menu Démarrer"
Height = 255
Index = 8
Left = 240
TabIndex = 7
Top = 2880
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "SendTo"
Height = 255
Index = 7
Left = 240
TabIndex = 6
Top = 2520
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Recents"
Height = 255
Index = 6
Left = 240
TabIndex = 5
Top = 2160
Width = 1575
End
Begin VB.OptionButton Option1
Caption = "Démarrer\Programmes"
Height = 255
Index = 2
Left = 240
TabIndex = 4
Top = 720
Width = 2175
End
Begin VB.OptionButton Option1
Caption = "Windows\System"
Height = 255
Index = 20
Left = 2760
TabIndex = 3
Top = 3840
Width = 1575
End
End
Begin VB.CommandButton Command1
Caption = "Command1"
Default = -1 'True
Height = 495
Left = 1920
TabIndex = 0
Top = 4680
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
'Constantes et APIs nécessaires
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST
mkid As SHITEMID
End Type
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
'Pour les répertoires Windows et System :
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Function DossierSpecial(ByVal CSIDL As Long) As String
'récupère un dossier spécial style c:\windows, c:\windows\recent...
'variables nécessaires
Dim r As Long
Dim sPath As String
Dim IDL As ITEMIDLIST
Const NOERROR = 0
Const MAX_LENGTH = 260
'cherche le dossier spécial
r = SHGetSpecialFolderLocation(Form1.hWnd, CSIDL, IDL)
If r = NOERROR Then
'Recherche le dossier spécial à partir
'du "Type" IDL
sPath = Space$(MAX_LENGTH)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)
If r Then
DossierSpecial = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If
End If
End Function
Private Sub Command1_Click()
Dim i As Integer
Dim IndexCliqué As Integer
Dim NumRep As Integer
'Pour les dossiers Windows et System
Dim str As String * 128
Dim TailleChemin As Integer
'Trouve l'index du bouton radio sélectionné
For i = 1 To 20 If Option1(i).Value True Then IndexCliqué i
Next i
If IndexCliqué <= 18 Then 'La méthode est différente pour les dossiers Windows et System que pour les autres
Select Case IndexCliqué
Case 1: NumRep = 0
Case 2: NumRep = 2
Case 3: NumRep = 5
Case 4: NumRep = 6
Case 5: NumRep = 7
Case 6: NumRep = 8
Case 7: NumRep = 9
Case 8: NumRep = 11
Case 9: NumRep = 16
Case 10: NumRep = 19
Case 11: NumRep = 20
Case 12: NumRep = 21
Case 13: NumRep = 25
Case 14: NumRep = 26
Case 15: NumRep = 27
Case 16: NumRep = 32
Case 17: NumRep = 33
Case 18: NumRep = 34
End Select
MsgBox DossierSpecial(NumRep) 'affiche le dossier voulu
Else 'Pour Windows et System
If IndexCliqué = 19 Then 'Si Windows
TailleChemin = GetWindowsDirectory(str, 128)
MsgBox Left(str, TailleChemin)
ElseIf IndexCliqué = 20 Then 'Si System
TailleChemin = GetSystemDirectory(str, 128)
MsgBox Left(str, TailleChemin)
End If
End If
End Sub
Private Sub Form_Load()
'************************************************************
'* NOM : Dossiers Spéciaux
'* DATE : 14/11/1998
'*
'* AUTEUR : Antoine de Montgolfier ( Antoine@vbasic.org )
'*
'* CODE TROUVE SUR "Le petit monde de Visual Basic"
'* http://www.vbasic.org
'*
'* DESCRIPTION :
'* Permet de retrouver le chemin des répertoires spéciaux
'* de Windows, comme le dossier contenant les Favoris,
'* celui du Menu Démarrer, et bien d'autres encore...
'* Ce code permet également de trouver le chemin des dossier
'* Windows et Windows\System.
'*
'************************************************************
End Sub
Et copie ca dans un autre fichier texte et renomme le en Projet1.vbp
Form=Form1.frm
ProjWinSize=82,830,194,128
ProjWinShow=2
HelpFile=""
Name="Projet1"
HelpContextID="0"
StartMode=0
VersionCompatible32="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="escom"
@+