进程管理 ( 积分: 200 )

如何实现：
1：在有新进程创建时提示是否允许该进程运行（Y/N）。
2：Y：运行该进程；N：关闭该进程。
就类似Win xp的防火墙那种效果。
谢谢。

200 分实现不了，大概必须 RMB

另外 WINDOWS 防火墙并没有禁止程序运行的功能。

其他的都不难，问题是怎么知道哪些进程是不允许启动的呢

API Hook CreateProcess ＋跳转大法可以实现

正如楼上所言，如果是商用可以联系我 kryso@21cn.com

我这里有一个dll,可以监视进程。但运行后其他程序就不能运行了。
library MYAPIDLL;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
SysUtils,
Windows,
Classes,
HookAPI in 'HookAPI.pas',
Main in 'Main.pas';

var
Hook:HHOOK;

function GetMsgProc(nCode:Integer;wParam:wParam;lParam:lParam):LRESULT;stdcall;
begin
Result := 0;
end;

procedure SetHook;
begin
Hook := SetWindowsHookEx(WH_GETMESSAGE,GetMsgProc,hInstance,0);
end;

procedure RemoveHook;
begin
UnHookWindowsHookEx(Hook);
end;

{$R *.RES}

exports
SetHook, RemoveHook;

begin
API_Hookup;
end.






unit Main;

interface
uses
SysUtils,
Windows,
ShellAPI,
Dialogs,
Classes;

procedure API_Hookup; stdcall;
procedure API_HookDown; stdcall;

