在Delphi中隐藏程序进程的方法

在Delphi中隐藏程序进程方法[1]

主要需要解决两个问题，即隐藏窗口和设定热键。

一. 隐藏窗口

通过API函数GETACTIVEWINDOW获取当前窗口；函数ShowWindow(HWND,nCmdShow)的参数nCmdShow取SW_HIDE时将之隐藏，取SW_SHOW时将之显示。例如：

showwindow(getactivewindow,sw_hide)。隐藏好窗体后，须记住窗体句柄以便恢复。二. 键盘监控

为了实现键盘监控须用到钩子。

以下是程序的源文件：

一、创建一个动态链接库

unit HKHide; //链接库中的Unit文件

interface

uses

Windows, Messages, sysutils;

var

hNextHookHide: HHook;

HideSaveExit: Pointer;

hbefore:longint;

function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;

lParam: LPARAM): LRESULT; stdcall; export;

function EnableHideHook: BOOL; export;

function DisableHideHook: BOOL; export;

procedure HideHookExit; far;

implementation

function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;

lParam: LPARAM): LRESULT; stdcall; export;

const _KeyPressMask = $80000000;

var

f:textfile;

temp:string;

begin

Result := 0;

If iCode < 0 Then

begin

Result := CallNextHookEx(hNextHookHide, iCode, wParam, lParam); Exit;

end;

//侦测 Ctrl + Alt + F12 组合键

if ((lParam and _KeyPressMask) = 0) //按下时生效

and (GetKeyState(vk_Control) < 0)

and (getkeystate(vk_menu)<0)

and (wParam = vk_F12) then

begin

Result := 1;

//文件不存在则创建

if not fileexists('c:\test.txt') then

begin

assignfile(f,'c:\test.txt');

rewrite(f);

writeln(f,0);

closefile(f);

end

else

begin

assignfile(f,'c:\test.txt');

reset(f);

readln(f,temp);

hbefore:=strtoint(temp);

begin

hbefore:=getactivewindow;

temp:=inttostr(hbefore);

rewrite(f);

writeln(f,temp);

closefile(f);

ShowWindow(hbefore, SW_HIDE);

end;

end; //end if FileExists(....)

end

else begin

showwindow(hbefore,SW_SHOW);

rewrite(f);

writeln(f,0);

closefile(f);

end;//end if Ctrl+Alt+F12按键

end;

function EnableHideHook: BOOL; export;

begin

Result := False;

if hNextHookHide <> 0 then Exit;

// 挂上 WH_KEYBOARD 这型的 HOOK, 同时, 传回值必须保留下 // 来, 免得 HOOK 呼叫链结断掉

hNextHookHide := SetWindowsHookEx(WH_KEYBOARD,

KeyboardHookHandler,HInstance,0);

Result := hNextHookHide <> 0;

end;

function DisableHideHook: BOOL; export;

begin

if hNextHookHide <> 0 then

begin

Result:=True;

UnhookWindowshookEx(hNextHookHide); // 解除 Keyboard Hook hNextHookHide:=0;

end

else

Result:=False;

end;

procedure HideHookExit;

begin

// 如果忘了解除 HOOK, 自动代理解除的动作

if hNextHookHide <> 0 then DisableHideHook;

ExitProc := HideSaveExit;

end;

end.

library HKPHide; //动态链接库工程文件

uses

HKHide in HKHide.pas;

exports

EnableHideHook,

DisableHideHook;

begin

hNextHookHide := 0;

hbefore:=0;

HideSaveExit := ExitProc;

ExitProc := @HideHookExit;

end.

//文件制作好后先Build All编译成HKPHide.dll。

二、新建一个测试工程TestPrj

unit Unit1;//这是测试工程的窗体单元

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

function EnableHideHook: BOOL; external 'HKPHide.DLL'; function DisableHideHook: BOOL; external 'HKPHide.DLL';

procedure TForm1.Button1Click(Sender: TObject);

begin

