3个回答
2013-09-07
展开全部
Module1.bas:Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As LongPublic Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) _
As LongPublic 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 GWL_WNDPROC = (-4)'全局变量,存放控件标志性数据
Public preWinProc As Long
Public m_AllowExit As Boolean '是否可以退出windowsPublic Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'截取下来的消息存放在msg参数中
If (m_AllowExit = False) And (Msg = 17) Then
Form1.List1.AddItem "有程序试图关闭Windows!"
Else
'如果不是需要处理的消息,则将之送回原来的程序.
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End If
End Function
------------------------------------------------------------------------------------------------------------modMain.bas:Option ExplicitPrivate Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Private Const ICC_USEREX_CLASSES = &H200
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( _
ByVal lpLibFileName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32" ( _
ByVal hLibModule As Long) As LongPublic m_hMod As LongPublic Sub Main()
'设置工程属性,启动对象为main
On Error Resume Next Dim iccex As tagInitCommonControlsEx
With iccex
.lngSize = LenB(iccex)
.lngICC = ICC_USEREX_CLASSES
End With
InitCommonControlsEx iccex
m_hMod = LoadLibrary("shell32.dll")
InitCommonControls ' now start the application
On Error GoTo 0
Form1.Show '显示主窗体
End Sub
-----------------------------------------------------------------------------------------------------------------------------------form1:Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Sub Check1_Click()
If Check1.Value = 1 Then
m_AllowExit = False '不允许退出windows
Else
m_AllowExit = True '允许退出windows
End If
End SubPrivate Sub Command1_Click()
List1.Clear
End Sub
Private Sub Form_Load()
m_AllowExit = False
SubClass Me.hwnd
ShowWindow Me.hwnd, 7
End SubPrivate Sub Form_Unload(Cancel As Integer)
EndSubClass Me.hwnd
End SubPrivate Sub SubClass(wnd As Long)
Dim ret As Long
'记录Window Procedure的地址
preWinProc = GetWindowLong(wnd, GWL_WNDPROC)
'开始截取消息,并将消息交给wndproc过程处理
ret = SetWindowLong(wnd, GWL_WNDPROC, AddressOf wndproc)
End SubPrivate Sub EndSubClass(wnd As Long)
Dim ret As Long
'取消消息截取,结束子分类过程.
ret = SetWindowLong(wnd, GWL_WNDPROC, preWinProc)
End Sub
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As LongPublic Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) _
As LongPublic 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 GWL_WNDPROC = (-4)'全局变量,存放控件标志性数据
Public preWinProc As Long
Public m_AllowExit As Boolean '是否可以退出windowsPublic Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'截取下来的消息存放在msg参数中
If (m_AllowExit = False) And (Msg = 17) Then
Form1.List1.AddItem "有程序试图关闭Windows!"
Else
'如果不是需要处理的消息,则将之送回原来的程序.
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End If
End Function
------------------------------------------------------------------------------------------------------------modMain.bas:Option ExplicitPrivate Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As tagInitCommonControlsEx) As Boolean
Private Const ICC_USEREX_CLASSES = &H200
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( _
ByVal lpLibFileName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32" ( _
ByVal hLibModule As Long) As LongPublic m_hMod As LongPublic Sub Main()
'设置工程属性,启动对象为main
On Error Resume Next Dim iccex As tagInitCommonControlsEx
With iccex
.lngSize = LenB(iccex)
.lngICC = ICC_USEREX_CLASSES
End With
InitCommonControlsEx iccex
m_hMod = LoadLibrary("shell32.dll")
InitCommonControls ' now start the application
On Error GoTo 0
Form1.Show '显示主窗体
End Sub
-----------------------------------------------------------------------------------------------------------------------------------form1:Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPrivate Sub Check1_Click()
If Check1.Value = 1 Then
m_AllowExit = False '不允许退出windows
Else
m_AllowExit = True '允许退出windows
End If
End SubPrivate Sub Command1_Click()
List1.Clear
End Sub
Private Sub Form_Load()
m_AllowExit = False
SubClass Me.hwnd
ShowWindow Me.hwnd, 7
End SubPrivate Sub Form_Unload(Cancel As Integer)
EndSubClass Me.hwnd
End SubPrivate Sub SubClass(wnd As Long)
Dim ret As Long
'记录Window Procedure的地址
preWinProc = GetWindowLong(wnd, GWL_WNDPROC)
'开始截取消息,并将消息交给wndproc过程处理
ret = SetWindowLong(wnd, GWL_WNDPROC, AddressOf wndproc)
End SubPrivate Sub EndSubClass(wnd As Long)
Dim ret As Long
'取消消息截取,结束子分类过程.
ret = SetWindowLong(wnd, GWL_WNDPROC, preWinProc)
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询