bonjour,

comment utiliser la fonction GetOpenFileName avec vbs ?
(on trouve la librairie comdlg32.dll sur toutes les config windows)
(mais nécessite toujours le composant dynawrap )
pour la clarté de l'exemple, j'ai placé la classe Struct dans un fichier séparé

Struct_11.vbs :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
Class Struct ' v1.1
	Public Property Get Ptr '***************************************************** Propriété Ptr
		Ptr=GetBSTRPtr(sBuf)
	End Property
	Public Sub Add(sItem,sType,Data) '******************************************** Méthode Add
		Dim lVSize,iA,iB,iD
		iA=InStr(1,sType,"[",1)
		iB=InStr(1,sType,"]",1)
		iD="0"
		If iA>0	And iB>0 Then
			iD=Mid(sType,iA+1,iB-iA-1)
			If isNumeric(iD) Then
				sType=Left(sType,iA-1)
			Else
				Err.raise 10000,"Méthode Add","L'indice " & iD & " doit être numérique"
				Exit Sub
			End If
		End If
		Select Case UCase(sType)'************************************************* A COMPLETER AVEC D'AUTRES TYPES WIN32
		'OS 32bits...
		Case "DWORD","LONG","WPARAM","LPARAM","POINTX","POINTY","ULONG","HANDLE","HWND","HINSTANCE","HDC","WNDPROC","HICON","HCURSOR","HBRUSH"
			lVSize=4
		Case "LPBYTE","LPCTSTR","LPSTR","LPTSTR","LPPRINTHOOKPROC","LPSETUPHOOKPROC","LPOFNHOOKPROC","LPVOID","INT","UINT","LPARAM"
			lVSize=4
		Case "WORD"
			lVSize=2
		Case "BYTE"
			lVSize=1
		Case "TCHAR"
			If CLng(iD)<1 Then lVSize="254" Else lVSize=iD
		Case Else
			Err.raise 10000,"Méthode Add","Le type " & sType & " n'est pas un type Win32"
			Exit Sub
		End Select
		dBuf.Add sItem,lVSize
		sBuf=sBuf & String(lVSize/2+1,Chr(0))
		SetDataBSTR GetBSTRPtr(sBuf),lVSize,Data,iOffset
	End Sub
	Public Function GetItem(sItem) '********************************************** Méthode GetItem
		Dim lOf,lSi,aItems,aKeys,i
		If dBuf.Exists(sItem) then
			lSi=CLng(dBuf.Item(sItem))
			aKeys=dBuf.Keys
			aItems=dBuf.Items
			lOf=0
			For i=0	To dBuf.Count-1
				If aKeys(i)=sItem Then Exit For
				lOf=lOf+aItems(i)
			Next
			GetItem=GetDataBSTR(Ptr,lSi,lOf)
		Else
			GetItem=""
			err.raise 10000,"Méthode GetItem","L'item " & sItem & " n'existe pas"
		End If
	End Function
	Public Function GetBSTRPtr(ByRef sData)
	'renvoie la VRAIE adresse (variant long) de la chaine sData sans tenir compte du format variant BSTR
		Dim pSource 
		Dim pDest
		If VarType(sData)<>vbString Then 'vérification avant d'aller + loin
			GetBSTRPtr=0
			err.raise 10000, "GetBSTRPtr", "La variable fournie n'est pas une chaine"
			Exit Function
		End If
		'sData a été passée par	référence, c'est donc en réalité sBuf	 
		pSource=oSCat.lstrcat(sData,"")		'astuce qui renvoie le pointeur vers le début de sBuf
		pDest=oSCat.lstrcat(GetBSTRPtr,"")	'idem renvoie le pointeur vers la variable fonction 
		GetBSTRPtr=CLng(0)						'cast	de la variable fonction	qui doit renvoyer un format long 
		'l'adresse du contenu réel de sBuf (4octets) écrase le contenu de la variable GetBSTPtr	
		'les valeurs sont incrémentées de 8 octets pour	tenir compte du Type Descriptor
		oMM.RtlMovememory pDest+8,pSource+8,4 
	End Function
