[Sources] Utiliser la boite de dialogue sélection d'un fichier avec l'API

**omen999** · 10/05/2007, 13h51

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>

**Neuromancien2** · 11/09/2007, 18h01

Avec ce code, j'obtiens l'erreur : Un composant ActiveX ne peut pas créer un objet DynamicWrapper.

**SfJ5Rpw8** · 11/09/2007, 18h08

Envoyé par omen999

....
elle nécessite le composant dynawrap dispo ici: http://ourworld.compuserve.com/homep...SHDynaCall.htm

**Patrick22** · 25/01/2022, 16h45

Bonjour,

Un des côtés positifs du web c'est de conserver souvent les données et d'éviter de ré-inventer la roue.
Ce fil est ancien mais il correspond à ce que je recherche : En finir avec les boîtes de sélection de fichier.

J'ai copié les scripts et suite à la même sanction que Neuromancien2 :

Avec ce code, j'obtiens l'erreur : Un composant ActiveX ne peut pas créer un objet DynamicWrapper.

j'ai cherché, et trouvé, ce lien : https://omen999.developpez.com/tutor...wrapperx-v2-0/
A la décompression du fichier zip "Dynwrapx2.0.0.0.zip", WindowsDefender s'est affolé 'Grave' sur la version x32 mais pas sur celle x64.
1ère incompréhension: Pourquoi tant de haine sur la version x32 et pas celle x64 ?

Passons, je n'ai enregistré en BDR que la version x64, puis à la ré-exécution du script copié j'obtiens maintenant l'erreur suivante :

Script: D:\...\OpenFileName.wsf
Line: 67
Char.: 4
Error: Argument type can't be coerced into the parameter
Source: DynamicWrapperX.2

En fait cela semble provenir de la ligne 67 de "Struct-11.vbs" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

pDest=oSCat.lstrcat(GetBSTRPtr,"")	'idem renvoie le pointeur vers la variable fonction

2èmes questions : Est-ce à cause du wrapper utilisé ? Comment éviter ça ?

En suivant le lien sur le forum russe depuis la page sur "DynamicWrapX v2.0", je suis arrivé à une de vos réponses qui donnent un lien de chargement de la version 2.0.0.1 de ce wrapper : http://yuripopov.ucoz.net/load/0-0-0-8-20
Malheureusement ce lien affiche une page de refus :
Pièce jointe 612471
(Désolé pour le gigantisme de cette image, l'éditeur de message ne semble pas permettre l'affichage d'images à leur taille réelle.)
3ème interrogation : ?

Tous mes remerciements pour votre travail, sa qualité, et votre ténacité.

**omen999** · 26/01/2022, 22h22

bonjour,

2èmes questions : Est-ce à cause du wrapper utilisé ? Comment éviter ça ?

mes contributions anciennes sur ce sujet - enfin celles qui ont survécu

- utilisent le composant COM "historique" dynamicwrapper
écrit au siècle dernier par Jeff Stong et complété par quelques autres développeurs
il est toujours disponible dans sa forme définitive ici (prendre la version NT)
après enregistrement dans la bdr, il devrait donner entière satisfaction avec la contribution que tu as récupérée
je viens d'ailleurs de vérifier auprès de VirusTotal et le fichier dynwrap.dll passe l'examen virginal avec succès
en revanche, ces contributions ne sont pas compatibles avec les différents wrappers écrits par Yuri Popov

1ère incompréhension: Pourquoi tant de haine sur la version x32 et pas celle x64 ?

le DynamicWrapperX disponible dans sa dernière version v2.2.0.0 ici a été utilisé il y a quelques années par une poignée de
hackers besogneux pour les aider à déposer leur charge virale sur les systèmes qu'ils voulaient compromettre
mais il faut bien comprendre que ce composant est un simple outil et ne contient en soi aucun code malveillant
c'est tellement vrai que j'ai également fait un test sur VirusTotal avec sa dernière version v2.2 :
version x64 : 19 sur 65 signalent un fichier suspect "générique"
version x86 : 11 sur 64 signalent un fichier suspect "générique"
en résumé 8 éditeurs le signalent en version 64 bits et pas en 32...

ça reflète simplement le fait que de nombreux éditeurs sont désarmés face à la vague des malwares et préfèrent utiliser
des raccourcis douteux pour se faciliter la tâche
le seul dont je vérifie l'avis est kaspersky qui est à mon sens le moins nul de la bande

[Sources] Utiliser la boite de dialogue sélection d'un fichier avec l'API

Vos Contributions VBScript

Discussions similaires

Partager

Partager