前些日子忘记谁管我要定时关机的软件,昨天晚上回家就给你写了一个。。我就发在这里了。。
我要说明一下,我这个软件可能只对XP
系统用户有效,因为我在写这个程序的时候为了方便没有调用系统的API函数,直接调用cmd关机命令,如果有谁想要的话等哪天我有时间再帮着改回来。。
软件原代码公开,如果有谁认为我写的代码麻烦可以和我交流一下,呵呵。。大家一起学习嘛。。。。
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 Long
Dim ss(7) As Long
Option Explicit
'确定按钮的click事件
Private Sub Command1_Click()
'声名日期型变量
Dim Time1 As Date
Dim Time2 As Date
'首先关闭定时器timer1
Timer1.Enabled = False
Time2 = Time()
'判断用户输入时间的合法性
If Text1.Text = "" Then
MsgBox "请输入定时关机/重起时间!", vbExclamation + vbOKCancel, "警告信息"
Text1.SetFocus
Exit Sub
End If
If IsDate(Text1) = False Then
MsgBox "请输入正确时间格式!--> HH:MM:SS", vbExclamation + vbOKCancel, "警告信息"
Text1.SetFocus
Exit Sub
Else:
Time1 = CDate(Text1.Text) '把输入的时间字符串转换为日期型
ss(0) = Val(Left(Trim(Text1.Text), 2))
ss(1) = Val(Mid(Trim(Text1.Text), 4, 2))
ss(2) = Val(Right(Trim(Text1.Text), 2))
ss(3) = ss(0) * 3600 + ss(1) * 60 + ss(2)
'得到秒数值
End If
If Time1 <= Time2 Then
MsgBox "定时时间必须大于当前系统时间!", vbExclamation + vbOKCancel, "警告信息"
Text1.SetFocus
Exit Sub
Else:
Timer1.Enabled = True '打开定时器
Text1.Enabled = False
Command1.Enabled = False
Command2.Enabled = True
quxiao.Enabled = True
End If
End Sub
'关机/重起的函数
Function exit_win()
Dim a As Variant
If Option1.Value = True Then
Shell "cmd.exe /c shutdown -s -t 0" '关机
Else:
Shell "cmd.exe /c shutdown -r -t 0" '重起
End If
End Function
'取消按扭事件
Private Sub Command2_Click()
Timer1.Enabled = False
Command2.Enabled = False
Command1.Enabled = True
Text1.Enabled = True
End Sub
'程序初始化
Private Sub Form_Load()
Label2.Visible = False
Command2.Enabled = False
quxiao.Enabled = False
form2.RichTextBox1.Enabled = False
End Sub
'进入论坛
Private Sub jinru_Click()
Dim a As String
a = "
http://www.jsjbbs.cn"
ShellExecute 0, "open", a, "", "", 1
End Sub
'点击网址进入网站
Private Sub Label7_Click()
Call jinru_Click
End Sub
'菜单确定
Private Sub queding_Click()
Call Command1_Click
End Sub
'菜单取消
Private Sub quxiao_Click()
Call Command2_Click
End Sub
Private Sub ruanjian_Click()
form2.Show
End Sub
'定时器触发事件
Private Sub Timer1_Timer()
Dim cur_time As String
Dim winhwnd As Long
Dim retval As Long
cur_time = CStr(Time())
'取当前系统时间
ss(4) = Val(Left(cur_time, 2))
ss(5) = Val(Mid(cur_time, 4, 2))
ss(6) = Val(Right(cur_time, 2))
ss(7) = ss(4) * 3600 + ss(5) * 60 + ss(6)
'把系统当前时间值转换为秒数值
If ss(3) = ss(7) Then
Call exit_win
End If
End Sub '定时器2的事件
'time2事件
Private Sub Timer2_Timer()
'把当前的系统时间显示在 label2上
Label2.Visible = True
Timer2.Enabled = True
Label2.Caption = FormatDateTime(Now, vbLongTime) & " " & FormatDateTime(Now, vbShortDate)
End Sub
'退出程序
Private Sub tuichu_Click()
End
End Sub