为了正常的体验网站,请在浏览器设置里面开启Javascript功能!

自动关机—vb程序代码

2012-10-23 12页 doc 89KB 77阅读

用户头像

is_415141

暂无简介

举报
自动关机—vb程序代码往链点点通共享资源,了解更多请登录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 Privat...
自动关机—vb程序代码
往链点点通共享资源,了解更多请登录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 往链点点通,让您无障碍畅游网络世界!
/
本文档为【自动关机—vb程序代码】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。 本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。 网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。

历史搜索

    清空历史搜索