{-----------------------------------------------------------------------------
Unit Name: ShellExecuteHookObj
Author: hubdog
Purpose: 外壳ShellExecute函数截取扩展
History: 2001-05-01
-----------------------------------------------------------------------------}
unit ShellExecuteHookObj;
interface
uses
Windows, ActiveX, ComObj, ShlObj, ShellAPI;
type
TTShellExecuteHook = class(TComObject, IShellExecuteHook)
protected
function Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult; stdcall;
end;
const
Class_TShellExecuteHook: TGUID = '{935FA400-243D-11D3-B06E-857B2AE2BE64}';
implementation
resourcestring
sCreateRegKeyError = '创建注册表项失败';
type
TShellExComObjectFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;
{ TShellExComObjectFactory }
function TTShellExecuteHook.Execute(var ShellExecuteInfo: TShellExecuteInfo): HResult;
var
FileName: string;
begin
Result := S_FALSE;
with ShellExecuteInfo do
begin
FileName := UpperCase(ExtractFileName(lpFile));
if Pos('NOTEPAD', FileName) = 1 then
begin
Result := S_OK;
hInstApp := 32;
MessageBox(Wnd, '不允许记事本运行！', '错误', MB_OK or MB_ICONERROR);
end;
end;
end;
procedure TShellExComObjectFactory.UpdateRegistry(Register: Boolean);
const
hellExecuteHooksKey = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks';
var
Handle: HKey;
Status, Disposition: Integer;
ClassID: string;
begin
ClassID := GUIDToString(Class_TShellExecuteHook);
if Register then
begin
Status := RegCreateKeyEx(HKEY_LOCAL_MACHINE, PChar(ShellExecuteHooksKey), 0, '',
REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, nil, Handle, @Disposition);
if Status = 0 then
begin
Status := RegSetValueEx(Handle, PChar(ClassID), 0, REG_SZ,
PChar(Description), Length(Description) + 1);
RegCloseKey(Handle);
end;
end else
begin
Status := RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(ShellExecuteHooksKey), 0,
KEY_READ or KEY_WRITE, Handle);
if Status = 0 then
begin
Status := RegDeleteValue(Handle, PChar(ClassID));
RegCloseKey(Handle);
end;
end;
if Status <> 0 then raise EOleError.Create(sCreateRegKeyError);
inherited UpdateRegistry(Register);
end;
initialization
TShellExComObjectFactory.Create(ComServer, TTShellExecuteHook, Class_TShellExecuteHook,
'TShellExecuteHook', 'ShellExecute hook sample', ciMultiInstance, tmApartment);
end.