if EnableHideHook then

ShowMessage('HotKey Testing...');

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if DisableHideHook then

ShowMessage('HotKey Testing..., DONE！);

end;

end.

DELPHI中隐藏程序进程，纯DELPHI代码方式，我在XP下通过测试。下面是隐藏进程的unit HideProcess

unit HideProcess;

interface

function MyHideProcess: Boolean;

implementation

uses

Windows, SysUtils, Variants, Classes, AclAPI, accCtrl;

type

NTSTATUS = LongInt;

const

//NT_SUCCESS(Status) ((NTSTATUS)(Status) >= 0)

STATUS_INFO_LENGTH_MISMATCH = NTSTATUS($C0000004);

STATUS_ACCESS_DENIED = NTSTATUS($C0000022);

OBJ_INHERIT = $00000002;

OBJ_PERMANENT = $00000010;

OBJ_EXCLUSIVE = $00000020;

OBJ_CASE_INSENSITIVE = $00000040;

OBJ_OPENIF = $00000080;

OBJ_OPENLINK = $00000100;

OBJ_KERNEL_HANDLE = $00000200;

OBJ_VALID_ATTRIBUTES = $000003F2;

type

PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;

IO_STATUS_BLOCK = record

Status: NTSTATUS;

FObject: DWORD;

end;

PUNICODE_STRING = ^UNICODE_STRING;

UNICODE_STRING = record

Length: Word;

MaximumLength: Word;

Buffer: PWideChar;

end;

POBJECT_ATTRIBUTES = ^OBJECT_ATTRIBUTES;

OBJECT_ATTRIBUTES = record

Length: DWORD;

RootDirectory: Pointer;

ObjectName: PUNICODE_STRING;

Attributes: DWORD;

SecurityDescriptor: Pointer;

SecurityQualityOfService: Pointer;

end;

TZwOpenSection = function(SectionHandle: PHandle;

DesiredAccess: ACCESS_MASK;

ObjectAttributes: POBJECT_ATTRIBUTES): NTSTATUS; stdcall;

TRTLINITUNICODESTRING = procedure(DestinationString: PUNICODE_STRING; SourceString: PWideChar); stdcall;

var

RtlInitUnicodeString: TRTLINITUNICODESTRING = nil;

ZwOpenSection: TZwOpenSection = nil;

g_hNtDLL: THandle = 0;

g_pMapPhysicalMemory: Pointer = nil;

g_hMPM: THandle = 0;

g_hMPM2: THandle = 0;

g_osvi: OSVERSIONINFO;

b_hide: Boolean = false;

//---------------------------------------------------------------------------

function InitNTDLL: Boolean;

begin

g_hNtDLL := LoadLibrary('ntdll.dll');

if 0 = g_hNtDLL then

begin

Result := false;

Exit;

end;

RtlInitUnicodeString := GetProcAddress(g_hNtDLL, 'RtlInitUnicodeString'); ZwOpenSection := GetProcAddress(g_hNtDLL, 'ZwOpenSection');

Result := True;

end;

//---------------------------------------------------------------------------

procedure CloseNTDLL;

begin

if (0 <> g_hNtDLL) then

FreeLibrary(g_hNtDLL);

g_hNtDLL := 0;

end;

//---------------------------------------------------------------------------

procedure SetPhyscialMemorySectionCanBeWrited(hSection: THandle);

var

pDacl: PACL;

pSD: PPSECURITY_DESCRIPTOR;

pNewDacl: PACL;

dwRes: DWORD;

ea: EXPLICIT_ACCESS;

begin

pDacl := nil;

pSD := nil;

pNewDacl := nil;

dwRes := GetSecurityInfo(hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, nil, nil, pDacl, nil, pSD);

if ERROR_SUCCESS <> dwRes then

begin

if Assigned(pSD) then

LocalFree(Hlocal(pSD^));

if Assigned(pNewDacl) then

LocalFree(HLocal(pNewDacl));

end;

ZeroMemory(@ea, sizeof(EXPLICIT_ACCESS));

ea.grfAccessPermissions := SECTION_MAP_WRITE;

ea.grfAccessMode := GRANT_ACCESS;

ea.grfInheritance := NO_INHERITANCE;

ea.Trustee.TrusteeForm := TRUSTEE_IS_NAME;

ea.Trustee.TrusteeType := TRUSTEE_IS_USER;

ea.Trustee.ptstrName := 'CURRENT_USER';

dwRes := SetEntriesInAcl(1, @ea, pDacl, pNewDacl);

if ERROR_SUCCESS <> dwRes then

begin

if Assigned(pSD) then

LocalFree(Hlocal(pSD^));

if Assigned(pNewDacl) then

LocalFree(HLocal(pNewDacl));

end;

dwRes := SetSecurityInfo

(hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION, nil, nil, pNewDacl, nil);

if ERROR_SUCCESS <> dwRes then

begin

if Assigned(pSD) then

LocalFree(Hlocal(pSD^));

if Assigned(pNewDacl) then

LocalFree(HLocal(pNewDacl));

end;

end;

//---------------------------------------------------------------------------

function OpenPhysicalMemory: THandle;

var

status: NTSTATUS;

physmemString: UNICODE_STRING;

attributes: OBJECT_ATTRIBUTES;

PhyDirectory: DWORD;

begin

g_osvi.dwOSVersionInfoSize := sizeof(OSVERSIONINFO);

GetVersionEx(g_osvi);

if (5 <> g_osvi.dwMajorVersion) then

begin

Result := 0;

Exit;

end;

case g_osvi.dwMinorVersion of

0: PhyDirectory := $30000;

1: PhyDirectory := $39000;

else

begin

Result := 0;

Exit;

end;

end;

RtlInitUnicodeString(@physmemString, '\Device\PhysicalMemory');

attributes.Length := SizeOf(OBJECT_ATTRIBUTES);

attributes.RootDirectory := nil;

attributes.ObjectName := @physmemString;

attributes.Attributes := 0;

attributes.SecurityDescriptor := nil;

attributes.SecurityQualityOfService := nil;

status := ZwOpenSection(@g_hMPM, SECTION_MAP_READ or SECTION_MAP_WRITE, @attributes);

if (status = STATUS_ACCESS_DENIED) then

begin

ZwOpenSection(@g_hMPM, READ_CONTROL or WRITE_DAC, @attributes); SetPhyscialMemorySectionCanBeWrited(g_hMPM);

CloseHandle(g_hMPM);

status := ZwOpenSection(@g_hMPM, SECTION_MAP_READ or SECTION_MAP_WRITE,

@attributes);

end;

if not (LongInt(status) >= 0) then

begin

Result := 0;

Exit;

end;

g_pMapPhysicalMemory := MapViewOfFile(g_hMPM,

FILE_MAP_READ or FILE_MAP_WRITE, 0, PhyDirectory, $1000);

if (g_pMapPhysicalMemory = nil) then

begin

Result := 0;

Exit;

end;

Result := g_hMPM;

end;

//--------------------------------------------------------------------------- function LinearToPhys(BaseAddress: PULONG; addr: Pointer): Pointer;

var

VAddr, PGDE, PTE, PAddr, tmp: DWORD;

begin

VAddr := DWORD(addr);

// PGDE := BaseAddress[VAddr shr 22];

PGDE := PULONG(DWORD(BaseAddress) + (VAddr shr 22) * SizeOf(ULONG))^; // Modify by dot.

if 0 = (PGDE and 1) then

begin

Result := nil;

Exit;

end;

tmp := PGDE and $00000080;

if (0 <> tmp) then

begin

PAddr := (PGDE and $FFC00000) + (VAddr and $003FFFFF);

end

else

begin

PGDE := DWORD(MapViewOfFile(g_hMPM, 4, 0, PGDE and $FFFFF000, $1000));

// PTE := (PDWORD(PGDE))[(VAddr and $003FF000) shr 12];

PTE := PDWORD(PGDE + ((VAddr and $003FF000) shr 12) * SizeOf(DWord))^; // Modify by dot.

if (0 = (PTE and 1)) then

begin

Result := nil;

Exit;

end;

PAddr := (PTE and $FFFFF000) + (VAddr and $00000FFF);

UnmapViewOfFile(Pointer(PGDE));

end;

Result := Pointer(PAddr);

end;

//---------------------------------------------------------------------------

function GetData(addr: Pointer): DWORD;

var

phys, ret: DWORD;

tmp: PDWORD;

begin

phys := ULONG(LinearToPhys(g_pMapPhysicalMemory, Pointer(addr)));

tmp := PDWORD(MapViewOfFile(g_hMPM, FILE_MAP_READ or FILE_MAP_WRITE, 0,

phys and $FFFFF000, $1000));

if (nil = tmp) then

begin

Result := 0;

Exit;

end;

// ret := tmp[(phys and $FFF) shr 2];

ret := PDWORD(DWORD(tmp) + ((phys and $FFF) shr 2) * SizeOf(DWord))^; // Modify by dot.

UnmapViewOfFile(tmp);

Result := ret;

end;

//---------------------------------------------------------------------------

function SetData(addr: Pointer; data: DWORD): Boolean;

var

phys: DWORD;

tmp: PDWORD;

begin

phys := ULONG(LinearToPhys(g_pMapPhysicalMemory, Pointer(addr)));

tmp := PDWORD(MapViewOfFile(g_hMPM, FILE_MAP_WRITE, 0, phys and $FFFFF000, $1000));

if (nil = tmp) then

begin

Result := false;

Exit;

end;

// tmp[(phys and $FFF) shr 2] := data;

PDWORD(DWORD(tmp) + ((phys and $FFF) shr 2) * SizeOf(DWord))^ := data; // Modify by dot.

UnmapViewOfFile(tmp);

Result := TRUE;

end;

//--------------------------------------------------------------------------- {long __stdcall exeception(struct _EXCEPTION_POINTERS *tmp)

begin

ExitProcess(0);

return 1 ;

end }