type
TCreateProcess = function(lpApplicationName: PChar; lpCommandLine: PChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
TCreateProcessA = function(lpApplicationName: PAnsiChar; lpCommandLine: PAnsiChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PAnsiChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
TCreateProcessW = function(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;

var
OldCreateProcess: TCreateProcess;
OldCreateProcessA: TCreateProcessA;
OldCreateProcessW: TCreateProcessW;

implementation

uses HookAPI;

function MyCreateProcess(lpApplicationName: PChar; lpCommandLine: PChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
begin
ShowMessage('MyCreateProcess');
end;

function MyCreateProcessA(lpApplicationName: PAnsiChar; lpCommandLine: PAnsiChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PAnsiChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
begin
ShowMessage('MyCreateProcessA');
end;

function MyCreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
begin
ShowMessage('MyCreateProcessW');
end;

procedure API_Hookup; stdcall;
begin
if @OldCreateProcess = nil then
@OldCreateProcess := LocateFunctionAddress(@CreateProcess);
if @OldCreateProcessA = nil then
@OldCreateProcessA := LocateFunctionAddress(@CreateProcessA);
if @OldCreateProcessW = nil then
@OldCreateProcessW := LocateFunctionAddress(@CreateProcessW);

RepointFunction(@OldCreateProcess, @MyCreateProcess);
RepointFunction(@OldCreateProcessA, @MyCreateProcessA);
RepointFunction(@OldCreateProcessW, @MyCreateProcessW);

end;

procedure API_HookDown; stdcall;
begin
if @OldCreateProcess <> nil then
RepointFunction(@MyCreateProcess, @OldCreateProcess);
if @OldCreateProcess <> nil then
RepointFunction(@MyCreateProcessA, @OldCreateProcessA);
if @OldCreateProcess <> nil then
RepointFunction(@MyCreateProcessW, @OldCreateProcessW);
end;

initialization

finalization
API_HookDown;

end.







unit HookAPI;

interface

uses
Windows, Classes;
function LocateFunctionAddress(Code: Pointer): Pointer;
function RepointFunction(OldFunc, NewFunc: Pointer): Integer;

type //ｶｨﾒ袵ｻｸ ・ﾚｽ盪ｹ
PImage_Import_Entry = ^Image_Import_Entry;
Image_Import_Entry = record
Characteristics: DWORD;
TimeDateStamp: DWORD;
MajorVersion: Word;
MinorVersion: Word;
Name: DWORD;
LookupTable: DWORD;
end;

type
TImportCode = packed record
JumpInstruction: Word;
AddressOfPointerToFunction: ^Pointer;
end;
PImportCode = ^TImportCode;
implementation

function LocateFunctionAddress(Code: Pointer): Pointer;
var
func: PImportCode;
begin
Result := Code;
if Code = nil then exit;
try
func := code;
if (func.JumpInstruction = $25FF) then
begin
Result := func.AddressOfPointerToFunction^;
end;
except
Result := nil;
end;
end;

function RepointFunction(OldFunc, NewFunc: Pointer): Integer;
var
IsDone: TList;
function RepointAddrInModule(hModule: THandle; OldFunc, NewFunc: Pointer): Integer;
var
Dos: PImageDosHeader;
NT: PImageNTHeaders;
ImportDesc: PImage_Import_Entry;
RVA: DWORD;
Func: ^Pointer;
DLL: string;
f: Pointer;
written: DWORD;
begin
Result := 0;
Dos := Pointer(hModule);
if IsDone.IndexOf(Dos) >= 0 then exit;
IsDone.Add(Dos);

OldFunc := LocateFunctionAddress(OldFunc);

if IsBadReadPtr(Dos, SizeOf(TImageDosHeader)) then exit;
if Dos.e_magic <> IMAGE_DOS_SIGNATURE then exit;
NT := Pointer(Integer(Dos) + dos._lfanew);

RVA := NT^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT]
.VirtualAddress;

if RVA = 0 then exit;
ImportDesc := pointer(integer(Dos) + RVA);
while (ImportDesc^.Name <> 0) do
begin
DLL := PChar(Integer(Dos) + ImportDesc^.Name);
RepointAddrInModule(GetModuleHandle(PChar(DLL)), OldFunc, NewFunc);
Func := Pointer(Integer(DOS) + ImportDesc.LookupTable);
while Func^ <> nil do
begin
f := LocateFunctionAddress(Func^);
if f = OldFunc then
begin
WriteProcessMemory(GetCurrentProcess, Func, @NewFunc, 4, written);
if Written > 0 then Inc(Result);
end;
Inc(Func);
end;
Inc(ImportDesc);
end;
end;

begin
IsDone := TList.Create;
try
Result := RepointAddrInModule(GetModuleHandle(nil), OldFunc, NewFunc);
finally
IsDone.Free;
end;
end;

end.

代码还过得去，你自己修改下就可以实现你要的功能，除了稳定性应该没什么大问题。

路过看看

路过的不防指点指点。谢谢了。

帮你顶一下，接个小分

就是HOOK API啊
function MyCreateProcess(lpApplicationName: PChar; lpCommandLine: PChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
begin
{在这里处理询问是否运行}
end;

function MyCreateProcessA(lpApplicationName: PAnsiChar; lpCommandLine: PAnsiChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PAnsiChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
begin
{在这里处理询问是否运行}
end;

function MyCreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
begin
{在这里处理询问是否运行}
end;

询问是否运行多半是阻塞的,处理不好多半是死掉....

我就是这样做的，但启动的程序都被阻止了。

使用system hook api倒是可以不过你必须过滤掉对系统文件的过滤，否则你只有死机一条路走了。

lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PAnsiChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
begin
{在这里处理询问是否运行}
end;

function MyCreateProcessW(lpApplicationName: PWideChar; lpCommandLine: PWideChar;
lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
lpCurrentDirectory: PWideChar; const lpStartupInfo: TStartupInfo;
var lpProcessInformation: TProcessInformation): BOOL; stdcall;
begin
{在这里处理询问是否运行}
end;

你去问江民呀，瑞星呀，卡吧呀、诺吨呀，都可以得到答案

一个简单的方法，遍历进程列表，发现新的进程把进程状态设置为等待运行，弹出提示，如果用户允许，则运行，否则就强制关闭

谢谢你的回答

如果懒得做，或急需，可以免费用我的软件！呵呵！
http://www.delphibbs.com/delphibbs/dispq.asp?lid=3681128

多人接受答案了。