'******************************************************************************************************* IMPLEMENTATION
	Private oMM,oSCat,oAnWi 'objets wrapper API
	Private dBuf,sBuf,iOffset 
	Private	Sub Class_Initialize 'Constructeur
		Set oMM=CreateObject("DynamicWrapper")
		oMM.Register "kernel32.dll","RtlMoveMemory","f=s","i=lll","r=l"	'pour manipuler directement la mémoire
		Set oSCat=CreateObject("DynamicWrapper")
		oSCat.Register "kernel32.dll","lstrcat","f=s","i=ws","r=l"		 	'pour obtenir l'adresse d'une variable
		Set oAnWi=CreateObject("DynamicWrapper")						
  		oAnWi.Register "kernel32.dll","MultiByteToWideChar","f=s","i=llllll","r=l" 'gestion conversion ansi->wide
		Set dBuf=CreateObject("Scripting.Dictionary")
		sBuf=""
		iOffset=0
	End Sub	
	Private Sub SetDataBSTR(lpData,iSize,Data,ByRef iOfs)
	'Place une valeur Data de taille iSize à l'adresse lpData+iOfs
		Dim lW,hW,xBuf
		Select Case iSize 	'on commence par formater les valeurs numériques
		Case 1
			lW=Data mod 256 	'formatage 8 bits
			xBuf=ChrB(lW)
		Case 2 					'if any
			lW=Data mod 65536 'formatage 16 bits
			xBuf=ChrW(lW)		'formatage little-endian
		Case 4
			hW=Fix(Data/65536)'high word
			lW=Data mod 65536 'low word
			xBuf=ChrW(lW) & ChrW(hW) 'formatage little-endian
		Case Else				'un tableau d'octets de taille iSize
			xBuf=Data
		End Select
		oMM.RtlMovememory lpData+iOfs,GetBSTRPtr(xBuf),iSize
		iOfs=iOfs+iSize 'maj l'offset
	End Sub
	Private Function GetDataBSTR(lpData,iSize,iOffset)
	'Lit une valeur de taille iSize à l'adresse lpData+iOffset
		Const CP_ACP=0 			'code ANSI	
		Dim pDest,tdOffset
		'valeurs pour les données numériques
		pDest=oSCat.lstrcat(GetDataBSTR,"")
		tdOffset=8
		Select Case iSize ' cast de la variable fonction
		Case 1
			GetDataBSTR=CByte(0)
		Case 2
			GetDataBSTR=CInt(0)
		Case 4
			GetDataBSTR=CLng(0)
		Case Else	'un peu + compliqué pour une donnée chaine...
  			GetDataBSTR=String(iSize/2,Chr(0))
  			'la chaine variant BSTR stocke ses données ailleurs
			pDest=GetBSTRPtr(GetDataBSTR)
			tdOffset=0
		End Select
		'le contenu de la structure à l'offset iOffset écrase le contenu de la variable GetDataBSTR (tenir compte du TD)
		oMM.RtlMovememory pDest+tdOffset,lpData+iOffset,iSize 
		if tdOffset=0 Then
			oAnWi.MultiByteToWideChar CP_ACP,0,lpData+iOffset,-1,pDest,iSize 'ne pas oublier la conversion Ansi->Wide
			GetDataBSTR=Replace(GetDataBSTR,Chr(0),"") 							  'on nettoye le trailer
		End If
	End Function 
End Class
OpenFileName.wsf :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
<job>
<script language="VbScript" src="Struct_11.vbs">
Option Explicit
'*******************************************************************************************************************
'* Boite de dialogue pour choisir un fichier uniquement par des appels à l'API de Windows						 			 *	
'* Utilise la classe Struct v1.1	(la méthode GetBSTRPtr est maintenant publique)										 		 *
'*	v 1.0																																				 *
'* syntaxe Win NT4 et >																															 *
'* omen999 mai 2007																	 			   		 			
'*******************************************************************************************************************
Const OFN_ALLOWMULTISELECT=&h200
Const OFN_CREATEPROMPT=&h2000
Const OFN_ENABLEHOOK=&h20
Const OFN_ENABLETEMPLATE=&h40
Const OFN_ENABLETEMPLATEHANDLE=&h80
Const OFN_EXPLORER=&h80000             
Const OFN_EXTENSIONDIFFERENT=&h400
Const OFN_FILEMUSTEXIST=&h1000
Const OFN_HIDEREADONLY=&h4
Const OFN_LONGNAMES=&h200000           
Const OFN_NOCHANGEDIR=&h8
Const OFN_NODEREFERENCELINKS=&h100000
Const OFN_NOLONGNAMES=&h40000          
Const OFN_NONETWORKBUTTON=&h20000
Const OFN_NOREADONLYRETURN=&h8000
Const OFN_NOTESTFILECREATE=&h10000
Const OFN_NOVALIDATE=&h100
Const OFN_OVERWRITEPROMPT=&h2
Const OFN_PATHMUSTEXIST=&h800
Const OFN_READONLY=&h1
Const OFN_SHAREAWARE=&h4000
Const OFN_SHAREFALLTHROUGH=2
Const OFN_SHARENOWARN=1
Const OFN_SHAREWARN=0
Const OFN_SHOWHELP=&H10
 