//---------------------------------------------------------------------------

function YHideProcess: Boolean;

var

thread, process: DWORD;

fw, bw: DWORD;

begin

// SetUnhandledExceptionFilter(exeception);

if (FALSE = InitNTDLL) then

begin

Result := FALSE;

Exit;

end;

if (0 = OpenPhysicalMemory) then

begin

Result := FALSE;

Exit;

end;

thread := GetData(Pointer($FFDFF124)); //kteb

process := GetData(Pointer(thread + $44)); //kpeb

if (0 = g_osvi.dwMinorVersion) then

begin

fw := GetData(Pointer(process + $A0));

bw := GetData(Pointer(process + $A4));

SetData(Pointer(fw + 4), bw);

SetData(Pointer(bw), fw);

Result := TRUE;

end

else if (1 = g_osvi.dwMinorVersion) then

begin

fw := GetData(Pointer(process + $88));

bw := GetData(Pointer(process + $8C));

SetData(Pointer(fw + 4), bw);

SetData(Pointer(bw), fw);

Result := TRUE;

end

else

begin

Result := False;

end;

CloseHandle(g_hMPM);

CloseNTDLL;

end;

function MyHideProcess: Boolean; begin

if not b_hide then

begin

b_hide := YHideProcess;

end;

Result := b_hide;

