📄 frmmain.frm
字号:
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "磁盘碎片整理监视程序"
ClientHeight = 2325
ClientLeft = 45
ClientTop = 330
ClientWidth = 7065
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 2325
ScaleWidth = 7065
StartUpPosition = 3 '窗口缺省
Begin VB.Timer Timer2
Enabled = 0 'False
Interval = 200
Left = 6480
Top = 2880
End
Begin VB.Frame Frame1
Height = 2175
Left = 120
TabIndex = 0
Top = 0
Width = 6855
Begin VB.CommandButton Command2
Caption = "测试"
Enabled = 0 'False
Height = 300
Left = 5760
TabIndex = 5
Top = 1560
Width = 855
End
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 0
Top = 0
End
Begin VB.TextBox Text1
Enabled = 0 'False
Height = 270
Left = 360
TabIndex = 4
Text = "Beep"
Top = 1560
Width = 5175
End
Begin VB.CommandButton Command1
Caption = "开始监视"
Default = -1 'True
Height = 495
Left = 5040
TabIndex = 6
Top = 360
Width = 1455
End
Begin VB.OptionButton Option2
Caption = "运行下面的程序(&R)"
Height = 495
Left = 2400
TabIndex = 3
Top = 840
Width = 2055
End
Begin VB.OptionButton Option1
Caption = "关闭计算机(&U)"
Height = 495
Left = 600
TabIndex = 2
Top = 840
Value = -1 'True
Width = 1935
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "请选择磁盘碎片整理结束后执行的操作:"
Height = 180
Left = 360
TabIndex = 1
Top = 480
Width = 3150
End
End
Begin VB.Image Image2
Height = 480
Left = 5160
Picture = "frmMain.frx":030A
Top = 2880
Width = 480
End
Begin VB.Image Image1
Height = 480
Index = 7
Left = 4560
Picture = "frmMain.frx":0614
Top = 2880
Width = 480
End
Begin VB.Image Image1
Height = 480
Index = 6
Left = 3960
Picture = "frmMain.frx":0A56
Top = 2880
Width = 480
End
Begin VB.Image Image1
Height = 480
Index = 5
Left = 3360
Picture = "frmMain.frx":0E98
Top = 2880
Width = 480
End
Begin VB.Image Image1
Height = 480
Index = 4
Left = 2760
Picture = "frmMain.frx":12DA
Top = 2880
Width = 480
End
Begin VB.Image Image1
Height = 480
Index = 3
Left = 2160
Picture = "frmMain.frx":171C
Top = 2880
Width = 480
End
Begin VB.Image Image1
Height = 480
Index = 2
Left = 1560
Picture = "frmMain.frx":1B5E
Top = 2880
Width = 480
End
Begin VB.Image Image1
Height = 480
Index = 1
Left = 960
Picture = "frmMain.frx":1FA0
Top = 2880
Width = 480
End
Begin VB.Image Image1
Height = 480
Index = 0
Left = 360
Picture = "frmMain.frx":23E2
Top = 2880
Width = 480
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' --------------------------------------------------------------
' 版权所有 原子数据工作室 作者:陈国强
' E-mail: alone@telekbird.com.cn
' http://www.quanqiiu.com/vb
'
' 如果您认为本程序对您有用，您可以免费以任何方式使用、修改、复制
' 并分发本程序(或其修改版本)，而无须征得原子数据工作室同意。原子
' 数据工作室对本程序文件不做任何安全保证及其他暗示，对因使用本程
' 序而引起的直接或间接损失不负任何责任及义务。11:47 1999-07-01
' --------------------------------------------------------------
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Const EWX_FORCE = 4
Const EWX_LOGOFF = 0
Const EWX_REBOOT = 2
Const EWX_SHUTDOWN = 1
Private Sub Command1_Click()
Timer1.Enabled = Not Timer1.Enabled
Timer2.Enabled = Timer1.Enabled
If Not Timer1.Enabled Then Me.Icon = Image2.Picture
If Timer1.Enabled Then
Command1.Caption = "停止监视"
Else
Command1.Caption = "开始监视"
End If
End Sub
Private Sub Command2_Click()
Dim di As Long
On Error GoTo ERROR_LINE
If UCase(Text1.Text) = "BEEP" Then
Beep
Else
Shell Text1.Text, vbNormalFocus
End If
Exit Sub
ERROR_LINE:
MsgBox "发生了一个错误！", vbCritical, "错误"
Resume Next
End Sub
Private Sub Option1_Click()
Text1.Enabled = Option2.Value
Command2.Enabled = Option2.Value
End Sub
Private Sub Option2_Click()
Text1.Enabled = Option2.Value
Command2.Enabled = Option2.Value
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub Timer1_Timer()
On Error GoTo ERROR_LINE
Dim lngDeskTopHandle As Long
Dim lngHand As Long
Dim strName As String * 255
Dim strFormCaption As String
Const strHook_01 = "磁盘碎片整理程序"
Const strHook_02 = "磁盘加速"
Const strHook_03 = "完成"
Dim lngWindowCount As Long
lngDeskTopHandle = GetDesktopWindow()
lngHand = GetWindow(lngDeskTopHandle, GW_CHILD)
lngWindowCount = 0
Do While lngHand <> 0
GetWindowText lngHand, strName, Len(strName)
lngHand = GetWindow(lngHand, GW_HWNDNEXT)
If Left$(strName, 1) <> vbNullChar Then
strFormCaption = Left$(strName, InStr(1, strName, vbNullChar) - 1)
If (strFormCaption = strHook_01) Or (strFormCaption = strHook_02) _
Or (strFormCaption = strHook_03) Then lngWindowCount = lngWindowCount + 1
End If
Loop
If lngWindowCount >= 2 Then Call ExitWindows
Exit Sub
ERROR_LINE:
Exit Sub
End Sub
Private Sub ExitWindows()
Dim di As Long
On Error GoTo ERROR_LINE
Beep
If Option1.Value Then
di = ExitWindowsEx(EWX_SHUTDOWN, 0)
Else
If UCase(Text1.Text) = "BEEP" Then
Beep
Else
Shell Text1.Text, vbNormalFocus
Timer1.Enabled = Not Timer1.Enabled
If Timer1.Enabled Then
Command1.Caption = "停止监视"
Else
Command1.Caption = "开始监视"
End If
End If
End If
Exit Sub
ERROR_LINE:
MsgBox "发生了一个错误！", vbCritical, "错误"
Resume Next
End Sub
Private Sub Timer2_Timer()
Static i As Integer
Me.Icon = Image1(i).Picture
i = i + 1
If i > Image1.UBound Then i = Image1.LBound
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -