怎样编写关机语言(VB) 急急...........

2002-12-30 09:45:07 169 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

tangwei2000 墨衍会员 · AI 创作全网分发关注 + 加入社区

深入构建加密货币价格预测系统：从数据获取到模型优化的完整指南！ 🏆本文收录于「编程与技术实战」专栏，此专栏涵盖了C/C++编程、人工智能、数据结构、机器学习等技术领域的内容，助你早日登顶实现财富自由🚀；同时，欢迎大家关注&&收藏&&订阅！持续更新中，up！up！up！！阅读详情

怎样编写关机语言(VB)

...全文

DNF单机版搭建全攻略：从零开始到局域网联机（含常见问题解决）本文提供详细的DNF单机版搭建指南，从环境配置到局域网联机设置，涵盖服务端安装、数据库配置及常见问题解决方案。适合新手和有经验的玩家，帮助快速搭建专属游戏服务器，重温经典游戏体验。阅读详情

tangwei2000

VBA 2,506 成员 10,830 内容

+ 关注 + 加入社区

切换为时间正序

smartluwei 2003-01-30

打赏
举报

这样，用shell运行那个叫rundll32的。

li3807 2003-01-20

打赏
举报

这个能关WIN2K吗？？？？

theMost 2003-01-11

打赏
举报

Option Explicit

Dim mDattime As Date

Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As Long, ReturnLength As Long) As Long
Private Declare Function GetTokenInformation Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, ByRef lpLuid As LARGE_INTEGER) As Long

Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const EWX_LOGOFF = 0 '中止进程，然后注销
Private Const EWX_POWEROFF = 8 '关掉系统电源
Private Const EWX_SHUTDOWN = 1 '关闭系统
Private Const EWX_REBOOT = 2 '重新引导系统
Private Const EWX_FORCE = 4 '强迫中止没有响应的进程
Private Const EWX_FORCEIFHUNG = 16 '如果应用程序已挂起，强制关闭

Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const SE_PRIVILEGE_ENABLED_BY_DEFAULT = &H1
Private Const SE_PRIVILEGE_USED_FOR_ACCESS = &H80000000

Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY_SOURCE = &H10
Private Const TOKEN_QUERY = &H8

Private Const ANYSIZE_ARRAY = 1

Private Const SE_SHUTDOWN_NAME = "SeShutdownPrivilege"

Private Const PROCESS_SET_INFORMATION = &H200
Private Const PROCESS_QUERY_INFORMATION = &H400

Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type

Private Type LUID
lowpart As Long
highpart As Long
End Type

Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(0) As LUID_AND_ATTRIBUTES
End Type

Dim Opt As Long

Private Sub Shutdown(Optional Mode As Long = EWX_POWEROFF)
Dim lAPIReturn As Long
Dim tTOKPRI As TOKEN_PRIVILEGES
Dim tLUID As LUID
Dim tLarInt As LARGE_INTEGER
Dim lRequired As Long
Dim hTokHan As Long
Dim hProcess As Long

If LookupPrivilegeValue(vbNullString, SE_SHUTDOWN_NAME, tLarInt) = 0 Then
MsgBox "Get LUID error!", vbOKOnly, "Error"
Exit Sub
End If

tLUID.highpart = tLarInt.highpart
tLUID.lowpart = tLarInt.lowpart

tTOKPRI.PrivilegeCount = 1
tTOKPRI.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
tTOKPRI.Privileges(0).pLuid = tLUID

hProcess = GetCurrentProcess()
lAPIReturn = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hTokHan)
lAPIReturn = AdjustTokenPrivileges(hTokHan, 0, tTOKPRI, Len(tTOKPRI), 0, 0)
lAPIReturn = ExitWindowsEx(Mode, 0)
If lAPIReturn = 0 Then
MsgBox "Function calling error!", vbOKOnly, "错误"
End If

lAPIReturn = CloseHandle(hTokHan)
Unload Me
End Sub

////////////////////////////////////////////////

将：上面程序的常量定义部分的
Private Const EWX_POWEROFF = 8 '关掉系统电源
中的8改为5，6，8，7，9，10。。。。每一个都试一下。
保证有一个可以实现！
///////////////////////////////////////////////////////

liangfang 2003-01-09

打赏
举报

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 _
dwOptions As Long, ByVal dwReserved As Long) As Long

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 EWX_SHUTDOWN = 1

Const EWX_POWEROFF=8'常数

Private Sub AdjustToken()
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long

hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or _
TOKEN_QUERY), hdlTokenHandle

' Get the LUID for shutdown privilege.
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid

tkp.PrivilegeCount = 1 ' One privilege to set
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED

' Enable the shutdown privilege in the access token of this process.
AdjustTokenPrivileges hdlTokenHandle, False, _
tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded

End Sub

Private Sub Command1_Click()'引发事件
AdjustToken'如果是WIN98 可不用这个
ExitWindowsEx EWX_SHUTDOWN, 0
'是 ATX 电源就改为这个 EWX_POWEROFF