end;

end.

用法：

implementation

uses HideProcess;

过程调用

begin

MyHideProcess;

....

end;

异常死亡进程的自动复活

[作者: 上海三吉电子工程有限公司卓乃奇]

一、问题的产生

我们或多或少都有这样的经历，在Windows上运行的应用程序常常会异常终止，需要通过手工重新将其启动起来。若计算机无人看守，异常终止的进程不能实时启动，则可能给生产造成损失。

本人在开发GPS全球卫星定位系统控制中心程序时，就遇到过控制中心程序异常终止死亡的情况，由此，找出了一个自动复活死亡进程的方法，供参考。

二、相关知识

通常，把一个应用程序的一次运行实例叫做一个进程，在一个进程内又可包含多条可并发执行的路径，每条执行路径叫做一个线程，一个进程至少包含一个主线程。主线程负责执行运行的启动代码。另外，一个进程可以创建若干子进程。当进程被创建时，系统自动产生主线程，主线程然后可创建更多的线程。

我们可以编写一个程序，让其创建、启动子进程，并监视进程的运行情况，在其出现异常终止时，立即重新创建并启动子进程即可。

三、相关函数

1、创建一个子进程函数：

BOOL CreateProcess(

LPCTSTR lpApplicationName,

LPTSTR lpCommandLine,

LPSECURITY_ATTRIBUTES lpProcessAttributes,

LPSECURITY_ATTRIBUTES lpThreadAttributes,

BOOL bInheritHandles,

DWORD dwCreationFlags,

LPVOID lpEnvironment,

LPCTSTR lpCurrentDirectory,

LPSTARTUPINFO lpStartupInfo,

LPPROCESS_INFORMATION lpProcessInformation

);

