DELPHI 程序停止运行

DELPHI 程序停止运行,第1张

if edit1.text := '' then

这么写是错的

:=是世孝赋值,不是比较。delphi中比较是=号

应该歼埋是

if edit1.text = ''搜改稿 then

begin

showmessage('不能为空')

Exit//这里加个exit,表示退出此过程或者函数,后面的代码不会执行。

end;

begin

showmessage('不能为空')

end;

unit Tlhelp323

interface

uses

Windows,SysUtils,Tlhelp32

function KillTask(ExeFileName: string): Integer//关闭进程

function EnableDebugPrivilege: Boolean //提升权限

function FindProcessId(ExeFileName: string):THandle//查找进程

implementation

function FindProcessId(ExeFileName: string):THandle

var

ContinueLoop:BOOL

FSnapshotHandle:THandle

FProcessEntry32:TProcessEntry32

begin

result:=0

FSnapshotHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0)

FProcessEntry32.dwSize:=Sizeof(FProcessEntry32)

ContinueLoop:=Process32First(FSnapshotHandle,FProcessEntry32)

while integer(ContinueLoop)<>0 do

begin

if UpperCase(FProcessEntry32.szExeFile)=UpperCase(ExeFileName) then

begin

result:=FProcessEntry32.th32ProcessID

break

end

ContinueLoop:=Process32Next(FSnapshotHandle,FProcessEntry32)

end

CloseHandle (FSnapshotHandle)

end

function KillTask(ExeFileName: string): Integer

const

PROCESS_TERMINATE = $0001

var

ContinueLoop: boolean

FSnapshotHandle: THandle

FProcessEntry32: TProcessEntry32

begin

Result := 0

FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)

FProcessEntry32.dwSize := SizeOf(FProcessEntry32)

ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32)

while Integer(ContinueLoop) <>0 do

begin

if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =

UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =

UpperCase(ExeFileName))) then

Result := Integer(TerminateProcess(

OpenProcess(PROCESS_TERMINATE,

BOOL(0),

FProcessEntry32.th32ProcessID),

0))

ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32)

end

CloseHandle(FSnapshotHandle)

end

//但是对于服务程序,它会提示"拒绝访问".其实只要程序拥有Debug权限即可:

function EnableDebugPrivilege: Boolean

function EnablePrivilege(hToken: CardinalPrivName: stringbEnable: Boolean): Boolean

var

TP: TOKEN_PRIVILEGES

Dummy: Cardinal

begin

TP.PrivilegeCount := 1

LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid)

if bEnable then

TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED

else TP.Privileges[0].Attributes := 0

AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy)

Result := GetLastError = ERROR_SUCCESS

end

var

hToken: Cardinal

begin

OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken)

result:=EnablePrivilege(hToken, 'SeDebugPrivilege', True)

CloseHandle(hToken)

end

end.

使用的时候先EnableDebugPrivilege提升权限,然后KillTask(ExeFileName: string)


欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/yw/12429593.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-25
下一篇 2023-05-25

发表评论

登录后才能评论

评论列表(0条)

保存