CreateDesktop实现虚拟桌面
'Module1
引用:
Public Declare Function GetThreadDesktop Lib "user32" (ByVal dwThread As Long) As Long
'Public Declare Function CreateDesktop Lib "user32" Alias "CreateDesktopA" (ByVal lpszDesktop As String, ByVal lpszDevice As String, pDevmode As DEVMODE, ByVal dwFlags As Long, ByVal dwDesiredAccess As Long, lpsa As SECURITY_ATTRIBUTES) As Long
Public Declare Function CreateDesktop Lib "user32" Alias "CreateDesktopA" (ByVal lpszDesktop As String, ByVal lpszDevice As String, pDevmode As Long, ByVal dwFlags As Long, ByVal dwDesiredAccess As Long, lpsa As Long) As Long
Public Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Public Declare Function SetThreadDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Public Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Public Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Boolean, ByVal dwDesiredAccess As Long) As Long
Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Long, lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' ---------------------------------------
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32
Public Const MOD_CONTROL = &H2
Public Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = -4
Public Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Public Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Public 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 Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
' ---------------------------------------
Public Const GENERIC_ALL = &H10000000
Public Const DESKTOP_SWITCHDESKTOP = &H100
Public Const DESKTOP_CREATEMENU = &H4&
Public Const DESKTOP_CREATEWINDOW = &H2&
Public Const DESKTOP_ENUMERATE = &H40&
Public Const DESKTOP_HOOKCONTROL = &H8&
Public Const DESKTOP_JOURNALPLAYBACK = &H20&
Public Const DESKTOP_JOURNALRECORD = &H10&
Public Const DESKTOP_READOBJECTS = &H1&
Public Const DESKTOP_WRITEOBJECTS = &H80&
Public Const DESKTOP_ALL = 511
Public Const MAXIMUM_ALLOWED = &H2000000
' ---------------------------------------
Public lpOldWinProc As Long
Public g_hDesktopThreadOld As Long '正常桌面句柄
Public g_hDesktopNew As Long, g_hDesktopNameNew As String '新建桌面的句柄和名称
Function myWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_HOTKEY Then
If wParam = 2 And g_hDesktopNew <> 0 Then
SwitchDesktop g_hDesktopNew
End If
If wParam = 1 Then
SwitchDesktop g_hDesktopThreadOld
End If
End If
myWindowProc = CallWindowProc(lpOldWinProc, hWnd, uMsg, wParam, lParam)
End Function
Sub StartMyExplore(theEXEStr As String )
Dim sui As STARTUPINFO, pi As PROCESS_INFORMATION
sui.cb = Len(sui)
sui.lpDesktop = g_hDesktopNameNew
CreateProcess vbNullString, theEXEStr, ByVal 0 &, ByVal 0 &, 1 , &H4000000 Or &H800 , ByVal 0 &, vbNullString, sui, pi
End Sub
'Form1引用:
Private Sub Command1_Click()
If g_hDesktopNew <> 0 Then
SwitchDesktop g_hDesktopNew '切换到新桌面
End If
End Sub
Private Sub Command2_Click()
StartMyExplore Text1.Text '在新桌面运行程序
End Sub
Private Sub Form_Load()
g_hDesktopThreadOld = GetThreadDesktop(App.ThreadID) '得到正常的桌面句柄
RegisterHotKey Me.hWnd, 1, MOD_CONTROL, Asc("Q") '注册热键
RegisterHotKey Me.hWnd, 2, MOD_CONTROL, Asc("W") '注册热键
g_hDesktopNameNew = "MyNewDesktop"
g_hDesktopNew = OpenDesktop(g_hDesktopNameNew, 0, False, DESKTOP_ALL) '如果新桌面已经存在，就打开它
If g_hDesktopNew = 0 Then
g_hDesktopNew = CreateDesktop(g_hDesktopNameNew, vbNullString, ByVal 0&, 0, MAXIMUM_ALLOWED, ByVal 0&) '如果不存在，就新建一个
End If
Call SetThreadDesktop(g_hDesktopNew) '此句将调用失败，必须createThread，使用多线程调用
lpOldWinProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf myWindowProc) '子类化主窗口，接收热键消息
End Sub
Private Sub Form_Unload(Cancel As Integer)
If g_hDesktopNew <> 0 Then
CloseDesktop g_hDesktopNew '关闭新建的桌面句柄
End If
SetWindowLong Me.hWnd, GWL_WNDPROC, lpOldWinProc
End Sub
