|
Shell "command.com /c dir *.* > c:\liste.txt" |
| Vous trouverez une méthode possible dans le code source ci-dessous. La procédure KillApp() ferme le programme dont l'identifiant est passé en paramètre. Vous pouvez utiliser la valeur renvoyée par la fonction Shell(). La seule ligne contenue dans la procédure KillApp() a pour effet d'énumérer toutes les fenêtres ouvertes, et d'appeler pour chacune d'entre-elles la fonction CloseWindow().
La fonction CloseWindow() regarde si la fenêtre en cours appartient au processus que l'on doit fermer, et si elle contient un menu Système (menu qui apparaît quand on clique sur l'icône de la fenêtre). Si c'est le cas, elle ferme la fenêtre. Insérez ce code dans un module standard: Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, _
lpdwprocessid As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Const WM_CLOSE = &H10
Private Const GWL_STYLE = (-16)
Private Const WS_SYSMENU = &H80000
Private Function CloseWindow(ByVal hwnd As Long, ByVal hInstance As Long) As Long
Dim idproc As Long
idproc = 0
GetWindowThreadProcessId hwnd, idproc
If (idproc = hInstance) And ((GetWindowLong(hwnd, GWL_STYLE) And WS_SYSMENU) = WS_SYSMENU) Then
PostMessage hwnd, WM_CLOSE, 0, 0
End If
CloseWindow = True
End Function
Public Sub KillApp(hInstance As Long)
EnumWindows AddressOf CloseWindow, hInstance
End SubCertains programmes n'acceptent pas d'être ouverts plusieurs fois en même temps. Pour cela, ils commencent par chercher si une instance du programme est déjà en mémoire. Si c'est le cas, ils terminent l'instance qui vient d'être créée,
et si une nouvelle fenêtre doit être ouverte, c'est l'ancienne instance qui le fait. Avec ce code source vous ne pourrez donc pas, par exemple, fermer une fenêtre de l'explorateur Windows ouverte par Shell(),
car le processus dont l'id vous est renvoyé est automatiquement fermé, et la nouvelle fenêtre est ouverte par l'instance qui était déjà en mémoire. |
| Les fichiers .ini sont des fichiers texte utilisés pour enregistrer les options d'un programme. Ils sont composés
de sections, qui contiennent des clés auxquelles on peut donner une valeur. Par exemple :
[Affichage]
State=Maximized
Left=50
Top=80
[Sauvegarde]
Confirm=True
Auto=False
Pour pouvoir respectivement lire et écrire dans un fichier .ini, voici les décarations que vous devez ajouter dans votre module : Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
ByVal lpFileName As String) As LongVoici ci-dessous la fonction qui écrira une valeur pour la clé et dans la section indiquée. Notez que vous n'avez
pas besoin de créer le fichier s'il n'existe pas, car la fonction WritePrivateProfileString le fait pour vous. Private Function EcritDansFichierIni(Section As String, Cle As String, Valeur As String, Fichier As String) As Long
EcritDansFichierIni = WritePrivateProfileString(Section, Cle, Valeur, Fichier)
End Function Et voyons maintenant la fonction qui nous retournera la valeur d'une clé dans une section donnée.
ValeurParDefaut contient la valeur qui devra nous être retournée si le fichier n'existe pas, ou si aucune valeur
n'a été spécifiée pour la clé demandée : Private Function LitDansFichierIni(Section As String, Cle As String, Fichier As String, _
Optional ValeurParDefaut As String = "") As String
Dim strReturn As String
strReturn = String(255, 0)
GetPrivateProfileString Section, Cle, ValeurParDefaut, strReturn, Len(strReturn), Fichier
LitDansFichierIni = Left(strReturn, InStr(strReturn, Chr(0)) - 1)
End FunctionLe code nécessaire pour écrire la section [Affichage] du fichier donné en exemple sera : EcritDansFichierIni "Affichage", "State", "Maximized", "c:\config.ini"
EcritDansFichierIni "Affichage", "Left", "50", "c:\config.ini"
EcritDansFichierIni "Affichage", "Top", "80", "c:\config.ini" Et nous pourrons lire la valeur donnée à la clef "Left" avec : LeftParam = LitDansFichierIni("Affichage", "Left", "c:\config.ini", 100) |
| Placez cette déclaration dans le module d'une form : Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongLa ligne suivante affiche le site Developpez.com dans le navigateur par défaut, en fournissant le répertoire de votre application comme répertoire par défaut : ShellExecute Me.hwnd, "open", "http://www.developpez.com", "", App.Path, 1 |
lien : Comment exécuter un programme ?
|
| Dim x As Long, y As Long
x = Screen.Width / Screen.TwipsPerPixelX
y = Screen.Height / Screen.TwipsPerPixelY |
| Copiez ce code source dans un module. Vous pourrez alors changer la résolution par un simple appel à la procédure ResolutionEcran(). Pour passer par exemple à une résolution de 800 x 600 : Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
(ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" _
(lpDevMode As Any, ByVal dwflags As Long) As Long
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DM_WIDTH = &H80000
Private Const DM_HEIGHT = &H100000
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public Sub ResolutionEcran(sgWidth As Long, sgHeight As Long)
Dim blTMP As Boolean, lgTMP As Long, dmEcran As DEVMODE, res As Long
lgTMP = 0
Do
blTMP = EnumDisplaySettings(0, lgTMP, dmEcran)
lgTMP = lgTMP + 1
Loop While blTMP <> 0
dmEcran.dmFields = DM_WIDTH Or DM_HEIGHT
dmEcran.dmPelsWidth = sgWidth
dmEcran.dmPelsHeight = sgHeight
lgTMP = ChangeDisplaySettings(dmEcran, 0)
End Sub |
| Cochez Microsoft MAPI Controls 6.0 dans la liste des composants. MAPISession1.SignOn
MAPIMessages1.MsgIndex = -1
MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.RecipDisplayName = "toto@domaine.fr"
MAPIMessages1.MsgSubject = "Un petit bonjour"
MAPIMessages1.MsgNoteText = "Salut."
MAPIMessages1.Send
MAPISession1.SignOff |
| auteur : Romain Puyfoulhoux
| Placez cette ligne dans la partie Déclarations d'un module : Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Vous pourrez ainsi faire une pause de 2 secondes avec l'appel suivant : |
| Les paramètres régionaux s'obtiennent grâce à la fonction GetLocaleInfo() de l'API Windows. Les paramètres de cette fonction sont : locale : identifiant représentant le type d'information locale demandé (système ou utilisateur)
LCType : valeur indiquant quel paramètre doit être retrouvé. Ce doit être une des constantes LCTYPE
lpLCData : buffer recevant la valeur du paramètre demandé
cchData : longueur du buffer Voici les déclarations des deux fonctions dont vous aurez besoin, ainsi que quelques-unes des constantes LCTYPE disponibles : Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal locale As Long, _
ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Private Const LOCALE_IDATE = &H21
Private Const LOCALE_ILDATE = &H22
Private Const LOCALE_SCOUNTRY = &H6
Private Const LOCALE_SNATIVELANGNAME = &H4
Private Const LOCALE_STHOUSAND = &HF
Private Const LOCALE_SDECIMAL = &HE La fonction ci-dessous renvoie la valeur du paramètre régional dont la constante LCTYPE est passée en paramètre : Private Function ParametreRegional(parametre As Long) As String
Dim lngResultat As Long
Dim buffer As String
Dim pos As Integer
Dim locale As Long
locale = GetUserDefaultLCID()
lngResultat = GetLocaleInfo(locale, parametre, buffer, 0)
buffer = String(lngResultat, 0)
GetLocaleInfo locale, parametre, buffer, lngResultat
pos = InStr(buffer, Chr(0))
If pos > 0 Then ParametreRegional = Left(buffer, pos - 1)
End Function |
| Voici deux solutions possibles. Tout d'abord, les fonctions de l'API Windows : 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
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As LongCes 3 fonctions de l'API Win32 renvoient respectivement les chemins complets des répertoires Windows, System, et Windows\Temp. Elles s'utilisent toutes les 3 de la même manière : Function GetWindowsDir() As String
Dim buffer As String * 256
Dim Length As Long
Length = GetWindowsDirectory(buffer, Len(buffer))
GetWindowsDir = Left(buffer, Length)
End Function
Function GetSystemDir() As String
Dim buffer As String * 256
Dim Length As Long
Length = GetSystemDirectory(buffer, Len(buffer))
GetSystemDir = Left(buffer, Length)
End Function
Function GetTempDir() As String
Dim buffer As String * 256
Dim Length As Long
Length = GetTempPath(Len(buffer), buffer)
GetTempDir = Left(buffer, Length)
End Function Une autre manière de procèder est de faire appel au FileSystemObject : Dim fso As FileSystemObject
Set fso = New FileSystemObject
MsgBox fso.GetSpecialFolder(0)
MsgBox fso.GetSpecialFolder(1)
MsgBox fso.GetSpecialFolder(2)
Set fso = Nothing
End Sub |
| Pour récupérer les chemins complets des répertoires du Bureau, de Mes Documents, ou du menu Démarrer, vous pouvez utiliser la fonction SHGetSpecialFolderPath de l'Api Windows : Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _
(ByVal hwndOwner As Long, ByVal lpszPath As String, ByVal nFolder As Long, ByVal fCreate As Long) As LongDescription des paramètres : hwndOwner : handle de la fenêtre à utiliser si une boîte de dialogue doit être affichée lpszPath : chaîne de caractères recevant le chemin complet du répertoire demandé
nFolder : nombre indiquant le répertoire demandé fCreate : si la valeur passée à ce paramètre n'est pas nulle, le répertoire est créé, s'il n'existe pas déjà Sous Windows NT 4.0 et Windows 95, cette fonction n'est disponible que si Internet Explorer 4.0 ou supérieur est installé. Voyons comment l'utiliser : Public Function GetSpecialFolderPath(dossier As Long, hwnd As Long)
Dim buffer As String
buffer = Space(256)
SHGetSpecialFolderPath hwnd, buffer, dossier, 0
GetSpecialFolderPath = Left(buffer, InStr(buffer, Chr(0)) - 1)
End Function Pour tester cette fonction, placez par exemple ces 3 lignes dans une procédure du module d'une form : MsgBox GetSpecialFolderPath(0, Me.hwnd)
MsgBox GetSpecialFolderPath(5, Me.hwnd)
MsgBox GetSpecialFolderPath(11, Me.hwnd) Les réfractaires aux Api Windows préfèreront utiliser le Windows Script Host Object Model en ajoutant wshom.ocx aux références du projet. Les chemins complets des répertoires spéciaux sont dans la collection SpecialFolders de l'objet IWshShell_Class. Dim WshShell As IWshShell_Class
Set WshShell = New IWshShell_Class
MsgBox WshShell.SpecialFolders.Item("Desktop")
MsgBox WshShell.SpecialFolders.Item("MyDocuments")
MsgBox WshShell.SpecialFolders.Item("StartMenu")
Set WshShell = nothing
End Sub |
| Première possibilité, l'api GetVolumeInformation, dont voici la déclaration : Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _
(ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As LongCette fonction, qui permet d'obtenir diverses informations à propos d'un lecteur, s'utilise très simplement. Ces quelques lignes affichent le numéro de série du lecteur C : Dim numero As Long
GetVolumeInformation "c:\", "", 0, numero, 0, 0, "", 0
MsgBox numero Mais vous pouvez obtenir cette même information avec le FileSystemObject : Dim fso As FileSystemObject
Set fso = New FileSystemObject
MsgBox fso.Drives("c").SerialNumber
Set fso = Nothing |
| Vous trouverez un exemple pas à pas avec le code source dans le  Howto de MSDN. |
Ce document issu de http://www.developpez.com est soumis à la licence GNU FDL traduit en français ici.
Permission vous est donnée de distribuer, modifier des copies de cette page tant que cette note apparaît clairement.
|