参数说明：

lpApplicationName：新进程将要使用的可执行文件的名字，必须包含扩展名。LpCommandLine：新进程的命令行。若lpApplicationName为NULL，LpCommandLine 的第一个参数是新进程将要使用的可执行文件的名字，可以不包含扩展名，系统假定是exe文件。LpProcessAttributes和lpThreadAttributes：分别是给进程对象和线程对象指定的安全属

性。

BInheritHandles：指定该进程是否继承其父进程中的句柄。

dwCreationFlags：指定新进程产生方式的标志，可用逻辑操作符or相连接。LpEnvironment：指向含有新进程将要使用的环境块字符串的一块内存,一般为NULL，使子进程继承父进程的一组环境块。

LpCurrentDirectory：设置子进程的当前驱动器和工作目录, 为NULL，子进程继承父进程的当前驱动器和工作目录。

LpStartupInfo：指向STARTUPINFO 的结构。一般让子进程使用缺省值。但要把该结构中的所有成员初始化为0,并设置cb为结构大小。

STARTUPINFO 结构如下：

typedef struct _STARTUPINFO {

DWORD cb;

LPTSTR lpReserved;

LPTSTR lpDesktop;

LPTSTR lpTitle;

DWORD dwX;

DWORD dwY;

DWORD dwXSize;

DWORD dwYSize;

DWORD dwXCountChars;

DWORD dwYCountChars;

DWORD dwFillAttribute;

DWORD dwFlags;

WORD wShowWindow;

WORD cbReserved2;

LPBYTE lpReserved2;

HANDLE hStdInput;

HANDLE hStdOutput;

HANDLE hStdError;

} STARTUPINFO, *LPSTARTUPINFO；

lpProcessInformation 参数指向LPPROCESS_INFORMATION结构，CreateProcess在返回之前，填入有关子进程的信息，父进程正是利用该信息监测子进程是否终止。该结构如下：typedef struct _PROCESS_INFORMATION {

HANDLE hProcess;

HANDLE hThread;

DWORD dwProcessId;

DWORD dwThreadId;

} PROCESS_INFORMATION;

hProcess和hThread分别是子进程的句柄和子进程的主线程的句柄，dwProcessId和dwThreadId分别是子进程的标识号和子进程的主线程的标识号。

2、子进程终止检测函数

GetEXitCodeProcess(HANDLE hProcess, LPDWORD lpExitCode );

Hprocess：进程句柄，lpExitCode：进程终止时的退出码。

如果一个进程没有终止，lpExitCode 的返回值是STILL_ACTIVE,否则返回其他值。

四、方法的Delphi语言实现

1、创建一个新的项目 Project1

