VB and VBA Users Source Code: Displaying the various control panel applets
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Displaying the various control panel applets
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, July 22, 2002
Hits:
1172
Category:
Windows API
Article:
The following code demonstrates how to show the various control panel applets. Option Explicit Private Const VER_PLATFORM_WIN32s = 0, VER_PLATFORM_WIN32_WINDOWS = 1, VER_PLATFORM_WIN32_NT = 2 Private Type OSVERSIONINFO OSVSize As Long dwVerMajor As Long dwVerMinor As Long dwBuildNumber As Long PlatformID As Long szCSDVersion As String * 128 End Type Public Type tOperatingInfo BuildNo As String PlatformID As Long VersionName As String VersionNo As String ServicePack As String End Type Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetActiveWindow Lib "user32" () As Long Public Enum eControlPanelOption eControlPanel eAccessKeyboard eAccessSound eAccessDisplay eAccessMouse eAccessGenereal eAddRemoveInstallAndUninstallPrograms eAddRemoveWindowsSetup eAddRemoveStartupDisk eDisplayBackground eDisplayScreenSaver eDisplayAppearance eDisplaySettings eRegionalSettings eRegionalNumber eRegionalCurrency eRegionalTime eRegionalDate eJoyStick eMainMouse eMainKeyboard eMainPrinters eMainFont eMailExchange eMediaAudio eMediaVideo eMediaMidi eMediaCD eMediaAdvanced eMediaSound eModem eNetworkConfiguration eODBCAdmin ePasswords eHardwardGeneral eHardwardDeviceManager eHardwardProfiles eHardwardPerformance eHardwardAdd eDateTime ePostOfficeAdmin End Enum 'Purpose : Shells the various applets within the control panel 'Inputs : eType The applet to open. ' [bWaitTillClosed] If True will wait till the applet has been closed by the user before returning 'Outputs : Returns True if opened the control panel applet. 'Author : Andrew Baker (copyright www.vbusers.com) 'Date : 28/04/2001 'Notes : Function ControlPanelRun(eType As eControlPanelOption, Optional bWaitTillClosed As Boolean = False) As Boolean On Error Resume Next Const SYNCHRONIZE = &H100000 Const WAIT_FAILED = -1&, WAIT_OBJECT_0 = 0 Dim sCommandLine As String, lTaskID As Long, lPID As Long, lRetVal As Long Dim lControlHwnd As Long, lAppHwnd As Long, lThisWait As Long lAppHwnd = GetForegroundWindow Select Case eType Case eControlPanel sCommandLine = """rundll32.exe"" shell32.dll, Control_RunDLL" Case eAccessKeyboard sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL access.cpl,,1" Case eAccessSound sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL access.cpl,,2" Case eAccessDisplay sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL access.cpl,,3" Case eAccessMouse sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL access.cpl,,4" Case eAccessGenereal sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL access.cpl,,5" Case eAddRemoveInstallAndUninstallPrograms sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL appwiz.cpl,,1" Case eAddRemoveWindowsSetup sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL appwiz.cpl,,2" Case eAddRemoveStartupDisk sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL appwiz.cpl,,3" Case eDisplayBackground sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL desk.cpl,,0" Case eDisplayScreenSaver sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL desk.cpl,,1" Case eDisplayAppearance sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL desk.cpl,,2" Case eDisplaySettings sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL desk.cpl,,3" Case eRegionalSettings sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL intl.cpl,,0" Case eRegionalNumber sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL intl.cpl,,1" Case eRegionalCurrency sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL intl.cpl,,2" Case eRegionalTime sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL intl.cpl,,3" Case eRegionalDate sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL intl.cpl,,4" Case eJoyStick sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL joy.cpl" Case eMainMouse sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL main.cpl @0" Case eMainKeyboard sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL main.cpl @1" Case eMainPrinters sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL main.cpl @2" Case eMainFont sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL main.cpl @3" Case eMailExchange sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL mlcfg32.cpl" Case eMediaAudio sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL mmsys.cpl,,0" Case eMediaVideo sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL mmsys.cpl,,1" Case eMediaMidi sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL mmsys.cpl,,2" Case eMediaCD sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL mmsys.cpl,,3" Case eMediaAdvanced sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL mmsys.cpl,,4" Case eMediaSound sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL mmsys.cpl @1" Case eModem sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL modem.cpl" Case eNetworkConfiguration If WinVersionInfo.VersionName = "Windows NT" Then sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL netcpl.cpl" Else sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL ncpa.cpl" End If Case eODBCAdmin sCommandLine = "ODBCAD32.EXE" Case ePasswords sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL password.cpl" Case eHardwardGeneral sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL sysdm.cpl,,0" Case eHardwardDeviceManager sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL sysdm.cpl,,1" Case eHardwardProfiles sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL sysdm.cpl,,2" Case eHardwardPerformance sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL sysdm.cpl,,3" Case eHardwardAdd sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL sysdm.cpl @1" Case eDateTime sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL timedate.cpl" Case ePostOfficeAdmin sCommandLine = """rundll32.exe"" shell32.dll,Control_RunDLL wgpocpl.cpl" End Select 'Shell the applet lTaskID = Shell(sCommandLine, vbNormalFocus) If lTaskID <> 0 And bWaitTillClosed Then 'Wait for user to close the applet lPID = OpenProcess(SYNCHRONIZE, False, lTaskID) If lPID = 0 Then 'Failed to get a valid process, wait for the window to be destroyed 'wait 5 secs for the control panel window to appear For lThisWait = 1 To 10 If lAppHwnd <> GetForegroundWindow Then 'New window displayed lControlHwnd = GetForegroundWindow Exit For End If DoEvents Sleep 500 Next 'Wait for window to close Do If IsWindow(lControlHwnd) = 0 Then 'Window has closed Exit Do End If DoEvents Sleep 200 Loop Else 'Got valid process handle Do lRetVal = WaitForSingleObject(lPID, 200) If lRetVal = WAIT_OBJECT_0 Then 'Finished process Exit Do ElseIf lRetVal = WAIT_FAILED Then 'Failed to open process Exit Do End If DoEvents Sleep 200 Loop lRetVal = CloseHandle(lPID) End If End If ControlPanelRun = lTaskID End Function 'Purpose : Determine information about the operating system 'Inputs : N/A 'Outputs : A type containing information on the operating system. 'Author : Andrew Baker 'Date : 17/01/2001 12:37 'Notes : 'Revisions : 'Assumptions : Public Function WinVersionInfo() As tOperatingInfo Dim OSV As OSVERSIONINFO Dim lPos As Integer Dim sVer As String, sBuild As String On Error Resume Next OSV.OSVSize = Len(OSV) If GetVersionEx(OSV) = 1 Then WinVersionInfo.PlatformID = OSV.PlatformID Select Case OSV.PlatformID Case VER_PLATFORM_WIN32s WinVersionInfo.VersionName = "Win32s" Case VER_PLATFORM_WIN32_NT WinVersionInfo.VersionName = "Windows NT" Case VER_PLATFORM_WIN32_WINDOWS 'Determine which version of windows Select Case OSV.dwVerMinor Case 0 WinVersionInfo.VersionName = "Windows 95" Case 90 WinVersionInfo.VersionName = "Windows ME" Case Else WinVersionInfo.VersionName = "Windows 98" End Select End Select 'Get version number WinVersionInfo.VersionNo = OSV.dwVerMajor & "." & OSV.dwVerMinor 'Get build WinVersionInfo.BuildNo = (OSV.dwBuildNumber And &HFFFF) 'Get the service pack. lPos = InStr(OSV.szCSDVersion, Chr$(0)) If lPos Then WinVersionInfo.ServicePack = Left$(OSV.szCSDVersion, lPos - 1) End If End If On Error GoTo 0 End Function 'Demonstration code Sub Test() If ControlPanelRun(eAddRemoveInstallAndUninstallPrograms, True) Then MsgBox "Shown the add remove programs control panel applet" Else MsgBox "Falied to add remove programs control panel applet" End If End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
