delphi 程序防从任务管理器结束

[ss2008529]

delphi 开发的程序，如何防止用户从任务管理器里面结束改程序的进程。

[@zheng]

@xrbaa 这个应该怎么做呢？

[xrbaa]

你把程序写成系统关键进程。

[nikotin]

可以做一个内核驱动，这个驱动加载后即开启一个内核线程不断检查进程是否还在，不在的话就启动程序。

[nikotin]

或者程序做成几个进程，互相检查是否还活着；或者程序运行时不断向服务器上报自己的状态等等。没搞过类似问题，算是抛砖引玉吧。

[wdywmz]

我测试过，程序文件名 改为services.exe，貌似无法结束

[JI_Liudan]

测试环境WIN7+DELPHI11通过
uses
function MakeMeCritical(Yes: Boolean): Boolean; //这个地方申明一个，所有uses都可以调用
type

{$R *.dfm} //从这个后面开始增加
//===========在任务管理器里面不能关闭，强行关闭会蓝屏WIN7=====================
function MakeMeCritical(Yes: Boolean): Boolean;
const
SE_DEBUG_PRIVILEGE = $14;
SE_PROC_INFO = $1D;
var
Enabled: PBOOL;
DllHandle: THandle;
BreakOnTermination: ULong;
HR: HRESULT;
RtlAdjustPrivilege: function(Privilege: ULONG; Enable: BOOL; CurrentThread: BOOL; var Enabled: PBOOL): DWORD; stdcall;
NtSetInformationProcess: function(ProcHandle: THandle; ProcInfoClass: ULONG; ProcInfo: Pointer; ProcInfoLength: ULONG): HResult; stdcall;
begin
Result := False;
DllHandle := LoadLibrary('ntdll.dll') ;
if DllHandle <> 0 then
begin
@RtlAdjustPrivilege := GetProcAddress(dllHandle, 'RtlAdjustPrivilege');
if (@RtlAdjustPrivilege <> nil) then
begin
if RtlAdjustPrivilege(SE_DEBUG_PRIVILEGE, True, True, Enabled) = 0 then
begin
@NtSetInformationProcess := GetProcAddress(dllHandle, 'NtSetInformationProcess');
if (@NtSetInformationProcess <> nil) then
begin
BreakOnTermination := Ord(Yes);
HR := NtSetInformationProcess(GetCurrentProcess(), SE_PROC_INFO, @BreakOnTermination, SizeOf(BreakOnTermination));
Result := HR = S_OK;
end;
end;
end;
FreeLibrary(DllHandle);
end
end;
//什么位置都可以，可以是程序FormShow FormCreate ，直接上面function MakeMeCritical(Yes: Boolean): Boolean;后面都可以
if MakeMeCritical(False) then
begin
MakeMeCritical(True); //MakeMeCritical为True时任务管理器不能正常关闭的
end;
//============关闭程序的时候记得一定得让MakeMeCritical为False
退出里面一定要写
MakeMeCritical(False);

//如果程序没有退出，直接关机注销重启也会蓝屏解决办法如下：
public下面增加：
procedure EndMsg(var nMsg:TWMQueryEndSession); Message WM_QUERYENDSESSION;
主体代码
procedure TParameter_setting_from.EndMsg(var nMsg:TWMQueryEndSession); //检测关机重启注销的消息
begin
//0 可以取消关机操作
nMsg.Result := 1;
MakeMeCritical(False); //退出前解锁进程
Application.Terminate; //退出程序
end;

public下面增加：
//procedure WndProc(var Message: TMessage); override; 也可以用此方法
主体代码
procedure TParameter_setting_from.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_WTSSESSION_CHANGE then //锁屏
begin
case Message.wParam of
WTS_SESSION_LOCK: begin //锁运行代码
Control_ALL_Timer.Enabled:=false; //关闭检测 每多久执行
timefor_Timer.Enabled:=false; //关闭检测 禁用时间段执行
end;
WTS_SESSION_UNLOCK:begin //解锁运行代码
Control_ALL_Timer.Enabled:=True; //重新计时开始
timefor_Timer.Enabled:=True; //重新计时开始禁用时间段执行
ALL_TrayIcon.BalloonTitle:='提示';
ALL_TrayIcon.BalloonHint:='计算机已解锁，控制程序将重新开启计时。';
ALL_TrayIcon.BalloonTimeout:=2000;
ALL_TrayIcon.ShowBalloonHint;
end;
end;
end;
inherited;
{ if Message.Msg = WM_QUERYENDSESSION then //检测关机重启注销等
begin
if Message.LParam = 0 then
ShowMessage('关机或重启')
else
ShowMessage('注销');
end; }
end;

[JI_Liudan]

JI_Liudan补充，程序多开会蓝屏，你还要写防止多开
procedure TParameter_setting_from.FormCreate(Sender: TObject);
var
errno:integer; //禁止多开程序
hmutex:hwnd; //禁止多开程序
begin
//================ //禁止多开程序 begin=========================================
hmutex:=createmutex(nil,false,pchar(application.Title)); //禁止多开程序
errno:=getlasterror; //禁止多开程序
if errno=error_already_exists then //禁止多开程序
begin
// Application.MessageBox('程序已经正在运行中,请不要重复打开.','关于程序',MB_OK); //这句千万不能写，不然会蓝屏
Application.Terminate;
end;
end;
//最句话最后单独单用个时间控件来执行时间最好设为大于500毫秒，执行完FREE时间组件就行了，也就是等程序主体运行完再执行，不然会蓝屏
if MakeMeCritical(False) then
begin
MakeMeCritical(True); //MakeMeCritical为True时任务管理器不能正常关闭的
end;