往链点点通共享资源,了解更多请登录www.WL566.com
Form1(主界面)
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Const HELP_CONTENTS = &H3&
Const EWX_LOGOFF = 0 '注销
Const EWX_SHUTDOWN = 1 '待机
Const EWX_REBOOT = 2 '重新启动
Const EWX_WAIT = 16
Const EWX_FORCE = 4 '终止没有响应的进程
Const EWX_POWEROFF = 8 '关闭电源
Const xStr As String = "0123456789"
'=========================================================================================================窗口在前
'Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'Private Const HWND_TOPMOST& = -1
'Private Const SWP_NOSIZE& = &H1
'Private Const SWP_NOMOVE& = &H2
'===================================================================================================================
Dim WindowTop, WindowLeft
Public txt As Long
Private Sub Command1_Click() ''确定
If Command1.Caption = "设定" Then
Text1.Enabled = True
Text1.SetFocus
Command1.Caption = "确定"
Label1.Caption = "请输入关机时间:"
Label2.Caption = "如22时55分30秒关机则输入225530"
Exit Sub
ElseIf Command1.Caption = "确定" Then
If Len(Text1) < 6 Then
Call sjcw
Text1 = ""
Text1.SetFocus
Else
b1 = Format(Mid(Text1, 1, 2), "00")
b2 = Format(Mid(Text1, 3, 2), "00")
b3 = Format(Mid(Text1, 5, 2), "00")
If b1 > 23 Or b2 > 59 Or b3 > 59 Then
Call sjcw
Else
pdt = Text1 ''关机时间
Text1.Enabled = False
Command1.Caption = "修改"
Label1.Caption = "关机时间为:" & b1 & ":" & b2 & ":" & b3
Label2.Caption = "点击“启动”开启自动关机功能"
Command2.Enabled = True
Exit Sub
End If
End If
Else
Text1.Enabled = True
Text1.SetFocus
Command1.Caption = "确定"
Label1.Caption = "请输入关机时间:"
Label2.Caption = "如22时55分30秒关机则输入225530"
Exit Sub
End If
End Sub
Private Sub Command2_Click() ''启动
If Command2.Caption = "启动" Then
b1 = Format(Mid(Text1, 1, 2), "00")
b2 = Format(Mid(Text1, 3, 2), "00")
b3 = Format(Mid(Text1, 5, 2), "00")
If b1 > 23 Or b2 > 59 Or b3 > 59 Then
Call sjcw
Else
Open App.Path + "\mrpdt.dat" For Output As #5 Len = 6
Cls
For i = 1 To 6
t = Mid(Val(Text1), i, 1)
tt = tt & t
Next i
tt = Format(tt, "000000")
Print #5, tt
Close #5
Timer1.Enabled = True
Command2.Caption = "停止"
Command1.Caption = "修改"
Label1.Caption = "关机时间为:" & b1 & ":" & b2 & ":" & b3
Label2.Caption = "点击“启动”开启自动关机功能"
Command1.Enabled = False
Text1.Enabled = False
Open App.Path + "\rjsz.dat" For Input As #1
Input #1, rjsz
Close #1
rjsz = Format(rjsz, "00000")
If Mid(rjsz, 2, 1) = 1 Then
Me.WindowState = 1 ''点击启动到托盘
End If
End If
Else
Timer1.Enabled = False
Command2.Caption = "启动"
Command1.Enabled = True
End If
End Sub
Private Sub Command3_Click() ''设置
Form2.Show
Form2.Top = Form1.Top
Form2.Left = Form1.Left + Form1.Width
End Sub
Private Sub Form_Load()
'=================================================================================================================
Dim hProcessHandle As Long
Dim hTokenHandle As Long
Dim tmpLuid As LUID
Dim tkpNew As TOKEN_PRIVILEGES
Dim tkpPrevious As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
hProcessHandle = GetCurrentProcess()
OpenProcessToken hProcessHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hTokenHandle
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
tkpNew.PrivilegeCount = 1
tkpNew.TheLuid = tmpLuid
tkpNew.Attributes = SE_PRIVILEGE_ENABLED
lBufferNeeded = 0
AdjustTokenPrivileges hTokenHandle, False, tkpNew, Len(tkpPrevious), tkpPrevious, lBufferNeeded
'================================================================================================================
'SetWindowPos Form1.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE '窗口在前
'================================================================================================================
If Dir(App.Path + "\rjsz.dat") <> "" Then
Open App.Path + "\rjsz.dat" For Input As #1
Input #1, rjsz
Close #1
rjsz = Format(rjsz, "00000")
If Dir(App.Path + "\mrpdt.dat") <> "" Then
If Mid(rjsz, 3, 1) = 1 Then
Open App.Path + "\mrpdt.dat" For Input As #2 Len = 5
Input #2, mrt
mrt = Format(mrt, "000000")
Text1 = mrt
a1 = Format(Mid(mrt, 1, 2), "00")
a2 = Format(Mid(mrt, 3, 2), "00")
a3 = Format(Mid(mrt, 5, 2), "00")
Label1.Caption = "关机时间为:" & a1 & ":" & a2 & ":" & a3
Label2.Caption = "点击“启动”开启自动关机功能"
Text1.Enabled = False
Command1.Caption = "修改"
Close #2
End If
End If
If Mid(rjsz, 1, 1) = 1 Then
Call Command2_Click ''开机自动启动
End If
End If
End Sub
Private Sub Label4_Click()
Call tuichu
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_LBUTTONDBLCLK '双击左键显示窗体,要改成其他的看模块里的定义
ShowWindow Me.hWnd, SW_RESTORE
Me.Top = (Screen.Height - Form1.Height) / 2
Me.Left = (Screen.Width - Form1.Width) / 2
Me.SetFocus
Case WM_RBUTTONUP '在托盘图标上点右键显示菜单
PopupMenu F00 '菜单名称为F00
End Select
End Sub
Private Sub Label5_Click()
Form3.Show
Form3.Top = Form1.Top
Form3.Left = Form1.Left - Form3.Width
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) ''只能输入数字
KeyAscii = IIf(InStr(xStr & Chr(8), Chr(KeyAscii)), KeyAscii, 0)
End Sub
Function WindowStyle()
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
.szTip = Label7.Caption & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
Me.Hide
End Function
Private Sub Form_Resize()
WindowTop = Me.Top
WindowLeft = Me.Left
If Me.WindowState = 1 Then
WindowStyle
End If
End Sub
Private Sub F01_Click()
ShowWindow Me.hWnd, SW_RESTORE
Me.Top = (Screen.Height - Form1.Height) / 2
Me.Left = (Screen.Width - Form1.Width) / 2
End Sub
Private Sub F02_Click()
Call tuichu
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '关闭按钮
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End
End Sub
Function sjcw() ''数据错误
MsgBox "数据不合法,请重新输入!", vbOKOnly + vbCritical, "错误"
Text1 = ""
If Text1.Enabled = True Then
Text1.SetFocus
End If
End Function
Function tuichu()
ms = MsgBox("退出后自动关机功能将停用!" + Chr(13) + "确定退出?", vbOKCancel + vbExclamation + vbDefaultButton2, "提示")
If ms = vbCancel Then
Cancel = 1
Else
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End
End If
End Function
Private Sub Timer1_Timer()
ntm = Format(Hour(Now), "00") & Format(Minute(Now), "00") & Format(Second(Now), "00")
If ntm = Text1 Then
Call PowerDown
End If
End Sub
Private Sub Timer2_Timer()
Label3.Caption = "现在时间:" & Now
If Dir(App.Path + "\rjsz.dat") <> "" Then
Open App.Path + "\rjsz.dat" For Input As #1 Len = 5
Input #1, rjsz
Close #1
rjsz = Format(rjsz, "00000")
If Mid(rjsz, 4, 1) = 1 And Command2.Caption = "停止" Then
txt = Mid(rjsz, 5, 1) ''提醒时间
NT1 = Format(Hour(Now), "00")
NT2 = Format(Minute(Now), "00")
NT3 = Format(Second(Now), "00")
GT1 = Format(Mid(Text1, 1, 2), "00")
GT2 = Format(Mid(Text1, 3, 2), "00")
GT3 = Format(Mid(Text1, 5, 2), "00")
nt = NT1 & NT2 & NT3
If GT2 - txt >= 0 Then
Gt = GT1 & Format((GT2 - txt), "00") & GT3
Else
If GT1 - 1 >= 0 Then
Gt = Format((GT1 - 1), "00") & Format((60 + GT2 - txt), "00") & GT3
Else
Gt = 23 & Format((60 + GT2 - txt), "00") & GT3
End If
End If
If Gt = nt Then
Form4.Show
End If
If GT3 - NT3 >= 0 Then '剩余时间
Ts = GT3 - NT3
If GT2 - NT2 >= 0 Then
Tm = GT2 - NT2
If GT1 - NT1 >= 0 Then
Th = GT1 - NT1
Else
Th = GT1 + 24 - NT1
End If
Else
If GT1 - NT1 - 1 >= 0 Then
Tm = GT2 + 60 - GT1
Th = GT1 - NT1 - 1
Else
Tm = GT2 + 60 - GT1
Th = 24 + GT1 - NT1 - 1
End If
End If
Else
If GT2 - NT2 - 1 >= 0 Then
Ts = GT3 + 60 - NT3
Tm = GT2 - NT2 - 1
If GT1 - NT1 >= 0 Then
Th = GT1 - NT1
Else
Th = GT1 + 24 - NT1
End If
Else
If GT1 - NT1 - 1 >= 0 Then
Ts = GT3 + 60 - NT3
Tm = GT2 + 60 - NT3 - 1
Th = GT1 - NT1 - 1
Else
Ts = GT3 + 60 - NT3
Tm = GT2 + 60 - NT2 - 1
Th = 24 + GT1 - NT1 - 1
End If
End If
End If
Label7.Visible = True
Label7.Caption = "关机倒计时:" & Th & "时" & Tm & "分" & Ts & "秒"
If Th = 0 And Tm < 5 Then
Label7.ForeColor = vbRed
End If
End If
End If
End Sub
Function PowerDown()
ExitWindowsEx (EWX_SHUTDOWN Or EWX_FORCE Or EWX_POWEROFF), 0
Timer1.Enabled = False
End Function
Form2(设置)
Private Sub Command1_Click()
Dim v As Long
For i = 1 To 4
v = v & Check1(i - 1).Value
Next i
If v = 0 Then
Command1.Caption = "全清"
For i = 1 To 4
Check1(i - 1).Value = 1
Next i
Else
Command1.Caption = "全选"
For i = 1 To 4
Check1(i - 1).Value = 0
Next i
End If
End Sub
Private Sub Command2_Click()
'Dim c As Long, d As Long
Open App.Path + "\rjsz.dat" For Output As #4 Len = 5
Cls
For i = 1 To 4
c = Check1(i - 1).Value
cc = cc & c
Next i
d = Combo1.Text
cc = cc & d
Print #4, cc
Close #4
If Check1(0).Value = 1 Then '''开机自动启动
Call SetAutoRun(True)
Else
Call SetAutoRun(False)
End If
Unload Form2
End Sub
Private Sub Form_Load()
Dim s As Long
Combo1.AddItem 1
Combo1.AddItem 2
Combo1.AddItem 3
Combo1.AddItem 4
Combo1.AddItem 5
If Dir(App.Path + "\rjsz.dat") <> "" Then
Open App.Path + "\rjsz.dat" For Input As #3 Len = 5
Input #3, sss
sss = Format(sss, "00000")
For i = 1 To 4
Check1(i - 1).Value = Mid(sss, i, 1)
Next i
Combo1.Text = Mid(sss, 5, 1)
Close #3
End If
End Sub
Private Sub Timer1_Timer()
For i = 1 To 4
v = v & Check1(i - 1).Value
Next i
If v = 0 Then
Command1.Caption = "全选"
Else
Command1.Caption = "全清"
End If
End Sub
Form3(关于)
Private Sub Label13_Click()
Form2.Left = Form1.Left + Form1.Width
Form2.Top = Form1.Top
Form2.Show
End Sub
Form4(提示)
Private Sub Command1_Click()
Form4.Hide
End Sub
Private Sub Command2_Click()
MsgBox "你可回主界面重新" + Chr(13) + "开启自动关机功能!", vbOKOnly + vbInformation, "提示"
Form4.Hide
Form1.Show
End Sub
Private Sub Form_Load()
Label1.Caption = "还有" & Form1.txt & "分钟将关机!请做好保存工作。"
End Sub
往链点点通共享资源
-----------------------------
资料说明
-----------------------------
该资源由往链点点通搜索于网络公开资源,仅供网友浏览阅读,请勿用于商业用途;
往链点点通,是免费的新一代电脑管理、网络应用桌面软件。
通过简洁清爽并可随意切换的两种窗口操作界面,构建了用户、电脑、互联网之间顺畅的入口平台。为用户管理电脑、智能办公、快捷上网、玩转应用(如 游戏,),提供全方位一站式的服务。让用户只需通过往链点点通,就能便捷到达信息时代的各个角落。真正实现一键直达,点点就通。
往链快搜索:无论是搜索硬盘资源、查找网络资源,还是追踪热门应用,都能享受前所未所的快速度。如本地文件搜索,千万文件,零秒呈现;如网络搜索,只需输入一次关键词,便能同步打开百度、google等多个搜索引擎的结果页;
往链优应用:与某些软件相比,往链点点通追求绿色无广告的体验,精选最优质的网络应用,为用户提供纯净实在的生活、工作、学习、娱乐、休闲应用空间。
往链点点通,让您用windows的使用习惯享受苹果的操作体验!
查看和分享更多优质资源,请进入www.WL566.com 下载往链点点通,找到您的一切网络所需!
往链网址导航大全 www.www321.com
往链点点通,让您无障碍畅游网络世界!