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

VB6之切换桌面