选择File,New Application。在表单Form1上放一Memo组件，一个OK按钮组件，改变OK 按钮组件的Cation属性为 CreateProcess。再放一个timer组件。设置timer组件的Interval值为1000,每秒检查一次进程是否终止。

2、在Unit1 Use节的Type后定义一个过程

procedure EstablishProcess;

在Unit1 Use节的Var后定义一个变量：

piProcInfoGPS:PROCESS_INFORMATION;

3、在Unit1 implementation节中编写EstablishProcess过程的实现代码如下：procedure EstablishProcess;

Var

siStartupInfo:STARTUPINFO;

saProcess,saThread:SECURITY_ATTRIBUTES;

fSuccess:boolean;

begin

fSuccess:=false;

ZeroMemory(@siStartupInfo,sizeof(siStartupInfo));

siStartupInfo.cb:=sizeof(siStartupInfo);

saProcess.nLength:=sizeof(saProcess);

saProcess.lpSecurityDescriptor:=PChar(nil);

saProcess.bInheritHandle:=true;

saThread.nLength:=sizeof(saThread);

saThread.lpSecurityDescriptor:=PChar(nil);

saThread.bInheritHandle:=true;

fSuccess:=CreateProcess(PChar(nil),'c:\sr350\Sr350buff',@saProcess,@saThread ,false,

CREATE_DEFAULT_ERROR_MODE,Pchar(nil),Pchar(nil),siStartupInfo,piProcInfoGPS); if( not fSuccess)then

Form1.Memo1.Lines.Add('Create Process Sr350buff fail.')

else

Form1.Memo1.Lines.Add('Create Process Sr350buff success.')

end;

4、在CreateProcess按钮的OnClick事件中调用过程

EstablishProcess；

5、为Timer1的OnTimer事件编写代码：

Procedure TForm1.Timer1Timer(Sender: TObject);

Var

dwExitCode:DWORD;

fprocessExit:boolean;

Begin

dwExitCode:=0;

fprocessExit:=false;

fprocessExit:=GetExitCodeProcess(piProcInfoGPS.hProcess,dwExitCode);

if(fprocessExit and (dwExitCode<>STILL_ACTIVE))then

begin

Memo1.Lines.Add('SR350buff.exe进程终止');

CloseHandle(piProcInfoGPS.hThread);

CloseHandle(piProcInfoGPS.hProcess);

EstablishProcess;

end;

End;

6、程序中设可执行文件名为c:\sr350\sr350buff.exe，所以c:盘\sr350目录下需有

sr350buff.exe文件。

7、编译联接，运行project1，单击CreateProcess可见c:\sr350\sr350buff.exe启动。

关掉sr350buff.exe进程，可见sr350buff.exe自动再启动。

浅谈Delphi中进程间的数据共享

https://www.360docs.net/doc/47487146.html, 2005年08月11日09:10 天极yesky

DLL是创建Windows应用程序，实现代码重用的重要手段。那么当我们需要在进程间共享数据时，怎样做才能快捷方便地实现呢？在32位应用系统中，每个应用程序会将DLL映射到自己的地址空间，同时DLL中的数据也就随之被映射了。这样，每个应用程序都有自己

的数据实例，在一个应用程序中修改DLL中的全局变量，不会影响其它的应用程序。DLL 的使用似乎与我们的目的相背离，那么如何才能实现我们想要的东东呢？这里给大家介绍一

种特殊的技术，那就是内存映射文件。

内存映射文件提供了一种方法，就是在WIN32系统的地址空间保留一块内存区域，物理存储可以向其中提交。并且内存映射文件不只是磁盘文件，也可以是WIN32的页面文件，而且后者比前者要好，因为这意味着可以像访问一个磁盘文件那样访问内存中的一个区域，而不用创建临时文件，用完后还得删除它。WIN32有自己的管理页面调度文件，当不需要页面调度文件时，系统会自动将有关区域释放。以下是具体的实现代码：