VB6之切换桌面

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

模块部分：

  1 'desktop.bas
  2 'too much struct and declare unused, shame~
  3 Public Declare Function GetThreadDesktop Lib "user32" (ByVal dwThread As Long) As Long
  4 Public Declare Function CreateDesktop Lib "user32" Alias "CreateDesktopA" (ByVal lpszDesktop As String, _
  5     ByVal lpszDevice As String, _
  6     pDevmode As Long, _
  7     ByVal dwFlags As Long, _
  8     ByVal dwDesiredAccess As Long, _
  9     lpsa As Long) As Long
 10 Public Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As Long
 11 Public Declare Function SetThreadDesktop Lib "user32" (ByVal hDesktop As Long) As Long
 12 Public Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
 13 Public Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, _
 14     ByVal dwFlags As Long, _
 15     ByVal fInherit As Boolean, _
 16     ByVal dwDesiredAccess As Long) As Long
 17 Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, _
 18     ByVal id As Long, _
 19     ByVal fsModifiers As Long, _
 20     ByVal vk As Long) As Long
 21 Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, _
 22     ByVal id As Long) As Long
 23 Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
 24     ByVal nIndex As Long, _
 25     ByVal dwNewLong As Long) As Long
 26 Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
 27     ByVal nIndex As Long) As Long
 28 Public Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, _
 29     ByVal lpCommandLine As String, _
 30     lpProcessAttributes As Long, _
 31     lpThreadAttributes As Long, _
 32     ByVal bInheritHandles As Long, _
 33     ByVal dwCreationFlags As Long, _
 34     lpEnvironment As Any, _
 35     ByVal lpCurrentDriectory As String, _
 36     lpStartupInfo As STARTUPINFO, _
 37     lpProcessInformation As PROCESS_INFORMATION) As Long
 38 Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
 39     ByVal hwnd As Long, _
 40     ByVal Msg As Long, _
 41     ByVal wparam As Long, _
 42     ByVal lparam As Long) As Long
 43 
 44 Public Const CCHDEVICENAME = 32
 45 Public Const CCHFORMNAME = 32
 46 Public Const MOD_CONTROL = &H2
 47 Public Const WM_HOTKEY = &H312
 48 Public Const GWL_WNDPROC = -4
 49 
 50 Public Type STARTUPINFO
 51        cb As Long
 52       lpReserved As String
 53       lpDesktop As String
 54       lpTitle As String
 55       dwX As Long
 56       dwY As Long
 57       dwXSize As Long
 58       dwYSize As Long
 59       dwXCountChars As Long
 60       dwYCountChars As Long
 61       dwFillAttribute As Long
 62       dwFlags As Long
 63       wShowWindow As Integer
 64       cbReserved2 As Integer
 65       lpReserved2 As Long
 66       hStdInput As Long
 67       hStdOutput As Long
 68       hStdError As Long
 69 End Type
 70 
 71 Public Type PROCESS_INFORMATION
 72        hProcess As Long
 73       hThread As Long
 74       dwProcessId As Long
 75       dwThreadId As Long
 76 End Type
 77 
 78 
 79 Public Type DEVMODE
 80        dmDeviceName As String * CCHDEVICENAME
 81        dmSpecVersion As Integer
 82       dmDriverVersion As Integer
 83       dmSize As Integer
 84       dmDriverExtra As Integer
 85       dmFields As Long
 86       dmOrientation As Integer
 87       dmPaperSize As Integer
 88       dmPaperLength As Integer
 89       dmPaperWidth As Integer
 90       dmScale As Integer
 91       dmCopies As Integer
 92       dmDefaultSource As Integer
 93       dmPrintQuality As Integer
 94       dmColor As Integer
 95       dmDuplex As Integer
 96       dmYResolution As Integer
 97       dmTTOption As Integer
 98       dmCollate As Integer
 99       dmFormName As String * CCHFORMNAME