End Sub

980 2003-01-05

打赏
举报

　　 1.定时。可以用VB中的Timer控件结合计算机的系统时间来进行精确的定时。
　　 2.关闭计算机。这可以调用Win32 API函数 ExitWindowsEx 来关闭计算机。---

　下面首先来说明一下 ExitWindowsEx 函数，该函数在VB中的声明如下：

Declare Function ExitWindowsEx Lib "user32" Alias "ExitWindowsEx" _
　 (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

【返回值】
　　　 Long，非零表示成功，零表示失败。
【参数表】
　　　 uFlags --------- Long，
　指定下述一个或多个标志（用OR运算符合并到一起）
　　　 EWX_FORCE=4
　强迫中止没有响应的进程
　　　 EWX_LOGOFF=0
　中止进程，然后注销
　　　 EWX_SHUTDOWN=1
　关掉系统电源（如果可能的话，ATX电源就可以）
　　　 EWX_REBOOT=2 重新引导系统
　　　 dwReserved ----- Long，保留，设为零
　好了，现在可以开始编程了。

　 1. 新建一个标准EXE工程。
　 2. 在窗体上放置一个TextBox控件，用以输入定时时间。
　 3. 在TextBox控件之下放置两个OptionButton控件，组成控件数组，用以选择定时模式。
　 4. 在OptionButton控件之下放置一个CommandButton.
　 5. 随便在窗体的某地方放置一Timer控件。

　以上控件了需要设置的属性值如下：

对象属性设置
Text1 Text 空
Option1(0) Caption 在指定时间关机
(时间格式：00:00:00)
Index 0
Option1(1) Caption 延迟指定的时间关机
Index 0
Command1 Caption 确定
Timer1 Interval 15000（精确到1/4分钟，如要更精确可减少该值）
Enabled False

　增加代码如下：

标准模块：
Option Explicit
Public Const EWX_SHUTDOWN = 1 '关闭系统

Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, _
　　 ByVal dwReserved As Long) As Long

窗体模块：

Option Explicit
Dim txtTime　　 '保存输入时间
Dim nowTime　　 '保存实时时间
Dim oldTime　　 '保存开始定时时间

Private Sub Command1_Click()
　 oldTime = Time
　 If Not IsDate(Text1.Text) Then '用IsData函数判断输入的时间格式
　　　 MsgBox "你所输入的不是时间格式,请重试!", , "Wrong"
　 Else
　　　 txtTime = TimeValue(Text1.Text)
　 End If
　 Timer1.Enabled = True　 '启动定时器
　 Me.WindowState = 1　　 '最小化窗体
End Sub

Private Sub Timer1_Timer()
　 nowTime = Time
　 If Option1(0).Value Then
　　　 If DateDiff("s", nowTime, txtTime) Then
　　　　 If DateDiff("s", nowTime, txtTime) < 0 Then
　　　　　 '用DateDiff函数判断是否到时间了
　　　　　　 If Not ExitWindowsEx(EWX_SHUTDOWN, 0) Then
　　　　　　　　 MsgBox "无法关闭计算机"
　　　　　　 End If
　　　　 End If
　　　 ElseIf DateDiff("s", nowTime, oldTime + txtTime) < 0 Then
　　　　 If Not ExitWindowsEx(EWX_SHUTDOWN, 0) Then
　　　　　　　 MsgBox "无法关闭计算机"
　　　　 End If
　　　 End If
　　 End If
End Sub

　结束语：以上程序在VB5.0/6.0和Win98上调试通过。其实，此程序还可增加一些花样，譬如，最后窗体不是最小化，而是调用Win32 API函数，把她的图标放在系统任务栏里，即在右下角有声音，时间等图标的地方，那是另外一个主题了。

　 (版主注：此文有bug，Command1_Click过程改为下述代码为好)

附：

Private Sub Command1_Click()
　 oldTime = Time
　 If Not IsDate(Text1.Text) Then '用IsData函数判断输入的时间格式
　　　 MsgBox "你所输入的不是时间格式,请重试!", , "Wrong"
　 Else
　　　 txtTime = TimeValue(Text1.Text)
　　 Timer1.Enabled = True　 '启动定时器
　　 Me.WindowState = 1　　 '最小化窗体
　 End If
End Sub
这是定时关机代码

liubingqian 2003-01-03

打赏
举报

调用API函数ExitWindowsEx

chenyu5188 2003-01-01

打赏
举报

用API函数哈

Laney 2003-01-01

打赏
举报

调用api,
去找以前的帖子把，里面很详细！

liuks 2003-01-01

打赏
举报

用API

zyl910 2002-12-30

打赏
举报

http://expert.csdn.net/Expert/FAQ/FAQ_Index.asp?id=18622

jinesc 2002-12-30

打赏
举报

http://jinesc.6600.org/myweb/disp.asp?idd=253&room=1020

怎样编写关机语言(VB) 急急...........

相关推荐