Dim aFilter(5),sFilters
Dim sFullFileName,sFileName,sInitDir,sDefExt,sTitre
Dim oDlg,OPENFILENAME,lRc
'instanciation de l'objet wrapper
Set oDlg=CreateObject("DynamicWrapper")
 
'définition des paramètres de la boite
aFilter(0)="Tous fichiers (*.*)"
aFilter(1)="*.*"
aFilter(2)="Fichiers script (*.wsf | *.vbs)"
aFilter(3)="*.wsf;*.vbs"
aFilter(4)="Fichiers texte (*.txt)"
aFilter(5)="*.txt"
sFilters=Join(aFilter,vbNullChar) & vbNullChar & vbNullChar
sFullFileName=string(1024,chr(0)) 'peut contenir un nom complet de fichier qui sera proposé comme le fichier par défaut
sFileName=string(128,chr(0))
sInitDir="C:\"
sTitre="Choisissez votre fichier avec omen999"
sDefExt="vbs"
 
oDlg.Register "comdlg32.dll","GetOpenFileNameW","f=s","i=l","r=l"
Set OPENFILENAME=New Struct
With OPENFILENAME
    .Add "lStructSize","DWORD",76   							 'OPENFILENAME_SIZE_VERSION_400 
    .Add "hwndOwner","HWND",0										 'handle de la fenêtre parent (peut être nul)
    .Add "hInstance","HINSTANCE",0								 'inutilisable
    .Add "lpstrFilter","LPCTSTR",.GetBSTRPtr(sFilters) 	 'filtre d'affichage
  	 .Add "lpstrCustomFilter","LPTSTR",0 						 'inutilisable 
    .Add "nMaxCustFilter","DWORD",0                       'inutilisable   
    .Add "nFilterIndex","DWORD",2   							 'sélectionne le 2ème filtre par défaut 
    .Add "lpstrFile","LPTSTR",.GetBSTRPtr(sFullFileName)	 'fichier avec chemin complet 
    .Add "nMaxFile","DWORD",1024     							 'taille du buffer fichier (min: 256)
    .Add "lpstrFileTitle","LPTSTR",.GetBSTRPtr(sFileName) 'nom du fichier seul
    .Add "nMaxFileTitle","DWORD",128  						 	 'taille du nom fichier 
    .Add "lpstrInitialDir","LPCTSTR",.GetBSTRPtr(sInitDir)'répertoire par défaut
    .Add "lpstrTitle","LPCTSTR",.GetBSTRPtr(sTitre)		 'titre de la boite de dialogue (facultatif)
    .Add "Flags","DWORD",0											 'flags (voir ci-dessus la liste des options) 
    .Add "nFileOffset","WORD",0                           'offset nom fichier (valeur renvoyée)
    .Add "nFileExtension","WORD",0								 'offset extension (valeur renvoyée)
    .Add "lpstrDefExt","LPCTSTR",.GetBSTRPtr(sDefExt)     'extension par défaut si l'utilisateur l'oublie
    .Add "lCustData","LPARAM",0									 'inutilisable 
    .Add "lpfnHook","LPOFNHOOKPROC",0							 'inutilisable 
    .Add "lpTemplateName","LPCTSTR",0 							 'inutilisable 
 
    lRc=oDlg.GetOpenFileNameW(.Ptr)
    if lRc <> 0 then 
      'nettoyage trailer
      sFullFileName=Replace(sFullFileName,Chr(0),"") 
      sFileName=Replace(sFileName,Chr(0),"")
    	Msgbox sFullFileName & vbCrLf & sFileName & vbCrLf & "Offset fichier: " & .GetItem("nFileOffset") & _
    	vbCrLf & "Offset extension: " & .GetItem("nFileExtension")
    end if
End With
</script>
</job>