100        dmUnusedPadding As Integer
101       dmBitsPerPel As Long
102       dmPelsWidth As Long
103       dmPelsHeight As Long
104       dmDisplayFlags As Long
105       dmDisplayFrequency As Long
106 End Type
107 
108 Public Type SECURITY_ATTRIBUTES
109        nLength As Long
110       lpSecurityDescriptor As Long
111       bInheritHandle As Long
112 End Type
113 
114 Public Const GENERIC_ALL = &H10000000
115 Public Const MAXIMUM_ALLOWED = &H2000000
116 Public Const DESKTOP_SWITCHDESKTOP = &H100
117 Public Const DESKTOP_CREATEMENU = &H4&
118 Public Const DESKTOP_CREATEWINDOW = &H2&
119 Public Const DESKTOP_ENUMERATE = &H40&
120 Public Const DESKTOP_HOOKCONTROL = &H8&
121 Public Const DESKTOP_JOURNALPLAYBACK = &H20&
122 Public Const DESKTOP_JOURNALRECORD = &H10&
123 Public Const DESKTOP_READOBJECTS = &H1&
124 Public Const DESKTOP_WRITEOBJECTS = &H80&
125 Public Const DESKTOP_ALL = 511
126 
127 Public HotKeyID1 As Long
128 Public HotKeyID2 As Long
129 Public hwndOldDesktop As Long
130 Public hwndNewDesktop As Long
131 Public NEW_DESKTOP_NAME As String
132 Public OldWndProc As Long
133 
134 Public Function CallBackWndProc(ByVal hwnd As Long, _
135     ByVal wMsg As Long, _
136     ByVal wparam As Long, _
137     ByVal lparam As Long) As Long
138     
139     If wMsg = WM_HOTKEY Then
140         If wparam = HotKeyID1 And hwndNewDesktop Then
141             'Ctrl+W, switch it to new
142             Call SwitchDesktop(hwndNewDesktop)
143             Debug.Print "i am new desktop, u c?"
144         ElseIf wparam = HotKeyID2 Then
145             'Ctrl+Q, switch it to old
146             Call SwitchDesktop(hwndOldDesktop)
147             Debug.Print "i am back to old desktop, yeah!"
148         End If
149     End If
150     
151     CallBackWndProc = CallWindowProc(OldWndProc, hwnd, wMsg, wparam, lparam)
152 End Function

窗体部分：

 1 'code by lichmama from cnblogs.com
 2 Private Sub Form_Load()
 3     HotKeyID1 = 101&
 4     HotKeyID2 = 102&
 5     
 6     hwndOldDesktop = GetThreadDesktop(App.ThreadID)
 7     NEW_DESKTOP_NAME = "myNewDesktop-VB6.0"
 8     Call RegisterHotKey(Me.hwnd, HotKeyID1, MOD_CONTROL, vbKeyW)
 9     Call RegisterHotKey(Me.hwnd, HotKeyID2, MOD_CONTROL, vbKeyQ)
10     hwndNewDesktop = OpenDesktop(NEW_DESKTOP_NAME, 0&, False, DESKTOP_ALL)
11     If hwndNewDesktoop = 0 Then
12         '如果新桌面不存在，则创建一个
13         hwndNewDesktop = CreateDesktop(NEW_DESKTOP_NAME, vbNullString, ByVal 0&, 0&, MAXIMUM_ALLOWED, ByVal 0&)
14     End If
15     If hwndNewDesktop = 0 Then
16         Debug.Print "new desktop create failed"
17     End If
18     OldWndProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
19     Call SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf CallBackWndProc)
20 End Sub
21 
22 Private Sub Form_Unload(Cancel As Integer)
23     Call SetWindowLong(Me.hwnd, GWL_WNDPROC, OldWndProc)
24     Call UnregisterHotKey(Me.hwnd, HotKeyID1)
25     Call UnregisterHotKey(Me.hwnd, HotKeyID1)
26 End Sub