VB6之切换桌面

Desktop的API，用于切换或者系统桌面环境。扩展起来可以做一个锁屏程序或者多桌面程序。

模块部分：

 'desktop.bas
 'too much struct and declare unused, shame~
 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 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 UnregisterHotKey Lib "user32" (ByVal hwnd As Long, _
     ByVal id 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
     ByVal nIndex 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 =
 Public Const CCHFORMNAME =
 Public Const MOD_CONTROL = &H2
 Public Const WM_HOTKEY = &H312
 Public Const GWL_WNDPROC = -

 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 MAXIMUM_ALLOWED = &H2000000
 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 = 

 Public HotKeyID1 As Long
 Public HotKeyID2 As Long
 Public hwndOldDesktop As Long
 Public hwndNewDesktop As Long
 Public NEW_DESKTOP_NAME As String
 Public OldWndProc As Long

 Public Function CallBackWndProc(ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wparam As Long, _
     ByVal lparam As Long) As Long

     If wMsg = WM_HOTKEY Then
         If wparam = HotKeyID1 And hwndNewDesktop Then
             'Ctrl+W, switch it to new
             Call SwitchDesktop(hwndNewDesktop)
             Debug.Print "i am new desktop, u c?"
         ElseIf wparam = HotKeyID2 Then
             'Ctrl+Q, switch it to old
             Call SwitchDesktop(hwndOldDesktop)
             Debug.Print "i am back to old desktop, yeah!"
         End If
     End If

     CallBackWndProc = CallWindowProc(OldWndProc, hwnd, wMsg, wparam, lparam)
 End Function

窗体部分：

 'code by lichmama from cnblogs.com
 Private Sub Form_Load()
     HotKeyID1 = &
     HotKeyID2 = &

     hwndOldDesktop = GetThreadDesktop(App.ThreadID)
     NEW_DESKTOP_NAME = "myNewDesktop-VB6.0"
     Call RegisterHotKey(Me.hwnd, HotKeyID1, MOD_CONTROL, vbKeyW)
     Call RegisterHotKey(Me.hwnd, HotKeyID2, MOD_CONTROL, vbKeyQ)
     hwndNewDesktop = OpenDesktop(NEW_DESKTOP_NAME, &, False, DESKTOP_ALL)
     If hwndNewDesktoop =  Then
         '如果新桌面不存在，则创建一个
         hwndNewDesktop = CreateDesktop(NEW_DESKTOP_NAME, vbNullString, ByVal &, &, MAXIMUM_ALLOWED, ByVal &)
     End If
     If hwndNewDesktop =  Then
         Debug.Print "new desktop create failed"
     End If
     OldWndProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
     Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf CallBackWndProc)
 End Sub

 Private Sub Form_Unload(Cancel As Integer)
     Call SetWindowLong(Me.hwnd, GWL_WNDPROC, OldWndProc)
     Call UnregisterHotKey(Me.hwnd, HotKeyID1)
     Call UnregisterHotKey(Me.hwnd, HotKeyID1)
 End Sub